3ca81cc · rowtype-yoga/purescript-native

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

Fix #2070, typed hole errors now include environment information

commit3ca81ccb35e48b0d49bb7b5580cf636663148068 authorPhil Freeman <paf31@cantab.net> dateSun 15 May 2016, 14:37 (10 years ago) parent11f4898

3 files changed+27−11

compare with golang

unifiedsplit

src/Language/PureScript/Errors.hs+18−7 src/Language/PureScript/Pretty/Types.hs+1−1 src/Language/PureScript/TypeChecker/Types.hs+8−3

src/Language/PureScript/Errors.hs+18−7

@@ -24,6 +24,7 @@ import Language.PureScript.Crash

2424import Language.PureScript.Kinds

2525import Language.PureScript.Names

2626import Language.PureScript.Pretty

27+import Language.PureScript.Traversals

2728import Language.PureScript.Types

2829import qualified Language.PureScript.Bundle as Bundle

2930import qualified Language.PureScript.Constants as C

@@ -112,7 +113,7 @@ data SimpleErrorMessage

112113 | ShadowedTypeVar String

113114 | UnusedTypeVar String

114115 | WildcardInferredType Type

115− | HoleInferredType String Type

116+ | HoleInferredType String Type [(Ident, Type)]

116117 | MissingTypeDeclaration Ident Type

117118 | OverlappingPattern [[Binder]] Bool

118119 | IncompleteExhaustivityCheck

@@ -395,7 +396,7 @@ onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse

395396 gSimple (ExpectedType ty k) = ExpectedType <$> f ty <*> pure k

396397 gSimple (OrphanInstance nm cl ts) = OrphanInstance nm cl <$> traverse f ts

397398 gSimple (WildcardInferredType ty) = WildcardInferredType <$> f ty

398− gSimple (HoleInferredType name ty) = HoleInferredType name <$> f ty

399+ gSimple (HoleInferredType name ty env) = HoleInferredType name <$> f ty <*> traverse (sndM f) env

399400 gSimple (MissingTypeDeclaration nm ty) = MissingTypeDeclaration nm <$> f ty

400401 gSimple (CannotGeneralizeRecursiveFunction nm ty) = CannotGeneralizeRecursiveFunction nm <$> f ty

401402

@@ -494,7 +495,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

494495 : foldMap (return . line . (" bound at " ++) . displayStartEndPos) ss

495496

496497 unknownInfo :: Int -> Box.Box

497− unknownInfo u = line $ "_" ++ show u ++ " is an unknown type"

498+ unknownInfo u = line $ "t" ++ show u ++ " is an unknown type"

498499

499500 renderSimpleErrorMessage :: SimpleErrorMessage -> Box.Box

500501 renderSimpleErrorMessage (CannotGetFileInfo path) =

@@ -817,10 +818,20 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

817818 paras [ line "Wildcard type definition has the inferred type "

818819 , indent $ typeAsBox ty

819820 ]

820− renderSimpleErrorMessage (HoleInferredType name ty) =

821− paras [ line $ "Hole '" ++ name ++ "' has the inferred type "

822− , indent $ typeAsBox ty

823− ]

821+ renderSimpleErrorMessage (HoleInferredType name ty env) =

822+ paras $ [ line $ "Hole '" ++ name ++ "' has the inferred type "

823+ , indent $ typeAsBox ty

824+ ] ++ if null env then [] else envInfo

825+ where

826+ envInfo :: [Box.Box]

827+ envInfo = [ line "in the following context:"

828+ , indent $ paras

829+ [ Box.hcat Box.left [ Box.text (showIdent ident <> " :: ")

830+ , typeAsBox ty'

831+ ]

832+ | (ident, ty') <- take 5 env

833+ ]

834+ ]

824835 renderSimpleErrorMessage (MissingTypeDeclaration ident ty) =

825836 paras [ line $ "No type declaration was provided for the top-level declaration of " ++ showIdent ident ++ "."

826837 , line "It is good practice to provide type declarations as a form of documentation."

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

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

3434 match (TypeVar var) = Just $ text var

3535 match (PrettyPrintObject row) = Just $ prettyPrintRowWith '{' '}' row

3636 match (TypeConstructor ctor) = Just $ text $ runProperName $ disqualify ctor

37− match (TUnknown u) = Just $ text $ '_' : show u

37+ match (TUnknown u) = Just $ text $ 't' : show u

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

3939 match REmpty = Just $ text "()"

4040 match row@RCons{} = Just $ prettyPrintRowWith '(' ')' row

src/Language/PureScript/TypeChecker/Types.hs+8−3

@@ -26,6 +26,7 @@ module Language.PureScript.TypeChecker.Types

2626

2727import Prelude.Compat

2828

29+import Control.Arrow (second)

2930import Control.Monad

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

3132import Control.Monad.State.Class (MonadState(..), gets)

@@ -118,8 +119,9 @@ typesOf bindingGroupType moduleName vals = do

118119 -- Replace all the wildcards types with their inferred types

119120 replace sub (ErrorMessage hints (WildcardInferredType ty)) =

120121 ErrorMessage hints . WildcardInferredType $ substituteType sub ty

121− replace sub (ErrorMessage hints (HoleInferredType name ty)) =

122− ErrorMessage hints . HoleInferredType name $ substituteType sub ty

122+ replace sub (ErrorMessage hints (HoleInferredType name ty env)) =

123+ ErrorMessage hints $ HoleInferredType name (substituteType sub ty)

124+ (map (second (substituteType sub)) env)

123125 replace _ em = em

124126

125127 isHoleError :: ErrorMessage -> Bool

@@ -324,7 +326,10 @@ infer' (TypedValue checkType val ty) = do

324326 return $ TypedValue True val' ty'

325327infer' (Hole name) = do

326328 ty <- freshType

327− tell . errorMessage $ HoleInferredType name ty

329+ env <- M.toList . names <$> getEnv

330+ Just moduleName <- checkCurrentModule <$> get

331+ let ctx = [ (ident, ty') | ((mn, ident@Ident{}), (ty', _, Defined)) <- env, mn == moduleName ]

332+ tell . errorMessage $ HoleInferredType name ty ctx

328333 return $ TypedValue True (Hole name) ty

329334infer' (PositionedValue pos c val) = warnAndRethrowWithPosition pos $ do

330335 TypedValue t v ty <- infer' val