@@ -47,10 +47,18 @@ modifyEnv f = modify $ \state -> state { sEnv = f (sEnv state) }
4747modifyPool f = modify $ \state -> state { sPool = f (sPool state) }
4848
4949addError span message t1 t2 =
50− modify $ \state -> state { sErrors = err : sErrors state }
50+ modify $ \state -> state { sErrors = makeError : sErrors state }
5151 where
52− prty t = pretty `fmap` toSrcType t
53− err = makeError <$> prty t1 <*> prty t2
52+ makeError = do
53+ t1' <- pretty <$> toSrcType t1
54+ t2' <- pretty <$> toSrcType t2
55+ return . P.vcat $
56+ [ P.text $ "Type error" ++ location ++ ":"
57+ , P.vcat . map P.text . lines $ if null message then defaultMessage else message
58+ , P.text src
59+ , P.text " Expected Type:" <+> t1'
60+ , P.text " Actual Type:" <+> t2' <> P.text "\n"
61+ ]
5462
5563 location = case span of
5664 NoSpan msg -> ""
@@ -67,13 +75,6 @@ addError span message t1 t2 =
6775
6876 defaultMessage = "Something weird is happening with this value:"
6977
70− makeError pt1 pt2 =
71− P.vcat [ P.text $ "Type error" ++ location ++ ":"
72− , P.vcat . map P.text . lines $ if null message then defaultMessage else message
73− , P.text src
74− , P.text " Expected Type:" <+> pt1
75− , P.text " Actual Type:" <+> pt2 <> P.text "\n"
76− ]
7778
7879switchToPool pool = modifyPool (\_ -> pool)
7980