summaryrefslogtreecommitdiff
path: root/src/Language/PureScript/Errors.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/PureScript/Errors.hs')
-rw-r--r--src/Language/PureScript/Errors.hs43
1 files changed, 23 insertions, 20 deletions
diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs
index cb4f460..1386ce6 100644
--- a/src/Language/PureScript/Errors.hs
+++ b/src/Language/PureScript/Errors.hs
@@ -10,6 +10,7 @@ import Prelude.Compat
import Protolude (ordNub)
import Control.Arrow ((&&&))
+import Control.Exception (displayException)
import Control.Monad
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.Trans.State.Lazy
@@ -85,9 +86,7 @@ errorCode em = case unwrapErrorMessage em of
MissingFFIImplementations{} -> "MissingFFIImplementations"
UnusedFFIImplementations{} -> "UnusedFFIImplementations"
InvalidFFIIdentifier{} -> "InvalidFFIIdentifier"
- CannotGetFileInfo{} -> "CannotGetFileInfo"
- CannotReadFile{} -> "CannotReadFile"
- CannotWriteFile{} -> "CannotWriteFile"
+ FileIOError{} -> "FileIOError"
InfiniteType{} -> "InfiniteType"
InfiniteKind{} -> "InfiniteKind"
MultipleValueOpFixities{} -> "MultipleValueOpFixities"
@@ -465,17 +464,9 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl
else
"Make sure the source file exists, and that it has been provided as an input to the compiler."
]
- renderSimpleErrorMessage (CannotGetFileInfo path) =
- paras [ line "Unable to read file info: "
- , indent . lineS $ path
- ]
- renderSimpleErrorMessage (CannotReadFile path) =
- paras [ line "Unable to read file: "
- , indent . lineS $ path
- ]
- renderSimpleErrorMessage (CannotWriteFile path) =
- paras [ line "Unable to write file: "
- , indent . lineS $ path
+ renderSimpleErrorMessage (FileIOError doWhat err) =
+ paras [ line $ "I/O error while trying to " <> doWhat
+ , indent . lineS $ displayException err
]
renderSimpleErrorMessage (ErrorParsingFFIModule path extra) =
paras $ [ line "Unable to parse foreign module:"
@@ -897,8 +888,14 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl
paras [ line "An exhaustivity check was abandoned due to too many possible cases."
, line "You may want to decompose your data types into smaller types."
]
- renderSimpleErrorMessage (UnusedImport name) =
- line $ "The import of module " <> markCode (runModuleName name) <> " is redundant"
+
+ renderSimpleErrorMessage (UnusedImport mn qualifier) =
+ let
+ mark = markCode . runModuleName
+ unqualified = "The import of " <> mark mn <> " is redundant"
+ msg' q = "The qualified import of " <> mark mn <> " as " <> mark q <> " is redundant"
+ msg = maybe unqualified msg'
+ in line $ msg qualifier
renderSimpleErrorMessage msg@(UnusedExplicitImport mn names _ _) =
paras [ line $ "The import of module " <> markCode (runModuleName mn) <> " contains the following unused references:"
@@ -1190,11 +1187,17 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs relPath) e = fl
printRow f t = markCodeBox $ indent $ f prettyDepth t
-- If both rows are not empty, print them as diffs
+ -- If verbose print all rows else only print unique rows
printRows :: Type a -> Type a -> (Box.Box, Box.Box)
- printRows r1@RCons{} r2@RCons{} = let
- (sorted1, sorted2) = filterRows (rowToList r1) (rowToList r2)
- in (printRow typeDiffAsBox sorted1, printRow typeDiffAsBox sorted2)
- printRows r1 r2 = (printRow typeAsBox r1, printRow typeAsBox r2)
+ printRows r1 r2 = case (full, r1, r2) of
+ (True, _ , _) -> (printRow typeAsBox r1, printRow typeAsBox r2)
+
+ (_, RCons{}, RCons{}) ->
+ let (sorted1, sorted2) = filterRows (rowToList r1) (rowToList r2)
+ in (printRow typeDiffAsBox sorted1, printRow typeDiffAsBox sorted2)
+
+ (_, _, _) -> (printRow typeAsBox r1, printRow typeAsBox r2)
+
-- Keep the unique labels only
filterRows :: ([RowListItem a], Type a) -> ([RowListItem a], Type a) -> (Type a, Type a)