Fix #1732, calculate type map separately for each error

purescript · Dec 20, 2015 · 33851dc · 33851dc
1 parent 1e8f4aa
commit 33851dc
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 19 deletions.
diff --git a/psc/JSON.hs b/psc/JSON.hs
@@ -53,7 +53,7 @@ toJSONErrors verbose level = map (toJSONError verbose level) . P.runMultipleErro
 toJSONError :: Bool -> P.Level -> P.ErrorMessage -> JSONError
 toJSONError verbose level e =
   JSONError (toErrorPosition <$> sspan)
-            (P.renderBox (P.prettyPrintSingleError' verbose level (P.stripModuleAndSpan e)))
+            (P.renderBox (P.prettyPrintSingleError verbose level (P.stripModuleAndSpan e)))
             (P.errorCode e)
             (P.spanName <$> sspan)
             (P.runModuleName <$> P.errorModule e)

diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs
@@ -412,14 +412,11 @@ onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse
   gHint (ErrorInInstance cl ts) = ErrorInInstance cl <$> traverse f ts
   gHint other = pure other
 
-prettyPrintSingleError' :: Bool -> Level -> ErrorMessage ->Box.Box
-prettyPrintSingleError' full level = flip evalState defaultUnknownMap . prettyPrintSingleError full level
-
 -- |
 -- Pretty print a single error, simplifying if necessary
 --
-prettyPrintSingleError :: Bool -> Level -> ErrorMessage -> State TypeMap Box.Box
-prettyPrintSingleError full level e = do
+prettyPrintSingleError :: Bool -> Level -> ErrorMessage -> Box.Box
+prettyPrintSingleError full level e = flip evalState defaultUnknownMap $ do
   em <- onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)
   um <- get
   return (prettyPrintErrorMessage um em)
@@ -1061,22 +1058,21 @@ prettyPrintMultipleWarnings full = renderBox . prettyPrintMultipleWarningsBox fu
 
 -- | Pretty print warnings as a Box
 prettyPrintMultipleWarningsBox :: Bool -> MultipleErrors -> Box.Box
-prettyPrintMultipleWarningsBox full = flip evalState defaultUnknownMap . prettyPrintMultipleErrorsWith Warning "Warning found:" "Warning" full
+prettyPrintMultipleWarningsBox full = prettyPrintMultipleErrorsWith Warning "Warning found:" "Warning" full
 
 -- | Pretty print errors as a Box
 prettyPrintMultipleErrorsBox :: Bool -> MultipleErrors -> Box.Box
-prettyPrintMultipleErrorsBox full = flip evalState defaultUnknownMap . prettyPrintMultipleErrorsWith Error "Error found:" "Error" full
-
-prettyPrintMultipleErrorsWith :: Level -> String -> String -> Bool -> MultipleErrors -> State TypeMap Box.Box
-prettyPrintMultipleErrorsWith level intro _ full  (MultipleErrors [e]) = do
-  result <- prettyPrintSingleError full level e
-  return $
-    Box.vcat Box.left [ Box.text intro
-                      , result
-                      ]
-prettyPrintMultipleErrorsWith level _ intro full  (MultipleErrors es) = do
-  result <- forM es $ prettyPrintSingleError full level
-  return $ Box.vsep 1 Box.left $ concat $ zipWith withIntro [1 :: Int ..] result
+prettyPrintMultipleErrorsBox full = prettyPrintMultipleErrorsWith Error "Error found:" "Error" full
+
+prettyPrintMultipleErrorsWith :: Level -> String -> String -> Bool -> MultipleErrors -> Box.Box
+prettyPrintMultipleErrorsWith level intro _ full (MultipleErrors [e]) =
+  let result = prettyPrintSingleError full level e
+  in Box.vcat Box.left [ Box.text intro
+                       , result
+                       ]
+prettyPrintMultipleErrorsWith level _ intro full (MultipleErrors es) =
+  let result = map (prettyPrintSingleError full level) es
+  in Box.vsep 1 Box.left $ concat $ zipWith withIntro [1 :: Int ..] result
   where
   withIntro i err = [ Box.text (intro ++ " " ++ show i ++ " of " ++ show (length es) ++ ":")
                     , Box.moveRight 2 err