Multiple errors during name resolution

examples/failing/MultipleErrors2.purs

@@ -0,0 +1,5 @@
+module MultipleErrors2 where
+
+foo = itDoesntExist
+
+bar = neitherDoesThis

src/Language/PureScript/Errors.hs

@@ -16,10 +16,12 @@
 
 module Language.PureScript.Errors where
 
+import Data.Either (lefts, rights)
 import Data.List (intersperse, intercalate)
 import Data.Monoid
 
 import Control.Monad.Error
+import Control.Applicative ((<$>))
 
 import Language.PureScript.Declarations
 import Language.PureScript.Pretty
@@ -121,3 +123,18 @@ rethrow f = flip catchError $ \e -> throwError (f e)
 --
 rethrowWithPosition :: (MonadError ErrorStack m) => SourcePos -> m a -> m a
 rethrowWithPosition pos = rethrow (positionError pos <>)
+
+-- |
+-- Collect errors in in parallel
+--
+parU :: (MonadError ErrorStack m, Functor m) => [a] -> (a -> m b) -> m [b]
+parU xs f = forM xs (withError . f) >>= collectErrors
+  where
+  withError :: (MonadError ErrorStack m, Functor m) => m a -> m (Either ErrorStack a)
+  withError u = catchError (Right <$> u) (return . Left)
+
+  collectErrors :: (MonadError ErrorStack m, Functor m) => [Either ErrorStack a] -> m [a]
+  collectErrors es = case lefts es of
+    [err] -> throwError err
+    [] -> return $ rights es
+    errs -> throwError $ MultipleErrors errs

src/Language/PureScript/Sugar/Names.hs

@@ -176,7 +176,7 @@ elaborateExports exps (Module mn decls _) = Module mn decls (Just $
 --
 renameInModule :: ImportEnvironment -> ExportEnvironment -> Module -> Either ErrorStack Module
 renameInModule imports exports (Module mn decls exps) =
-  Module mn <$> mapM go decls <*> pure exps
+  Module mn <$> parU decls go <*> pure exps
   where
   (go, _, _, _, _) = everywhereWithContextOnValuesM (Nothing, []) updateDecl updateValue updateBinder updateCase defS
 

src/Language/PureScript/TypeChecker/Monad.hs

@@ -28,7 +28,6 @@ import Language.PureScript.Options
 import Language.PureScript.Errors
 
 import Data.Maybe
-import Data.Either (lefts, rights)
 
 import Control.Applicative
 import Control.Monad.State
@@ -233,19 +232,3 @@ liftUnify unify = do
   (a, ust) <- runUnify (defaultUnifyState { unifyNextVar = checkNextVar st }) unify
   modify $ \st' -> st' { checkNextVar = unifyNextVar ust }
   return (a, unifyCurrentSubstitution ust)
-
--- |
--- Typecheck in parallel
---
-parU :: [a] -> (a -> UnifyT t Check b) -> UnifyT t Check [b]
-parU xs f = forM xs (withError . f) >>= collectErrors
-  where
-  withError :: UnifyT t Check a -> UnifyT t Check (Either ErrorStack a)
-  withError u = catchError (Right <$> u) (return . Left)
-
-  collectErrors :: [Either ErrorStack a] -> UnifyT t Check [a]
-  collectErrors es = case lefts es of
-    [err] -> throwError err
-    [] -> return $ rights es
-    errs -> throwError $ MultipleErrors errs
-