ce97433 · rowtype-yoga/purescript-native

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

on golang help sign in

Fix #1802, fix #1797, remove redundant hints and whitespace in errors

ce97433Phil Freeman11 years ago

src/Language/PureScript/Errors.hs+39−11

compare with golang

unifiedsplit

@@ -1,6 +1,5 @@

1{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2{-# LANGUAGE FlexibleContexts #-}

3−{-# LANGUAGE RecordWildCards #-}

4{-# LANGUAGE MultiParamTypeClasses #-}

3{-# LANGUAGE MultiParamTypeClasses #-}

6module Language.PureScript.Errors where

5module Language.PureScript.Errors where

@@ -9,6 +8,7 @@ import Prelude ()

9import Prelude.Compat

8import Prelude.Compat

11import Data.Ord (comparing)

10import Data.Ord (comparing)

11+import Data.Char (isSpace)

12import Data.Either (lefts, rights)

13import Data.List (intercalate, transpose, nub, nubBy, sortBy)

14import Data.Foldable (fold)

@@ -412,11 +412,9 @@ onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse

412 gHint (ErrorInInstance cl ts) = ErrorInInstance cl <$> traverse f ts

413 gHint other = pure other

414

415−

416wikiUri :: ErrorMessage -> String

415wikiUri :: ErrorMessage -> String

417wikiUri e = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ errorCode e

416wikiUri e = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ errorCode e

418

417

419−

420-- |

418-- |

421-- Pretty print a single error, simplifying if necessary

419-- Pretty print a single error, simplifying if necessary

422--

420--

@@ -432,17 +430,17 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

432 prettyPrintErrorMessage typeMap (ErrorMessage hints simple) =

430 prettyPrintErrorMessage typeMap (ErrorMessage hints simple) =

433 paras $

431 paras $

434 [ foldr renderHint (indent (renderSimpleErrorMessage simple)) hints

432 [ foldr renderHint (indent (renderSimpleErrorMessage simple)) hints

435− , Box.moveDown 1 typeInformation

436 ] ++

433 ] ++

434+ maybe [] (return . Box.moveDown 1) typeInformation ++

437 [ Box.moveDown 1 $ paras [ line $ "See " ++ wikiUri e ++ " for more information, "

435 [ Box.moveDown 1 $ paras [ line $ "See " ++ wikiUri e ++ " for more information, "

438 , line $ "or to contribute content related to this " ++ levelText ++ "."

436 , line $ "or to contribute content related to this " ++ levelText ++ "."

439 ]

437 ]

440− | showWiki

438+ | showWiki

441 ]

439 ]

442 where

440 where

443− typeInformation :: Box.Box

441+ typeInformation :: Maybe Box.Box

444− typeInformation | not (null types) = Box.hsep 1 Box.left [ line "where", paras types]

442+ typeInformation | not (null types) = Just $ Box.hsep 1 Box.left [ line "where", paras types ]

445− | otherwise = Box.emptyBox 0 0

443+ | otherwise = Nothing

446 where

444 where

447 types :: [Box.Box]

445 types :: [Box.Box]

448 types = map skolemInfo (M.elems (umSkolemMap typeMap)) ++

446 types = map skolemInfo (M.elems (umSkolemMap typeMap)) ++

@@ -1026,7 +1024,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

1026 where

1024 where

1027 -- Take the last instance of each "hint category"

1025 -- Take the last instance of each "hint category"

1028 simplifyHints :: [ErrorMessageHint] -> [ErrorMessageHint]

1026 simplifyHints :: [ErrorMessageHint] -> [ErrorMessageHint]

1029− simplifyHints = reverse . nubBy categoriesEqual . reverse

1027+ simplifyHints = reverse . nubBy categoriesEqual . stripRedudantHints simple . reverse

1030

1028

1031 -- Don't remove hints in the "other" category

1029 -- Don't remove hints in the "other" category

1032 categoriesEqual :: ErrorMessageHint -> ErrorMessageHint -> Bool

1030 categoriesEqual :: ErrorMessageHint -> ErrorMessageHint -> Bool

@@ -1036,6 +1034,30 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

1036 (_, OtherHint) -> False

1034 (_, OtherHint) -> False

1037 (c1, c2) -> c1 == c2

1035 (c1, c2) -> c1 == c2

1038

1036

1037+ -- | See https://github.com/purescript/purescript/issues/1802

1038+ stripRedudantHints :: SimpleErrorMessage -> [ErrorMessageHint] -> [ErrorMessageHint]

1039+ stripRedudantHints CannotApplyFunction{} = stripFirst isApplicationHint

1040+ where

1041+ isApplicationHint ErrorInApplication{} = True

1042+ isApplicationHint _ = False

1043+ stripRedudantHints ExprDoesNotHaveType{} = stripFirst isCheckHint

1044+ where

1045+ isCheckHint ErrorCheckingType{} = True

1046+ isCheckHint _ = False

1047+ stripRedudantHints TypesDoNotUnify{} = stripFirst isUnifyHint

1048+ where

1049+ isUnifyHint ErrorUnifyingTypes{} = True

1050+ isUnifyHint _ = False

1051+ stripRedudantHints _ = id

1052+

1053+ stripFirst :: (ErrorMessageHint -> Bool) -> [ErrorMessageHint] -> [ErrorMessageHint]

1054+ stripFirst p (PositionedError pos : hs) = PositionedError pos : stripFirst p hs

1055+ stripFirst p (ErrorInModule mn : hs) = ErrorInModule mn : stripFirst p hs

1056+ stripFirst p (hint : hs)

1057+ | p hint = hs

1058+ | otherwise = hint : hs

1059+ stripFirst _ [] = []

1060+

1039 hintCategory :: ErrorMessageHint -> HintCategory

1061 hintCategory :: ErrorMessageHint -> HintCategory

1040 hintCategory ErrorCheckingType{} = ExprHint

1062 hintCategory ErrorCheckingType{} = ExprHint

1041 hintCategory ErrorInferringType{} = ExprHint

1063 hintCategory ErrorInferringType{} = ExprHint

@@ -1137,9 +1159,15 @@ line :: String -> Box.Box

1137line = Box.text

1159line = Box.text

1138

1160

1139renderBox :: Box.Box -> String

1161renderBox :: Box.Box -> String

1140−renderBox = unlines . map trimEnd . lines . Box.render

1162+renderBox = unlines

1163+ . map (dropWhileEnd isSpace)

1164+ . dropWhile whiteSpace

1165+ . dropWhileEnd whiteSpace

1166+ . lines

1167+ . Box.render

1141 where

1168 where

1142− trimEnd = reverse . dropWhile (== ' ') . reverse

1169+ dropWhileEnd p = reverse . dropWhile p . reverse

1170+ whiteSpace = all isSpace

1143

1171

1144-- |

1172-- |

1145-- Rethrow an error with a more detailed error message in the case of failure

1173-- Rethrow an error with a more detailed error message in the case of failure