ehmry/dhall-haskell
ehmry/dhall-haskell
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Output the context of a type error with syntax highlighting (#1556)

Browse Source
This commit is contained in:
Simon Jakobi 2019-11-19 08:11:22 +01:00 committed by mergify[bot]
parent e12dd9adce
commit 3fdf075259
2 changed files with 43 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
dhall/src/Dhall/TypeCheck.hs
View File

@ -4252,13 +4252,15 @@ data TypeError s a = TypeError
}
instance (Eq a, Pretty s, Pretty a) => Show (TypeError s a) where
show = Pretty.renderString . Dhall.Pretty.layout . Pretty.pretty
show = Pretty.renderString . Dhall.Pretty.layout . prettyTypeError
instance (Eq a, Pretty s, Pretty a, Typeable s, Typeable a) => Exception (TypeError s a)
instance (Eq a, Pretty s, Pretty a) => Pretty (TypeError s a) where
pretty (TypeError _ expr msg)
= Pretty.unAnnotate
pretty = Pretty.unAnnotate . prettyTypeError
prettyTypeError :: (Eq a, Pretty s, Pretty a) => TypeError s a -> Doc Ann
prettyTypeError (TypeError _ expr msg) =
( "\n"
<> shortTypeMessage msg <> "\n"
<> source
@ -4425,13 +4427,15 @@ newtype DetailedTypeError s a = DetailedTypeError (TypeError s a)
deriving (Typeable)
instance (Eq a, Pretty s, Pretty a) => Show (DetailedTypeError s a) where
show = Pretty.renderString . Dhall.Pretty.layout . Pretty.pretty
show = Pretty.renderString . Dhall.Pretty.layout . prettyDetailedTypeError
instance (Eq a, Pretty s, Pretty a, Typeable s, Typeable a) => Exception (DetailedTypeError s a)
instance (Eq a, Pretty s, Pretty a) => Pretty (DetailedTypeError s a) where
pretty (DetailedTypeError (TypeError ctx expr msg))
= Pretty.unAnnotate
pretty = Pretty.unAnnotate . prettyDetailedTypeError
prettyDetailedTypeError :: (Eq a, Pretty s, Pretty a) => DetailedTypeError s a -> Doc Ann
prettyDetailedTypeError (DetailedTypeError (TypeError ctx expr msg)) =
( "\n"
<> ( if null (Dhall.Context.toList ctx)
then ""
@ -4444,7 +4448,8 @@ instance (Eq a, Pretty s, Pretty a) => Pretty (DetailedTypeError s a) where
)
where
prettyKV (key, val) =
pretty key <> " : " <> Dhall.Util.snipDoc (pretty val)
Dhall.Util.snipDoc
(Dhall.Pretty.Internal.prettyLabel key <> " : " <> Dhall.Pretty.prettyExpr val)
prettyContext =
Pretty.vsep

4
dhall/src/Dhall/Util.hs
View File

@ -32,7 +32,7 @@ import qualified Control.Exception
import qualified Data.Text
import qualified Data.Text.IO
import qualified Data.Text.Prettyprint.Doc as Pretty
import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty
import qualified Data.Text.Prettyprint.Doc.Render.Terminal as Pretty.Terminal
import qualified Dhall.Parser
import qualified Dhall.Pretty
@ -81,7 +81,7 @@ snipDoc doc = Pretty.align (Pretty.pretty (snip text))
ansiStream = fmap Dhall.Pretty.annToAnsiStyle stream
text = Pretty.renderStrict ansiStream
text = Pretty.Terminal.renderStrict ansiStream
takeEnd :: Int -> [a] -> [a]
takeEnd n l = go (drop n l) l