git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Make compilation error type names generic
f568d7dGary Burgess
src/Language/PureScript/Errors.hs+24−26
@@ -22,14 +22,13 @@ import Data.Monoid
22import Control.Monad.Error
22import Control.Monad.Error
23
23
24import Language.PureScript.Declarations
24import Language.PureScript.Declarations
25−import Language.PureScript.Options
26import Language.PureScript.Pretty
25import Language.PureScript.Pretty
27import Language.PureScript.Types
26import Language.PureScript.Types
28
27
29-- |
28-- |
30-- Type for sources of type checking errors
29-- Type for sources of type checking errors
31--
30--
32−data UnifyErrorSource
31+data ErrorSource
33 -- |
32 -- |
34 -- An error which originated at a Value
33 -- An error which originated at a Value
35 --
34 --
@@ -40,42 +39,41 @@ data UnifyErrorSource
40 | TypeError Type deriving (Show)
39 | TypeError Type deriving (Show)
41
40
42-- |
41-- |
43−-- Unification errors
42+-- Compilation errors
44--
43--
45−data UnifyError = UnifyError {
44+data CompileError = CompileError {
46 -- |
45 -- |
47 -- Error message
46 -- Error message
48 --
47 --
49− unifyErrorMessage :: String
48+ compileErrorMessage :: String
50 -- |
49 -- |
51 -- The value where the error occurred
50 -- The value where the error occurred
52 --
51 --
53− , unifyErrorValue :: Maybe UnifyErrorSource
52+ , compileErrorValue :: Maybe ErrorSource
54 -- |
53 -- |
55 -- Optional source position information
54 -- Optional source position information
56 --
55 --
57− , unifyErrorPosition :: Maybe SourcePos
56+ , compileErrorPosition :: Maybe SourcePos
58 } deriving (Show)
57 } deriving (Show)
59
58
60-- |
59-- |
61-- A stack trace for an error
60-- A stack trace for an error
62--
61--
63−newtype UnifyErrorStack = UnifyErrorStack { runUnifyErrorStack :: [UnifyError] } deriving (Show, Monoid)
62+newtype ErrorStack = ErrorStack { runUnifyErrorStack :: [CompileError] } deriving (Show, Monoid)
64
63
65−instance Error UnifyErrorStack where
64+instance Error ErrorStack where
66− strMsg s = UnifyErrorStack [UnifyError s Nothing Nothing]
65+ strMsg s = ErrorStack [CompileError s Nothing Nothing]
67− noMsg = UnifyErrorStack []
66+ noMsg = ErrorStack []
68
67
69−prettyPrintUnifyErrorStack :: Options -> UnifyErrorStack -> String
68+prettyPrintErrorStack :: Bool -> ErrorStack -> String
70−prettyPrintUnifyErrorStack opts (UnifyErrorStack es) =
69+prettyPrintErrorStack printAll (ErrorStack es) =
71− case mconcat $ map (Last . unifyErrorPosition) es of
70+ case mconcat $ map (Last . compileErrorPosition) es of
72 Last (Just sourcePos) -> "Error at " ++ show sourcePos ++ ": \n" ++ prettyPrintUnifyErrorStack'
71 Last (Just sourcePos) -> "Error at " ++ show sourcePos ++ ": \n" ++ prettyPrintUnifyErrorStack'
73 _ -> prettyPrintUnifyErrorStack'
72 _ -> prettyPrintUnifyErrorStack'
74 where
73 where
75 prettyPrintUnifyErrorStack' :: String
74 prettyPrintUnifyErrorStack' :: String
76 prettyPrintUnifyErrorStack'
75 prettyPrintUnifyErrorStack'
77− | optionsVerboseErrors opts =
78− intercalate "\n" (map showError (filter isErrorNonEmpty es))
76+ | printAll = intercalate "\n" (map showError (filter isErrorNonEmpty es))
79 | otherwise =
77 | otherwise =
80 let
78 let
81 es' = filter isErrorNonEmpty es
79 es' = filter isErrorNonEmpty es
@@ -83,16 +81,16 @@ prettyPrintUnifyErrorStack opts (UnifyErrorStack es) =
83 1 -> showError (head es')
81 1 -> showError (head es')
84 _ -> showError (head es') ++ "\n" ++ showError (last es')
82 _ -> showError (head es') ++ "\n" ++ showError (last es')
85
83
86−isErrorNonEmpty :: UnifyError -> Bool
84+isErrorNonEmpty :: CompileError -> Bool
87−isErrorNonEmpty = not . null . unifyErrorMessage
85+isErrorNonEmpty = not . null . compileErrorMessage
88
86
89−showError :: UnifyError -> String
87+showError :: CompileError -> String
90−showError (UnifyError msg Nothing _) = msg
88+showError (CompileError msg Nothing _) = msg
91−showError (UnifyError msg (Just (ValueError val)) _) = "Error in value " ++ prettyPrintValue val ++ "\n" ++ msg
89+showError (CompileError 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
90+showError (CompileError msg (Just (TypeError ty)) _) = "Error in type " ++ prettyPrintType ty ++ "\n" ++ msg
93
91
94−mkUnifyErrorStack :: String -> Maybe UnifyErrorSource -> UnifyErrorStack
92+mkUnifyErrorStack :: String -> Maybe ErrorSource -> ErrorStack
95−mkUnifyErrorStack msg t = UnifyErrorStack [UnifyError msg t Nothing]
93+mkUnifyErrorStack msg t = ErrorStack [CompileError msg t Nothing]
96
94
97−positionError :: SourcePos -> UnifyErrorStack
95+positionError :: SourcePos -> ErrorStack
98−positionError pos = UnifyErrorStack [UnifyError "" Nothing (Just pos)]
96+positionError pos = ErrorStack [CompileError "" Nothing (Just pos)]
src/Language/PureScript/TypeChecker/Monad.hs+4−4
@@ -135,8 +135,8 @@ data CheckState = CheckState {
135-- |
135-- |
136-- The type checking monad, which provides the state of the type checker, and error reporting capabilities
136-- The type checking monad, which provides the state of the type checker, and error reporting capabilities
137--
137--
138−newtype Check a = Check { unCheck :: StateT CheckState (Either UnifyErrorStack) a }
138+newtype Check a = Check { unCheck :: StateT CheckState (Either ErrorStack) a }
139− deriving (Functor, Monad, Applicative, MonadPlus, MonadState CheckState, MonadError UnifyErrorStack)
139+ deriving (Functor, Monad, Applicative, MonadPlus, MonadState CheckState, MonadError ErrorStack)
140
140
141-- |
141-- |
142-- Get the current @Environment@
142-- Get the current @Environment@
@@ -166,7 +166,7 @@ runCheck opts = runCheck' opts initEnvironment
166-- Run a computation in the Check monad, failing with an error, or succeeding with a return value and the final @Environment@.
166-- Run a computation in the Check monad, failing with an error, or succeeding with a return value and the final @Environment@.
167--
167--
168runCheck' :: Options -> Environment -> Check a -> Either String (a, Environment)
168runCheck' :: Options -> Environment -> Check a -> Either String (a, Environment)
169−runCheck' opts env c = either (Left . prettyPrintUnifyErrorStack opts) Right $ do
169+runCheck' opts env c = either (Left . prettyPrintErrorStack (optionsVerboseErrors opts)) Right $ do
170 (a, s) <- flip runStateT (CheckState env 0 0 Nothing) $ unCheck c
170 (a, s) <- flip runStateT (CheckState env 0 0 Nothing) $ unCheck c
171 return (a, checkEnv s)
171 return (a, checkEnv s)
172
172
@@ -186,7 +186,7 @@ rethrow f = flip catchError $ \e -> throwError (f e)
186-- |
186-- |
187-- Rethrow an error with source position information
187-- Rethrow an error with source position information
188--
188--
189−rethrowWithPosition :: (MonadError UnifyErrorStack m) => SourcePos -> m a -> m a
189+rethrowWithPosition :: (MonadError ErrorStack m) => SourcePos -> m a -> m a
190rethrowWithPosition pos = rethrow (positionError pos <>)
190rethrowWithPosition pos = rethrow (positionError pos <>)
191
191
192-- |
192-- |