diff --git a/dhall/src/Dhall/TypeCheck.hs b/dhall/src/Dhall/TypeCheck.hs index ac7906f..98b0378 100644 --- a/dhall/src/Dhall/TypeCheck.hs +++ b/dhall/src/Dhall/TypeCheck.hs @@ -4252,21 +4252,23 @@ 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 - ( "\n" - <> shortTypeMessage msg <> "\n" - <> source - ) - where - source = case expr of - Note s _ -> pretty s - _ -> mempty + 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 + ) + where + source = case expr of + Note s _ -> pretty s + _ -> mempty {-| Wrap a type error in this exception type to censor source code and `Text` literals from the error message @@ -4425,36 +4427,39 @@ 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 - ( "\n" - <> ( if null (Dhall.Context.toList ctx) - then "" - else prettyContext ctx <> "\n\n" - ) - <> longTypeMessage msg <> "\n" - <> "────────────────────────────────────────────────────────────────────────────────\n" - <> "\n" - <> source - ) - where - prettyKV (key, val) = - pretty key <> " : " <> Dhall.Util.snipDoc (pretty val) + pretty = Pretty.unAnnotate . prettyDetailedTypeError - prettyContext = - Pretty.vsep - . map prettyKV - . reverse - . Dhall.Context.toList +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 "" + else prettyContext ctx <> "\n\n" + ) + <> longTypeMessage msg <> "\n" + <> "────────────────────────────────────────────────────────────────────────────────\n" + <> "\n" + <> source + ) + where + prettyKV (key, val) = + Dhall.Util.snipDoc + (Dhall.Pretty.Internal.prettyLabel key <> " : " <> Dhall.Pretty.prettyExpr val) - source = case expr of - Note s _ -> pretty s - _ -> mempty + prettyContext = + Pretty.vsep + . map prettyKV + . reverse + . Dhall.Context.toList + + source = case expr of + Note s _ -> pretty s + _ -> mempty {-| This function verifies that a custom context is well-formed so that type-checking will not loop diff --git a/dhall/src/Dhall/Util.hs b/dhall/src/Dhall/Util.hs index 9c28ce0..3ca6e36 100644 --- a/dhall/src/Dhall/Util.hs +++ b/dhall/src/Dhall/Util.hs @@ -31,8 +31,8 @@ import Dhall.Src (Src) 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 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