1e4a776 · rowtype-yoga/purescript-native

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

on golang help sign in

Simplify unification variables in error messages

1e4a776Balaji R. Rao12 years ago

src/Language/PureScript/Errors.hs+70−20

compare with golang

unifiedsplit

@@ -19,14 +19,16 @@

19module Language.PureScript.Errors where

21import Data.Either (lefts, rights)

22−import Data.List (intercalate)

22+import Data.List (intercalate, elemIndex)

23import Data.Monoid

24import Data.Foldable (fold, foldMap)

26import Control.Monad

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

28import Control.Monad.Unify

29−import Control.Applicative ((<$>))

29+import Control.Applicative ((<$>), (<*>), Applicative, pure)

30+import Control.Monad.Trans.State.Lazy

31+import Control.Arrow(first)

31import Language.PureScript.AST

33import Language.PureScript.AST

32import Language.PureScript.Pretty

34import Language.PureScript.Pretty

@@ -250,12 +252,55 @@ errorMessage err = MultipleErrors [err]

250onErrorMessages :: (ErrorMessage -> ErrorMessage) -> MultipleErrors -> MultipleErrors

252onErrorMessages :: (ErrorMessage -> ErrorMessage) -> MultipleErrors -> MultipleErrors

251onErrorMessages f = MultipleErrors . map f . runMultipleErrors

253onErrorMessages f = MultipleErrors . map f . runMultipleErrors

252

254

255+replaceUnknowns :: Type -> State [Unknown] Type

256+replaceUnknowns = everywhereOnTypesM replaceUnknowns'

257+ where

258+ lookupTable :: Unknown -> [Unknown] -> (Unknown, [Unknown])

259+ lookupTable x table = case (elemIndex x table) of

260+ Nothing -> (length table, table ++ [x])

261+ Just i -> (i, table)

262+

263+ replaceUnknowns' :: Type -> State [Unknown] Type

264+ replaceUnknowns' (TUnknown u) = state $ first TUnknown . lookupTable u

265+ replaceUnknowns' other = return other

266+

267+

268+onTypesInErrorMessageM :: (Applicative m) => (Type -> m Type) -> ErrorMessage -> m ErrorMessage

269+onTypesInErrorMessageM f = g

270+ where

271+ g (InfiniteType t) = InfiniteType <$> (f t)

272+ g (TypesDoNotUnify t1 t2) = TypesDoNotUnify <$> (f t1) <*> (f t2)

273+ g (ConstrainedTypeUnified t1 t2) = ConstrainedTypeUnified <$> (f t1) <*> (f t2)

