on master help sign in
Improve error message when type annotation does not match defined value
commit304d4f3d6750a711d3c1d6ca9462f5721f134a54 authorEvan Czaplicki <info@elm-lang.org> dateTue 26 May 2015, 11:02 (11 years ago) parentdb277d9
2 files changed+17−7
src/Reporting/Error/Type.hs+6 src/Type/Constrain/Expression.hs+11−7
src/Reporting/Error/Type.hs+6
@@ -39,6 +39,7 @@ data Hint
3939 | Binop Var.Canonical
4040 | BadArgument Region.Region
4141 | ExtraArgument Region.Region
42+ | BadTypeAnnotation String
4243
4344
4445data Note
@@ -168,6 +169,11 @@ hintToString hint =
168169 ++ "Maybe you provided an extra argument?"
169170 )
170171
172+ BadTypeAnnotation name ->
173+ ( Nothing
174+ , "The type annotation for '" ++ name ++ "' does not match its definition."
175+ )
176+
171177
172178prettyOperator :: Var.Canonical -> String
173179prettyOperator (Var.Canonical _ opName) =
src/Type/Constrain/Expression.hs+11−7
@@ -416,12 +416,12 @@ data Info = Info
416416
417417
418418constrainDef :: Env.Environment -> Info -> Canonical.Def -> IO Info
419−constrainDef env info (Canonical.Definition (A.A _ pattern) expr maybeTipe) =
419+constrainDef env info (Canonical.Definition (A.A region pattern) expr maybeTipe) =
420420 let qs = [] -- should come from the def, but I'm not sure what would live there...
421421 in
422422 case (pattern, maybeTipe) of
423423 (P.Var name, Just tipe) ->
424− constrainAnnotatedDef env info qs name expr tipe
424+ constrainAnnotatedDef env info qs region name expr tipe
425425
426426 (P.Var name, Nothing) ->
427427 constrainUnannotatedDef env info qs name expr
@@ -433,11 +433,12 @@ constrainAnnotatedDef
433433 :: Env.Environment
434434 -> Info
435435 -> [String]
436+ -> R.Region
436437 -> String
437438 -> Canonical.Expr
438439 -> ST.Canonical
439440 -> IO Info
440−constrainAnnotatedDef env info qs name expr tipe =
441+constrainAnnotatedDef env info qs region name expr tipe =
441442 do -- Some mistake may be happening here. Currently, qs is always [].
442443 rigidVars <- Monad.forM qs (\_ -> variable Rigid)
443444
@@ -457,11 +458,14 @@ constrainAnnotatedDef env info qs name expr tipe =
457458 , header = Map.singleton name typ
458459 }
459460
460− c <- constrain env' expr typ
461+ var <- variable Flexible
462+ defCon <- constrain env' expr (varN var)
463+ let annCon =
464+ CEqual (Error.BadTypeAnnotation name) region typ (varN var)
461465
462466 return $ info
463467 { iSchemes = scheme : iSchemes info
464− , iC1 = fl rigidVars c /\ iC1 info
468+ , iC1 = iC1 info /\ ex [var] (defCon /\ fl rigidVars annCon)
465469 }
466470
467471
@@ -484,11 +488,11 @@ constrainUnannotatedDef env info qs name expr =
484488
485489 let env' = env { Env.value = List.foldl' (\x f -> f x) (Env.value env) inserts }
486490
487− c <- constrain env' expr tipe
491+ con <- constrain env' expr tipe
488492
489493 return $ info
490494 { iRigid = rigidVars ++ iRigid info
491495 , iFlex = v : iFlex info
492496 , iHeaders = Map.insert name tipe (iHeaders info)
493− , iC2 = c /\ iC2 info
497+ , iC2 = con /\ iC2 info
494498 }