35afca6 · rowtype-yoga/purescript-native

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

Merge pull request #1562 from purescript/1557

Fix #1557

commit35afca69fb68aedff53fe04134a9ee46dabb4170 authorPhil Freeman <paf31@cantab.net> dateSun 25 Oct 2015, 11:08 (11 years ago) parentfda24b5 21d6f4b

2 files changed+10−18

compare with golang

unifiedsplit

src/Language/PureScript/Errors.hs+8−16 src/Language/PureScript/TypeChecker/Types.hs+2−2

src/Language/PureScript/Errors.hs+8−16

@@ -20,7 +20,7 @@

2020module Language.PureScript.Errors where

2121

2222import Data.Either (lefts, rights)

23−import Data.List (intercalate, transpose, nub, nubBy, partition)

23+import Data.List (intercalate, transpose, nub, nubBy)

2424import Data.Function (on)

2525#if __GLASGOW_HASKELL__ < 710

2626import Data.Foldable (fold, foldMap)

@@ -154,6 +154,7 @@ data ErrorMessageHint

154154 | ErrorInModule ModuleName

155155 | ErrorInInstance (Qualified ProperName) [Type]

156156 | ErrorInSubsumption Type Type

157+ | ErrorCheckingAccessor Expr String

157158 | ErrorCheckingType Expr Type

158159 | ErrorCheckingKind Type

159160 | ErrorInferringType Expr

@@ -367,8 +368,8 @@ onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse

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

368369--

369370prettyPrintSingleError :: Bool -> Level -> ErrorMessage -> State UnknownMap Box.Box

370−prettyPrintSingleError full level e = prettyPrintErrorMessage . positionHintsFirst . reverseHints <$> onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)

371− where

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

372+ where

372373

373374 -- Pretty print an ErrorMessage

374375 prettyPrintErrorMessage :: ErrorMessage -> Box.Box

@@ -735,6 +736,10 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage . positionHintsFir

735736 , line "has type"

736737 , indent $ typeAsBox ty

737738 ]

739+ renderHint (ErrorCheckingAccessor expr prop) =

740+ paras [ lineWithLevel "checking type of property accessor"

741+ , indent $ prettyPrintValue (Accessor prop expr)

742+ ]

738743 renderHint (ErrorInApplication f t a) =

739744 paras [ lineWithLevel "applying a function"

740745 , indent $ prettyPrintValue f

@@ -782,19 +787,6 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage . positionHintsFir

782787 prettyPrintExport (ModuleRef name) = "module " ++ runModuleName name

783788 prettyPrintExport (PositionedDeclarationRef _ _ ref) = prettyPrintExport ref

784789

785− -- Hints get added at the front, so we need to reverse them before rendering

786− reverseHints :: ErrorMessage -> ErrorMessage

787− reverseHints (ErrorMessage hints simple) = ErrorMessage (reverse hints) simple

788−

789− -- | Put positional hints at the front of the list

790− positionHintsFirst :: ErrorMessage -> ErrorMessage

791− positionHintsFirst (ErrorMessage hints simple) = ErrorMessage (uncurry (++) $ partition (isPositionHint . hintCategory) hints) simple

792− where

793− isPositionHint :: HintCategory -> Bool

794− isPositionHint PositionHint = True

795− isPositionHint OtherHint = True

796− isPositionHint _ = False

797−

798790 -- | Simplify an error message

799791 simplifyErrorMessage :: ErrorMessage -> ErrorMessage

800792 simplifyErrorMessage (ErrorMessage hints simple) = ErrorMessage (simplifyHints hints) simple

src/Language/PureScript/TypeChecker/Types.hs+2−2

@@ -232,7 +232,7 @@ infer' (ObjectUpdate o ps) = do

232232 let oldTy = TypeApp tyObject $ rowFromList (oldTys, row)

233233 o' <- TypedValue True <$> check o oldTy <*> pure oldTy

234234 return $ TypedValue True (ObjectUpdate o' newVals) $ TypeApp tyObject $ rowFromList (newTys, row)

235−infer' (Accessor prop val) = do

235+infer' (Accessor prop val) = rethrow (addHint (ErrorCheckingAccessor val prop)) $ do

236236 field <- fresh

237237 rest <- fresh

238238 typed <- check val (TypeApp tyObject (RCons prop field rest))

@@ -551,7 +551,7 @@ check' (ObjectUpdate obj ps) t@(TypeApp o row) | o == tyObject = do

551551 obj' <- check obj (TypeApp tyObject (rowFromList (us ++ remainingProps, rest)))

552552 ps' <- checkProperties ps row True

553553 return $ TypedValue True (ObjectUpdate obj' ps') t

554−check' (Accessor prop val) ty = do

554+check' (Accessor prop val) ty = rethrow (addHint (ErrorCheckingAccessor val prop)) $ do

555555 rest <- fresh

556556 val' <- check val (TypeApp tyObject (RCons prop ty rest))

557557 return $ TypedValue True (Accessor prop val') ty