274+ g (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> (f t)

275+ g (PropertyIsMissing s t) = PropertyIsMissing s <$> (f t)

276+ g (ErrorUnifyingTypes t1 t2 e) = ErrorUnifyingTypes <$> (f t1) <*> (f t2) <*> (g e)

277+ g (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> (pure e)

278+ g (InvalidInstanceHead t) = InvalidInstanceHead <$> f t

279+ g (ErrorInSubsumption t1 t2 em) = ErrorInSubsumption <$> (f t1) <*> (f t2) <*> (g em)

280+ g (ErrorCheckingType e t em) = ErrorCheckingType e <$> (f t) <*> (g em)

281+ g (ErrorCheckingKind t em) = ErrorCheckingKind <$> (f t) <*> g em

282+ g (ErrorInApplication e1 t1 e2 em) = ErrorInApplication e1 <$> (f t1) <*> (pure e2) <*> (g em)

283+ g (NotYetDefined x e) = NotYetDefined x <$> (g e)

284+ g (ErrorInExpression x e) = ErrorInExpression x <$> (g e)

285+ g (ErrorInModule x e) = ErrorInModule x <$> (g e)

286+ g (ErrorInInstance x y e) = ErrorInInstance x y <$> (g e)

287+ g (ErrorInferringType x e) = ErrorInferringType x <$> (g e)

288+ g (ErrorInDataConstructor x e) = ErrorInDataConstructor x <$> (g e)

289+ g (ErrorInTypeConstructor x e) = ErrorInTypeConstructor x <$> (g e)

290+ g (ErrorInBindingGroup x e) = ErrorInBindingGroup x <$> (g e)

291+ g (ErrorInDataBindingGroup e) = ErrorInDataBindingGroup <$> (g e)

292+ g (ErrorInTypeSynonym x e) = ErrorInTypeSynonym x <$> (g e)

293+ g (ErrorInValueDeclaration x e) = ErrorInValueDeclaration x <$> (g e)

294+ g (ErrorInForeignImport x e) = ErrorInForeignImport x <$> (g e)

295+ g (PositionedError x e) = PositionedError x <$> (g e)

296+ g other = pure other

297+

253-- |

298-- |

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

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

255--

300--

256−prettyPrintSingleError :: Bool -> ErrorMessage -> Box.Box

301+prettyPrintSingleError :: Bool -> ErrorMessage -> State [Unknown] Box.Box

257−prettyPrintSingleError full e = prettyPrintErrorMessage (if full then e else simplifyErrorMessage e)

302+prettyPrintSingleError full e = prettyPrintErrorMessage <$> onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)

258− where

303+ where

259 -- |

304 -- |

260 -- Pretty print an ErrorMessage

305 -- Pretty print an ErrorMessage

261 --

306 --

@@ -514,32 +559,37 @@ prettyPrintSingleError full e = prettyPrintErrorMessage (if full then e else sim

514 unwrap pos (NotYetDefined ns err) = NotYetDefined ns (unwrap pos err)

559 unwrap pos (NotYetDefined ns err) = NotYetDefined ns (unwrap pos err)

515 unwrap _ (PositionedError pos err) = unwrap (Just pos) err

560 unwrap _ (PositionedError pos err) = unwrap (Just pos) err

516 unwrap pos other = wrap pos other

561 unwrap pos other = wrap pos other

517−

562+

518 wrap :: Maybe SourceSpan -> ErrorMessage -> ErrorMessage

563 wrap :: Maybe SourceSpan -> ErrorMessage -> ErrorMessage

519 wrap Nothing = id

564 wrap Nothing = id

520 wrap (Just pos) = PositionedError pos

565 wrap (Just pos) = PositionedError pos

521

566

567+

522-- |

568-- |

523-- Pretty print multiple errors

569-- Pretty print multiple errors

524--

570--

525prettyPrintMultipleErrors :: Bool -> MultipleErrors -> String

571prettyPrintMultipleErrors :: Bool -> MultipleErrors -> String

526−prettyPrintMultipleErrors = prettyPrintMultipleErrorsWith "Error:" "Multiple errors:"

572+prettyPrintMultipleErrors full = flip evalState [] . prettyPrintMultipleErrorsWith "Error:" "Multiple errors:" full

527−

573+

528-- |

574-- |

529-- Pretty print multiple warnings

575-- Pretty print multiple warnings

530--

576--

531−prettyPrintMultipleWarnings :: Bool -> MultipleErrors -> String

577+prettyPrintMultipleWarnings :: Bool -> MultipleErrors -> String

532−prettyPrintMultipleWarnings = prettyPrintMultipleErrorsWith "Warning:" "Multiple warnings:"

578+prettyPrintMultipleWarnings full = flip evalState [] . prettyPrintMultipleErrorsWith "Warning:" "Multiple warnings:" full

533−

579+

534−prettyPrintMultipleErrorsWith :: String -> String -> Bool -> MultipleErrors -> String

580+prettyPrintMultipleErrorsWith :: String -> String -> Bool -> MultipleErrors -> State [Unknown] String

535−prettyPrintMultipleErrorsWith intro _ full (MultipleErrors [e]) = renderBox $

581+prettyPrintMultipleErrorsWith intro _ full (MultipleErrors [e]) = do

582+ result <- prettyPrintSingleError full e

583+ return $ renderBox $

536− Box.vcat Box.left [ Box.text intro

584+ Box.vcat Box.left [ Box.text intro

537− , prettyPrintSingleError full e

585+ , result

538− ]

586+ ]

539−prettyPrintMultipleErrorsWith _ intro full (MultipleErrors es) = renderBox $

587+prettyPrintMultipleErrorsWith _ intro full (MultipleErrors es) = do

540− Box.vcat Box.left [ Box.text intro

541− , Box.vsep 1 Box.left $ map (Box.moveRight 2 . prettyPrintSingleError full) es

588+ result <- forM es $ (liftM $ Box.moveRight 2) . prettyPrintSingleError full

589+ return $ renderBox $

590+ Box.vcat Box.left [ Box.text intro

591+ , Box.vsep 1 Box.left result

542− ]

592+ ]

543

593

544renderBox :: Box.Box -> String

594renderBox :: Box.Box -> String

545renderBox = unlines . map trimEnd . lines . Box.render

595renderBox = unlines . map trimEnd . lines . Box.render