9d44e1b · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Merge pull request #1624 from purescript/1596

9d44e1bPhil Freeman11 years ago

src/Language/PureScript/Errors.hs+7−9

compare with golang

unifiedsplit

@@ -32,7 +32,7 @@ import Control.Monad

32import Control.Monad.Writer

33import Control.Monad.Error.Class (MonadError(..))

34import Control.Monad.Trans.State.Lazy

35−import Control.Arrow(first)

35+import Control.Arrow (first)

37import Language.PureScript.Crash

38import Language.PureScript.AST

@@ -938,20 +938,18 @@ renderBox = unlines . map trimEnd . lines . Box.render

938 where

939 trimEnd = reverse . dropWhile (== ' ') . reverse

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 :: (Functor m, 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

159 importExplicit :: Imports -> DeclarationRef -> m Imports

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

163 values' <- updateImports (importedValues imp) showIdent (exportedValues exps) name

164 return $ imp { importedValues = values' }

src/Language/PureScript/TypeChecker/Monad.hs+3−3

@@ -211,21 +211,21 @@ freshDictionaryName = do

211

212-- | Run a computation in the substitution monad, generating a return value and the final substitution.

213liftUnify ::

214− (MonadState CheckState m, MonadWriter MultipleErrors m) =>

214+ (Functor m, MonadState CheckState m, MonadWriter MultipleErrors m, MonadError MultipleErrors m) =>

215 m a ->

216 m (a, Substitution)

217liftUnify = liftUnifyWarnings (const id)

218

219-- | Run a computation in the substitution monad, generating a return value, the final substitution and updating warnings values.

220liftUnifyWarnings ::

221− (MonadState CheckState m, MonadWriter MultipleErrors m) =>

221+ (Functor m, MonadState CheckState m, MonadWriter MultipleErrors m, MonadError MultipleErrors m) =>

222 (Substitution -> ErrorMessage -> ErrorMessage) ->

223 m a ->

224 m (a, Substitution)

225liftUnifyWarnings replace ma = do

226 orig <- get

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

230 tell . onErrorMessages (replace subst) $ w

231 modify $ \st -> st { checkSubstitution = checkSubstitution orig }