git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix #1596, don't show type checker warnings in the event of an error
f8d6c48Phil Freeman
src/Language/PureScript/Errors.hs+7−9
@@ -32,7 +32,7 @@ import Control.Monad
32import Control.Monad.Writer
32import Control.Monad.Writer
33import Control.Monad.Error.Class (MonadError(..))
33import Control.Monad.Error.Class (MonadError(..))
34import Control.Monad.Trans.State.Lazy
34import Control.Monad.Trans.State.Lazy
35−import Control.Arrow(first)
35+import Control.Arrow (first)
36
36
37import Language.PureScript.Crash
37import Language.PureScript.Crash
38import Language.PureScript.AST
38import Language.PureScript.AST
@@ -938,20 +938,18 @@ renderBox = unlines . map trimEnd . lines . Box.render
938 where
938 where
939 trimEnd = reverse . dropWhile (== ' ') . reverse
939 trimEnd = reverse . dropWhile (== ' ') . reverse
940
940
941−-- |
942−-- Interpret multiple errors and warnings in a monad supporting errors and warnings
943−--
944−interpretMultipleErrorsAndWarnings :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m) => (Either MultipleErrors a, MultipleErrors) -> m a
945−interpretMultipleErrorsAndWarnings (err, ws) = do
946− tell ws
947− either throwError return err
948−
949-- |
941-- |
950-- Rethrow an error with a more detailed error message in the case of failure
942-- Rethrow an error with a more detailed error message in the case of failure
951--
943--
952rethrow :: (MonadError e m) => (e -> e) -> m a -> m a
944rethrow :: (MonadError e m) => (e -> e) -> m a -> m a
953rethrow f = flip catchError $ \e -> throwError (f e)
945rethrow f = flip catchError $ \e -> throwError (f e)
954
946
947+reifyErrors :: (MonadError e m) => m a -> m (Either e a)
948+reifyErrors ma = catchError (fmap Right ma) (return . Left)
949+
950+reflectErrors :: (MonadError e m) => m (Either e a) -> m a
951+reflectErrors ma = ma >>= either throwError return
952+
955warnAndRethrow :: (MonadError e m, MonadWriter e m) => (e -> e) -> m a -> m a
953warnAndRethrow :: (MonadError e m, MonadWriter e m) => (e -> e) -> m a -> m a
956warnAndRethrow f = rethrow f . censor f
954warnAndRethrow f = rethrow f . censor f
957
955
src/Language/PureScript/Sugar/Names/Imports.hs+1−1
@@ -158,7 +158,7 @@ resolveImport currentModule importModule exps imps impQual =
158 -- Import something explicitly
158 -- Import something explicitly
159 importExplicit :: Imports -> DeclarationRef -> m Imports
159 importExplicit :: Imports -> DeclarationRef -> m Imports
160 importExplicit imp (PositionedDeclarationRef pos _ r) =
160 importExplicit imp (PositionedDeclarationRef pos _ r) =
161− rethrowWithPosition pos . warnWithPosition pos $ importExplicit imp r
161+ warnAndRethrowWithPosition pos $ importExplicit imp r
162 importExplicit imp (ValueRef name) = do
162 importExplicit imp (ValueRef name) = do
163 values' <- updateImports (importedValues imp) showIdent (exportedValues exps) name
163 values' <- updateImports (importedValues imp) showIdent (exportedValues exps) name
164 return $ imp { importedValues = values' }
164 return $ imp { importedValues = values' }
src/Language/PureScript/TypeChecker/Monad.hs+3−3
@@ -211,21 +211,21 @@ freshDictionaryName = do
211
211
212-- | Run a computation in the substitution monad, generating a return value and the final substitution.
212-- | Run a computation in the substitution monad, generating a return value and the final substitution.
213liftUnify ::
213liftUnify ::
214− (MonadState CheckState m, MonadWriter MultipleErrors m) =>
214+ (MonadState CheckState m, MonadWriter MultipleErrors m, MonadError MultipleErrors m) =>
215 m a ->
215 m a ->
216 m (a, Substitution)
216 m (a, Substitution)
217liftUnify = liftUnifyWarnings (const id)
217liftUnify = liftUnifyWarnings (const id)
218
218
219-- | Run a computation in the substitution monad, generating a return value, the final substitution and updating warnings values.
219-- | Run a computation in the substitution monad, generating a return value, the final substitution and updating warnings values.
220liftUnifyWarnings ::
220liftUnifyWarnings ::
221− (MonadState CheckState m, MonadWriter MultipleErrors m) =>
221+ (MonadState CheckState m, MonadWriter MultipleErrors m, MonadError MultipleErrors m) =>
222 (Substitution -> ErrorMessage -> ErrorMessage) ->
222 (Substitution -> ErrorMessage -> ErrorMessage) ->
223 m a ->
223 m a ->
224 m (a, Substitution)
224 m (a, Substitution)
225liftUnifyWarnings replace ma = do
225liftUnifyWarnings replace ma = do
226 orig <- get
226 orig <- get
227 modify $ \st -> st { checkSubstitution = emptySubstitution }
227 modify $ \st -> st { checkSubstitution = emptySubstitution }
228− (a, w) <- censor (const mempty) . listen $ ma
228+ (a, w) <- reflectErrors . censor (const mempty) . reifyErrors . listen $ ma
229 subst <- gets checkSubstitution
229 subst <- gets checkSubstitution
230 tell . onErrorMessages (replace subst) $ w
230 tell . onErrorMessages (replace subst) $ w
231 modify $ \st -> st { checkSubstitution = checkSubstitution orig }
231 modify $ \st -> st { checkSubstitution = checkSubstitution orig }