0b8a09f · rowtype-yoga/purescript-native

examples/failing/MissingRecordField.purs+1−2

compare with golang

unifiedsplit

@@ -1,5 +1,4 @@

1−-- @shouldFailWith TypesDoNotUnify

1+-- @shouldFailWith PropertyIsMissing

2−-- TODO: Update type checker to make this fail with PropertyIsMissing instead.

3module MissingRecordField where

2module MissingRecordField where

4

3

5import Prelude ((>))

4import Prelude ((>))

src/Language/PureScript/Errors.hs+6−12

@@ -126,8 +126,8 @@ data SimpleErrorMessage

126 | ExpectedType Type Kind

127 | IncorrectConstructorArity (Qualified ProperName)

128 | ExprDoesNotHaveType Expr Type

129− | PropertyIsMissing String Expr

129+ | PropertyIsMissing String

130− | AdditionalProperty String Expr

130+ | AdditionalProperty String

131 | CannotApplyFunction Type Expr

132 | TypeSynonymInstance

133 | OrphanInstance Ident (Qualified ProperName) [Type]

@@ -618,16 +618,10 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError

618 , line "does not have type"

619 , indent $ typeAsBox ty

620 ]

621− renderSimpleErrorMessage (PropertyIsMissing prop expr) =

621+ renderSimpleErrorMessage (PropertyIsMissing prop) =

622− paras [ line "Row type"

623− , indent $ prettyPrintValue expr

624− , line $ "lacks required label " ++ show prop

622+ line $ "Type of expression lacks required label " ++ show prop ++ "."

625− ]

626− renderSimpleErrorMessage (AdditionalProperty prop expr) =

623+ renderSimpleErrorMessage (AdditionalProperty prop) =

627− paras [ line "Type of expression"

628− , indent $ prettyPrintValue expr

629− , line $ "contains additional label " ++ show prop

624+ line $ "Type of expression contains additional label " ++ show prop ++ "."

630− ]

631 renderSimpleErrorMessage (CannotApplyFunction fn arg) =

625 renderSimpleErrorMessage (CannotApplyFunction fn arg) =

632 paras [ line "A function of type"

626 paras [ line "A function of type"

633 , indent $ typeAsBox fn

627 , indent $ typeAsBox fn

src/Language/PureScript/TypeChecker/Subsumption.hs+10−2

@@ -21,6 +21,7 @@ import Data.List (sortBy)

21import Data.Ord (comparing)

22

23import Control.Monad.Unify

24+import Control.Monad.Error.Class (throwError)

24

25

25import Language.PureScript.Crash

26import Language.PureScript.Crash

26import Language.PureScript.AST

27import Language.PureScript.AST

@@ -77,10 +78,17 @@ subsumes' val (TypeApp f1 r1) (TypeApp f2 r2) | f1 == tyObject && f2 == tyObject

77 | p1 == p2 = do _ <- subsumes Nothing ty1 ty2

78 | p1 == p2 = do _ <- subsumes Nothing ty1 ty2

78 go ts1 ts2 r1' r2'

79 go ts1 ts2 r1' r2'

79 | p1 < p2 = do rest <- fresh

80 | p1 < p2 = do rest <- fresh

81+ -- What happens next is a bit of a hack.

82+ -- TODO: in the new type checker, object properties will probably be restricted to being monotypes

83+ -- in which case, this branch of the subsumes function should not even be necessary.

84+ case r2' of

85+ REmpty -> throwError . errorMessage $ AdditionalProperty p1

80− r2' =?= RCons p1 ty1 rest

86+ _ -> r2' =?= RCons p1 ty1 rest

81 go ts1 ((p2, ty2) : ts2) r1' rest

87 go ts1 ((p2, ty2) : ts2) r1' rest

82 | otherwise = do rest <- fresh

88 | otherwise = do rest <- fresh

89+ case r1' of

90+ REmpty -> throwError . errorMessage $ PropertyIsMissing p2

83− r1' =?= RCons p2 ty2 rest

91+ _ -> r1' =?= RCons p2 ty2 rest

84 go ((p1, ty1) : ts1) ts2 rest r2'

92 go ((p1, ty1) : ts1) ts2 rest r2'

85subsumes' val ty1 ty2@(TypeApp obj _) | obj == tyObject = subsumes val ty2 ty1

93subsumes' val ty1 ty2@(TypeApp obj _) | obj == tyObject = subsumes val ty2 ty1

86subsumes' val ty1 ty2 = do

94subsumes' val ty1 ty2 = do

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

@@ -595,8 +595,8 @@ checkProperties expr ps row lax = let (ts, r') = rowToList row in go ps ts r' wh

595 return []

596 go [] [] Skolem{} | lax = return []

597 go [] ((p, _): _) _ | lax = return []

598− | otherwise = throwError . errorMessage $ PropertyIsMissing p expr

598+ | otherwise = throwError . errorMessage $ PropertyIsMissing p

599− go ((p,_):_) [] REmpty = throwError . errorMessage $ AdditionalProperty p expr

599+ go ((p,_):_) [] REmpty = throwError . errorMessage $ AdditionalProperty p

600 go ((p,v):ps') ts r =

601 case lookup p ts of

602 Nothing -> do