b578d26 · rowtype-yoga/purescript-native

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

on golang help sign in

Nicer errors for skolemized types

b578d26Phil Freeman12 years ago

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

compare with golang

unifiedsplit

@@ -19,10 +19,13 @@

19module Language.PureScript.Errors where

21import Data.Either (lefts, rights)

22−import Data.List (intercalate, elemIndex)

22+import Data.List (intercalate)

23+import Data.Function (on)

23import Data.Monoid

24import Data.Monoid

24import Data.Foldable (fold, foldMap)

25import Data.Foldable (fold, foldMap)

27+import qualified Data.Map as M

28+

26import Control.Monad

29import Control.Monad

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

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

28import Control.Monad.Unify

31import Control.Monad.Unify

@@ -252,19 +255,22 @@ errorMessage err = MultipleErrors [err]

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

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

253onErrorMessages f = MultipleErrors . map f . runMultipleErrors

256onErrorMessages f = MultipleErrors . map f . runMultipleErrors

254

257

258+-- | A map from rigid type variable name/unknown variable pairs to new variables.

259+type UnknownMap = M.Map (Maybe String, Unknown) Unknown

260+

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

261+replaceUnknowns :: Type -> State UnknownMap Type

256replaceUnknowns = everywhereOnTypesM replaceUnknowns'

262replaceUnknowns = everywhereOnTypesM replaceUnknowns'

257 where

263 where

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

264+ lookupTable :: (Maybe String, Unknown) -> UnknownMap -> (Unknown, UnknownMap)

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

265+ lookupTable x m = case M.lookup x m of

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

266+ Nothing -> let i = length (filter (on (==) fst x) (M.keys m)) in (i, M.insert x i m)

261− Just i -> (i, table)

267+ Just i -> (i, m)

262−

268+

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

269+ replaceUnknowns' :: Type -> State UnknownMap Type

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

270+ replaceUnknowns' (TUnknown u) = state $ first TUnknown . lookupTable (Nothing, u)

271+ replaceUnknowns' (Skolem name s sko) = state $ first (flip (Skolem name) sko) . lookupTable (Just name, s)

265 replaceUnknowns' other = return other

272 replaceUnknowns' other = return other

266

273

267−

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

274onTypesInErrorMessageM :: (Applicative m) => (Type -> m Type) -> ErrorMessage -> m ErrorMessage

269onTypesInErrorMessageM f = g

275onTypesInErrorMessageM f = g

270 where

276 where

@@ -298,7 +304,7 @@ onTypesInErrorMessageM f = g

298-- |

304-- |

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

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

300--

306--

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

307+prettyPrintSingleError :: Bool -> ErrorMessage -> State UnknownMap Box.Box

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

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

303 where

309 where

304 -- |

310 -- |

@@ -569,15 +575,15 @@ prettyPrintSingleError full e = prettyPrintErrorMessage <$> onTypesInErrorMessag

569-- Pretty print multiple errors

575-- Pretty print multiple errors

570--

576--

571prettyPrintMultipleErrors :: Bool -> MultipleErrors -> String

577prettyPrintMultipleErrors :: Bool -> MultipleErrors -> String

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

578+prettyPrintMultipleErrors full = flip evalState M.empty . prettyPrintMultipleErrorsWith "Error:" "Multiple errors:" full

573

579

574-- |

580-- |

575-- Pretty print multiple warnings

581-- Pretty print multiple warnings

576--

582--

577prettyPrintMultipleWarnings :: Bool -> MultipleErrors -> String

583prettyPrintMultipleWarnings :: Bool -> MultipleErrors -> String

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

584+prettyPrintMultipleWarnings full = flip evalState M.empty . prettyPrintMultipleErrorsWith "Warning:" "Multiple warnings:" full

579

585

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

586+prettyPrintMultipleErrorsWith :: String -> String -> Bool -> MultipleErrors -> State UnknownMap String

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

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

582 result <- prettyPrintSingleError full e

588 result <- prettyPrintSingleError full e

583 return $ renderBox $

589 return $ renderBox $

src/Language/PureScript/Pretty/Types.hs+1−1

@@ -39,7 +39,7 @@ typeLiterals = mkPattern match

39 match (PrettyPrintObject row) = Just $ "{ " ++ prettyPrintRow row ++ " }"

40 match (PrettyPrintArray ty) = Just $ "[" ++ prettyPrintType ty ++ "]"

41 match (TypeConstructor ctor) = Just $ show ctor

42− match (TUnknown u) = Just $ 'u' : show u

42+ match (TUnknown u) = Just $ '_' : show u

43 match (Skolem name s _) = Just $ name ++ show s

44 match (ConstrainedType deps ty) = Just $ "(" ++ intercalate ", " (map (\(pn, ty') -> show pn ++ " " ++ unwords (map prettyPrintTypeAtom ty')) deps) ++ ") => " ++ prettyPrintType ty

45 match (SaturatedTypeSynonym name args) = Just $ show name ++ "<" ++ intercalate "," (map prettyPrintTypeAtom args) ++ ">"