@@ -22,14 +22,13 @@ import Data.Monoid
2222import Control.Monad.Error
2323
2424import Language.PureScript.Declarations
25−import Language.PureScript.Options
2625import Language.PureScript.Pretty
2726import Language.PureScript.Types
2827
2928-- |
3029-- Type for sources of type checking errors
3130--
32−data UnifyErrorSource
31+data ErrorSource
3332 -- |
3433 -- An error which originated at a Value
3534 --
@@ -40,42 +39,41 @@ data UnifyErrorSource
4039 | TypeError Type deriving (Show)
4140
4241-- |
43−-- Unification errors
42+-- Compilation errors
4443--
45−data UnifyError = UnifyError {
44+data CompileError = CompileError {
4645 -- |
4746 -- Error message
4847 --
49− unifyErrorMessage :: String
48+ compileErrorMessage :: String
5049 -- |
5150 -- The value where the error occurred
5251 --
53− , unifyErrorValue :: Maybe UnifyErrorSource
52+ , compileErrorValue :: Maybe ErrorSource
5453 -- |
5554 -- Optional source position information
5655 --
57− , unifyErrorPosition :: Maybe SourcePos
56+ , compileErrorPosition :: Maybe SourcePos
5857 } deriving (Show)
5958
6059-- |
6160-- A stack trace for an error
6261--
63−newtype UnifyErrorStack = UnifyErrorStack { runUnifyErrorStack :: [UnifyError] } deriving (Show, Monoid)
62+newtype ErrorStack = ErrorStack { runUnifyErrorStack :: [CompileError] } deriving (Show, Monoid)
6463
65−instance Error UnifyErrorStack where
66− strMsg s = UnifyErrorStack [UnifyError s Nothing Nothing]
67− noMsg = UnifyErrorStack []
64+instance Error ErrorStack where
65+ strMsg s = ErrorStack [CompileError s Nothing Nothing]
66+ noMsg = ErrorStack []
6867
69−prettyPrintUnifyErrorStack :: Options -> UnifyErrorStack -> String
70−prettyPrintUnifyErrorStack opts (UnifyErrorStack es) =
71− case mconcat $ map (Last . unifyErrorPosition) es of
68+prettyPrintErrorStack :: Bool -> ErrorStack -> String
69+prettyPrintErrorStack printAll (ErrorStack es) =
70+ case mconcat $ map (Last . compileErrorPosition) es of
7271 Last (Just sourcePos) -> "Error at " ++ show sourcePos ++ ": \n" ++ prettyPrintUnifyErrorStack'
7372 _ -> prettyPrintUnifyErrorStack'
7473 where
7574 prettyPrintUnifyErrorStack' :: String
7675 prettyPrintUnifyErrorStack'
77− | optionsVerboseErrors opts =
78− intercalate "\n" (map showError (filter isErrorNonEmpty es))
76+ | printAll = intercalate "\n" (map showError (filter isErrorNonEmpty es))
7977 | otherwise =
8078 let
8179 es' = filter isErrorNonEmpty es
@@ -83,16 +81,16 @@ prettyPrintUnifyErrorStack opts (UnifyErrorStack es) =
8381 1 -> showError (head es')
8482 _ -> showError (head es') ++ "\n" ++ showError (last es')
8583
86−isErrorNonEmpty :: UnifyError -> Bool
87−isErrorNonEmpty = not . null . unifyErrorMessage
84+isErrorNonEmpty :: CompileError -> Bool
85+isErrorNonEmpty = not . null . compileErrorMessage
8886
89−showError :: UnifyError -> String
90−showError (UnifyError msg Nothing _) = msg
91−showError (UnifyError msg (Just (ValueError val)) _) = "Error in value " ++ prettyPrintValue val ++ "\n" ++ msg
92−showError (UnifyError msg (Just (TypeError ty)) _) = "Error in type " ++ prettyPrintType ty ++ "\n" ++ msg
87+showError :: CompileError -> String
88+showError (CompileError msg Nothing _) = msg
89+showError (CompileError msg (Just (ValueError val)) _) = "Error in value " ++ prettyPrintValue val ++ "\n" ++ msg
90+showError (CompileError msg (Just (TypeError ty)) _) = "Error in type " ++ prettyPrintType ty ++ "\n" ++ msg
9391
94−mkUnifyErrorStack :: String -> Maybe UnifyErrorSource -> UnifyErrorStack
95−mkUnifyErrorStack msg t = UnifyErrorStack [UnifyError msg t Nothing]
92+mkUnifyErrorStack :: String -> Maybe ErrorSource -> ErrorStack
93+mkUnifyErrorStack msg t = ErrorStack [CompileError msg t Nothing]
9694
97−positionError :: SourcePos -> UnifyErrorStack
98−positionError pos = UnifyErrorStack [UnifyError "" Nothing (Just pos)]
95+positionError :: SourcePos -> ErrorStack
96+positionError pos = ErrorStack [CompileError "" Nothing (Just pos)]