errata 0.2.0.0 → 0.3.0.0

raw patch · 11 files changed

+693/−352 lines, 11 filesdep +hspecdep +hspec-goldendep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: hspec, hspec-golden

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• LICENSE +1/−1
• errata.cabal +25/−5
• example/Main.hs +51/−112
• src/Errata.hs +20/−49
• src/Errata/Internal/Render.hs +189/−120
• src/Errata/Source.hs +8/−5
• src/Errata/Types.hs +67/−60
• test/Errata/TypesSpec.hs +27/−0
• test/ErrataSpec.hs +290/−0
• test/Spec.hs +1/−0

@@ -2,6 +2,20 @@  **Errata** uses [PVP Versioning](https://pvp.haskell.org). +## 0.3.0.0++* Support GHC 9.0.1 (and eventually 9.2).++* Optimized rendering of errors ([#5](https://github.com/1Computer1/errata/pull/5)). Huge thanks to [RiugaBachi](https://github.com/RiugaBachi) for this! This also adds a `Monoid` constraint to `Source`.++* Reworked the pretty printer so that it no longer prints trailing whitespace in most places.++* Removed the `errataBlock` field, and only use `errataBlocks`. Now, an `Errata` can have no blocks attached to it at all. They will also no longer be sorted beforehand, as that should be up to the user.++* Removed `prettyErrorsNE`, as it is no longer useful for what it was documented for.++* Fixed the rendering of `Block`s with no `Pointer`s adding extra blank lines.+ ## 0.2.0.0  * Added new `blockHeader` field to `Block`, which will put text underneath the location text but above the source lines. This also affects all the block helper functions, which now have an argument for the header.

@@ -1,6 +1,6 @@ MIT License -Copyright (c) 2020 comp+Copyright (c) 2020-2021 comp  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -1,6 +1,6 @@ cabal-version: 2.4 name:          errata-version:       0.2.0.0+version:       0.3.0.0 synopsis:      Source code error pretty printing description:     An extremely customizable error pretty printer that can handle many kinds of error formatting.@@ -13,15 +13,16 @@ license-file:  LICENSE author:        comp maintainer:    onecomputer00@gmail.com-copyright:     (c) 2020 comp+copyright:     (c) 2020-2021 comp category:      Pretty Printer build-type:    Simple extra-doc-files:     README.md     CHANGELOG.md tested-with:-    GHC == 8.10.1-  , GHC == 8.8.3+    GHC == 9.0.1+  , GHC == 8.10.4+  , GHC == 8.8.4   , GHC == 8.6.5  source-repository head@@ -30,7 +31,7 @@  common common-options   build-depends:-      base >= 4.12 && < 4.15+      base >= 4.12 && < 4.17     , containers >= 0.6.0.1 && < 0.7     , text >= 1.2.3.1 && < 1.3   ghc-options:@@ -52,6 +53,25 @@       Errata.Internal.Render       Errata.Source       Errata.Types++test-suite errata-test+  import:         common-options+  type:           exitcode-stdio-1.0+  hs-source-dirs: test+  main-is:        Spec.hs+  other-modules:+      ErrataSpec+    , Errata.TypesSpec+  build-depends:+      errata+    , hspec >= 2.7 && < 3+    , hspec-golden >= 0.1 && < 0.2+  build-tool-depends:+      hspec-discover:hspec-discover >= 2.7 && < 3+  ghc-options:+      -threaded+      -rtsopts+      -with-rtsopts=-N  executable errata-example   import:         common-options

@@ -1,8 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications  #-} -module Main where+module Main+    where +import           Data.List import qualified Data.Text as T import qualified Data.Text.Lazy.IO as TL import           Errata@@ -36,121 +38,58 @@ -- Examples -- -------------- --- An ad-hoc errata.-adhoc :: [Pointer] -> Errata-adhoc ps = errataSimple (Just "an error") (Block fancyRedStyle ("here", 1, 1) Nothing ps (Just "pbody")) Nothing--main :: IO ()-main = do-    putStrLn "Simple single pointer:"-    putStrLn ""-    TL.putStrLn $ prettyErrors @String-        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"-        [ adhoc [Pointer 1 2 4 False (Just "x")]-        ]-    putStrLn ""--    putStrLn "Nothing is connected, some inner labels:"-    putStrLn ""-    TL.putStrLn $ prettyErrors @String-        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"-        [ adhoc-            [ Pointer 1 2 4 False (Just "x")-            , Pointer 1 6 8 False (Just "y")-            , Pointer 1 10 12 False (Just "z")-            , Pointer 2 5 8 False (Just "w")-            ]-        ]-    putStrLn ""--    putStrLn "Everything is connected."-    putStrLn ""-    TL.putStrLn $ prettyErrors @String-        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"-        [ adhoc-            [ Pointer 1 2 4 True (Just "x")-            , Pointer 1 6 8 True (Just "y")-            , Pointer 1 10 12 True (Just "z")-            , Pointer 2 5 8 True (Just "w")-            ]-        ]-    putStrLn ""+-- | From the Haddock for 'prettyErrors'.+jsonExample :: IO ()+jsonExample = printErrors+    "{\n    \"bad\": [1, 2,]\n    }"+    [ParseError "./comma.json" 2 18 "]" ["null", "true", "false", "\"", "-", "digit", "[", "{"]] -    putStrLn "Only one line is connected, and one of them is skewered through:"-    putStrLn ""-    TL.putStrLn $ prettyErrors @String-        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"-        [ adhoc-            [ Pointer 1 2 4 True (Just "x")-            , Pointer 1 6 8 False (Just "y")-            , Pointer 1 10 12 True (Just "z")-            , Pointer 2 5 8 False (Just "w")-            ]+-- | From the README.+foldExample :: IO ()+foldExample = TL.putStrLn $ prettyErrors @String+    "sum xs = fold (+) 0 xs"+    [ Errata+        (Just "\x1b[31m─────── NAME UNKNOWN ───────\x1b[0m\n\nThe name \x1b[31mfold\x1b[0m was not found.\n")+        [ Block+            fancyRedStyle { styleUnderline = " " }+            ("file.hs", 1, 10)+            Nothing+            [Pointer 1 10 14 False Nothing]+            Nothing         ]-    putStrLn ""+        (Just "\nDid you mean to use one of these?\n\n    \x1b[31mfoldl\x1b[0m\n    \x1b[31mfoldr\x1b[0m")+    ] -    putStrLn "Everything is connected except for 2. One of them does not have a label:"-    putStrLn ""-    TL.putStrLn $ prettyErrors @String-        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"-        [ adhoc-            [ Pointer 1 2 4 True (Just "x")-            , Pointer 1 6 8 True Nothing-            , Pointer 1 10 12 False (Just "z")-            , Pointer 2 5 8 False (Just "w")-            , Pointer 3 1 3 True (Just "v")+-- | From the README.+ifExample :: IO ()+ifExample = TL.putStrLn $ prettyErrors @String+    "foo = if 1 > 2\n    then 100\n    else \"uh oh\""+    [ Errata+        (Just "\x1b[31merror[E001]: mismatching types in `if` expression\x1b[0m")+        [ Block+            fancyRedStyle+            ("file.hs", 3, 10)+            Nothing+            [ Pointer 2 10 13 False (Just "\x1b[31mthis has type `Int`\x1b[0m")+            , Pointer 3 10 17 False (Just "\x1b[31mbut this has type `String`\x1b[0m")             ]-        ]-    putStrLn ""--    putStrLn "Example from the Haddock example for `prettyErrors`:"-    putStrLn ""-    printErrors-        "{\n    \"bad\": [1, 2,]\n    }"-        (pure (ParseError "./comma.json" 2 18 "]" ["null", "true", "false", "\"", "-", "digit", "[", "{"]))-    putStrLn ""--    putStrLn "Example 1 from the readme:"-    putStrLn ""-    TL.putStrLn $ prettyErrors @String-        "foo = if 1 > 2\n    then 100\n    else \"uh oh\""-        [ Errata-            (Just "\x1b[31merror[E001]: mismatching types in `if` expression\x1b[0m")-            (Block-                fancyRedStyle-                ("file.hs", 3, 10)-                Nothing-                [ Pointer 2 10 13 False (Just "\x1b[31mthis has type `Int`\x1b[0m")-                , Pointer 3 10 17 False (Just "\x1b[31mbut this has type `String`\x1b[0m")-                ]-                Nothing)-            [ Block-                fancyYellowStyle-                ("file.hs", 1, 7)-                Nothing-                [ Pointer 1 7 9 True Nothing-                , Pointer 2 5 9 True Nothing-                , Pointer 3 5 9 True (Just "\x1b[33min this `if` expression\x1b[0m")-                ]-                Nothing+            Nothing+        , Block+            fancyYellowStyle+            ("file.hs", 1, 7)+            Nothing+            [ Pointer 1 7 9 True Nothing+            , Pointer 2 5 9 True Nothing+            , Pointer 3 5 9 True (Just "\x1b[33min this `if` expression\x1b[0m")             ]-            (Just "\x1b[33mnote: use --explain E001 to learn more\x1b[0m")+            Nothing         ]-    putStrLn ""+        (Just "\n\x1b[33mnote: use --explain E001 to learn more\x1b[0m")+    ] -    putStrLn "Example 2 from the readme:"-    putStrLn ""-    TL.putStrLn $ prettyErrors @String-        "sum xs = fold (+) 0 xs"-        [ Errata-            (Just "\x1b[31m─────── NAME UNKNOWN ───────\x1b[0m\n\nThe name \x1b[31mfold\x1b[0m was not found.\n")-            (Block-                fancyRedStyle { styleUnderline = " " }-                ("file.hs", 1, 10)-                Nothing-                [Pointer 1 10 14 False Nothing]-                Nothing)-            []-            (Just "Did you mean to use one of these?\n\n    \x1b[31mfoldl\x1b[0m\n    \x1b[31mfoldr\x1b[0m")-        ]-    putStrLn ""+main :: IO ()+main = sequence_ . intersperse (putStrLn "") $+    [ jsonExample+    , foldExample+    , ifExample+    ]

@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -{-|+{- | Module      : Errata Copyright   : (c) 2020 comp License     : MIT@@ -14,9 +14,9 @@ To get started, see the documentation for 'prettyErrors'. When using this module, we recommend you turn on the @OverloadedStrings@ extension and import "Data.Text" at the very least due to the use of 'Data.Text.Text' (strict). -The overall workflow to use the printer is to convert your error type to 'Errata', which entails converting your errors-to 'Errata' by filling in messages and 'Block's. You can create 'Errata' and 'Block' from their constructors, or use-the convenience functions for common usecases, like 'errataSimple' and 'blockSimple'.+The overall workflow to use the printer is to convert your error type to 'Errata', which entails filling in messages+and 'Block's. You can create 'Errata' and 'Block' from their constructors, or use the convenience functions for+common usecases, like 'errataSimple' and 'blockSimple'.  For easier reading, we define: @@ -28,29 +28,27 @@ -} module Errata     ( -- * Error format data-      Errata(..)+      Errata (..)     , errataSimple       -- * Blocks and pointers-    , Block(..)+    , Block (..)     , blockSimple     , blockSimple'     , blockConnected     , blockConnected'     , blockMerged     , blockMerged'-    , Pointer(..)+    , Pointer (..)       -- * Styling options-    , Style(..)+    , Style (..)     , basicStyle     , fancyStyle     , fancyRedStyle     , fancyYellowStyle       -- * Pretty printer     , prettyErrors-    , prettyErrorsNE     ) where -import qualified Data.List.NonEmpty as N import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB@@ -66,8 +64,7 @@     -> Errata errataSimple header block body = Errata     { errataHeader = header-    , errataBlock = block-    , errataBlocks = []+    , errataBlocks = [block]     , errataBody = body     } @@ -95,13 +92,8 @@     -> (Line, Column, Maybe Label) -- ^ The line number and column, starting at 1, and a label.     -> Maybe Body                  -- ^ The body message.     -> Block-blockSimple' style fp hm (l, c, lbl) bm = Block-    { blockStyle = style-    , blockLocation = (fp, l, c)-    , blockHeader = hm-    , blockPointers = [Pointer l c (c + 1) False lbl]-    , blockBody = bm-    }+blockSimple' style fp hm (l, c, lbl) bm =+    blockSimple style fp hm (l, c, c + 1, lbl) bm  -- | A block that points to two parts of the source that are visually connected together. blockConnected@@ -129,16 +121,10 @@     -> (Line, Column, Maybe Label) -- ^ The second line number and column, starting at 1, and a label.     -> Maybe Body                  -- ^ The body message.     -> Block-blockConnected' style fp hm (l1, c1, lbl1) (l2, c2, lbl2) bm = Block-    { blockStyle = style-    , blockLocation = (fp, l1, c1)-    , blockHeader = hm-    , blockPointers = [Pointer l1 c1 (c1 + 1) True lbl1, Pointer l2 c2 (c2 + 1) True lbl2]-    , blockBody = bm-    }+blockConnected' style fp hm (l1, c1, lbl1) (l2, c2, lbl2) bm =+    blockConnected style fp hm (l1, c1, c1 + 1, lbl1) (l2, c2, c2 + 1, lbl2) bm -{-|-A block that points to two parts of the source that are visually connected together.+{- | A block that points to two parts of the source that are visually connected together.  If the two parts of the source happen to be on the same line, the pointers are merged into one. -}@@ -171,18 +157,10 @@     -> Maybe Label                 -- ^ The label for when the two pointers are merged into one.     -> Maybe Body                  -- ^ The body message.     -> Block-blockMerged' style fp hm (l1, c1, lbl1) (l2, c2, lbl2) lbl bm = Block-    { blockStyle = style-    , blockLocation = (fp, l1, c1)-    , blockHeader = hm-    , blockPointers = if l1 == l2-        then [Pointer l1 c1 (c2 + 1) False lbl]-        else [Pointer l1 c1 (c1 + 1) True lbl1, Pointer l2 c2 (c2 + 1) True lbl2]-    , blockBody = bm-    }+blockMerged' style fp hm (l1, c1, lbl1) (l2, c2, lbl2) lbl bm =+    blockMerged style fp hm (l1, c1, c1 + 1, lbl1) (l2, c2, c2 + 1, lbl2) lbl bm -{-|-A basic style using only ASCII characters.+{- | A basic style using only ASCII characters.  Errors should look like so: @@ -219,8 +197,7 @@     , styleUpDownRight = "|"     } -{-|-A fancy style using Unicode characters.+{- | A fancy style using Unicode characters.  Errors should look like so: @@ -295,8 +272,7 @@     , styleUpDownRight = "\x1b[33m├\x1b[0m"     } -{-|-Pretty prints errors. The original source is required. Returns 'Data.Text.Lazy.Text' (lazy). If the list is empty,+{- | Pretty prints errors. The original source is required. Returns 'Data.Text.Lazy.Text' (lazy). If the list is empty, an empty string is returned.  Suppose we had an error of this type:@@ -312,7 +288,6 @@ Then we can create a simple pretty printer like so:  @-import qualified Data.List.NonEmpty as N import qualified Data.Text as T import qualified Data.Text.Lazy.IO as TL import           "Errata"@@ -328,7 +303,7 @@         Nothing  printErrors :: T.Text -> [ParseError] -> IO ()-printErrors source es = TL.putStrLn $ 'prettyErrors' source (toErrata \<$> es)+printErrors source es = TL.putStrLn $ 'prettyErrors' source (map toErrata es) @  Note that in the above example, we have @OverloadedStrings@ enabled to reduce uses of 'Data.Text.pack'.@@ -346,7 +321,3 @@ -} prettyErrors :: Source source => source -> [Errata] -> TL.Text prettyErrors source errs = TB.toLazyText $ renderErrors source errs---- | A variant of 'prettyErrors' for non-empty lists. You can ensure the output is never an empty string.-prettyErrorsNE :: Source source => source -> N.NonEmpty Errata -> TL.Text-prettyErrorsNE source errs = prettyErrors source (N.toList errs)

@@ -1,8 +1,11 @@-{-# LANGUAGE MultiWayIf        #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE MultiWayIf          #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns        #-} -{-|+{- | Module      : Errata.Internal.Render Copyright   : (c) 2020 comp License     : MIT@@ -19,67 +22,152 @@     , renderErrata     , renderBlock     , renderSourceLines+    , groupBlockPointers+    , slices+    , makeSourceTable     ) where -import qualified GHC.Arr as A-import           Data.List-import qualified Data.List.NonEmpty as N-import qualified Data.Map.Strict as M-import           Data.Maybe+import           Control.Applicative (ZipList(..))+import qualified Data.IntMap as I+import           Data.List (foldl', inits, sortOn)+import           Data.Maybe (isJust) import qualified Data.Text as T import qualified Data.Text.Lazy.Builder as TB import           Errata.Source import           Errata.Types --- | Renders errors.+-- | Renders a collection of 'Errata'. renderErrors :: Source source => source -> [Errata] -> TB.Builder-renderErrors source errs = unsplit "\n\n" prettified+renderErrors source errs = errorMessage     where-        sortedErrata = sortOn (blockLocation . errataBlock) errs-        slines = let xs = sourceToLines source in A.listArray (0, length xs - 1) xs-        prettified = map (renderErrata slines) sortedErrata+        -- The pointers grouped by line, for each Errata.+        blockPointersGrouped = map (map groupBlockPointers . errataBlocks) errs --- | A single pretty error from metadata and source lines.-renderErrata :: Source source => A.Array Int source -> Errata -> TB.Builder-renderErrata slines (Errata {..}) = errorMessage+        -- Min and max line numbers as defined by the pointers of each block, for each Errata.+        minPointers = (map . map) (maybe 1 id . fmap fst . I.lookupMin) blockPointersGrouped+        maxPointers = (map . map) (maybe 0 id . fmap fst . I.lookupMax) blockPointersGrouped++        minLine = minimum (concat minPointers)+        maxLine = maximum (concat maxPointers)++        {- Optimization: we use a Patricia tree (IntMap) indexed by start line+        into respective tail slices of the list of source lines @slines@.++        If we were to use the list @slines@ as-is:+            O(n) seeking per source block, O(n) traversal+        Since, we would be linearly traversing to the start of each source block every+        time with no caching for future source blocks at (or close to) the same starting+        line as previous source blocks.++        If we were to use an IntMap of source lines by itself:+            Seeking becomes free, at the expense of O(n log n) traversal per source block+        Since, we are performing an O(log n) average case Patricia lookup per line.++        Whereas if we use a hybrid IntMap + association list approach:+            O(n + log n) worst case, O(log n) average case, seeking per source block, O(n) traversal+        Worse case is unevaluated slices, as this would force @slices@ evaluation, which is+        an O(n) list traversal, on top of an O(log n) Patricia lookup. Partially-evaluated leafs will+        have slightly better asymptotics, and fully-evaluated leafs will be O(log n) average case,+        which is just the cost of a Patricia lookup.++        For sufficiently large block counts with scattered pointers per block, which we assume+        holds for real-world use cases, the traversal savings on repeat lookups will quickly favor+        hybrid association list + IntMap asymptotics.+        -}+        srcTable = makeSourceTable minLine maxLine (sourceToLines source)++        errataMessages = getZipList $ renderErrata srcTable+            <$> ZipList errs+            <*> ZipList blockPointersGrouped+            <*> ZipList minPointers+            <*> ZipList maxPointers++        errorMessage = unsplit "\n\n" errataMessages++-- | Group the pointers of a block by the line they appear on.+groupBlockPointers :: Block -> I.IntMap [Pointer]+groupBlockPointers = I.fromListWith (<>) . map (\p -> (pointerLine p, pure p)) . blockPointers++-- | Create a source table from the given line span and source lines.+makeSourceTable :: Monoid a => Line -> Line -> [a] -> I.IntMap [a]+makeSourceTable minLine maxLine slines = I.fromDistinctAscList $+    zip [minLine .. maxLine] (drop (minLine - 1) (slices slines))++{- | Turns a list into a list of tail slices of the original list, with each element at index @i@ dropping+the first @i@ elements of the original list and tailing a 'mempty'.++This allows for correct behavior on out-of-source-bounds pointers.+-}+slices :: Monoid a => [a] -> [[a]]+slices [] = repeat (repeat mempty)+slices xs = (xs <> repeat mempty) : slices (tail xs)++-- | Renders a single 'Errata'.+renderErrata+    :: Source source+    => I.IntMap [source]    -- ^ The source table.+    -> Errata               -- ^ The 'Errata' to render.+    -> [I.IntMap [Pointer]] -- ^ The pointers of each block grouped by line.+    -> [Line]               -- ^ The mininum line of each block.+    -> [Line]               -- ^ The maxinum line of each block.+    -> TB.Builder+renderErrata srcTable (Errata {..}) blockPointersGrouped minPointers maxPointers = errorMessage     where+        blockMessages = getZipList $ renderBlock srcTable+            <$> ZipList errataBlocks+            <*> ZipList blockPointersGrouped+            <*> ZipList (zip minPointers maxPointers)+         errorMessage = mconcat-            [ TB.fromText $ maybe "" (<> "\n") errataHeader-            , unsplit "\n\n" (map (renderBlock slines) (errataBlock : errataBlocks))-            , TB.fromText $ maybe "" ("\n\n" <>) errataBody+            [ TB.fromText $ maybe "" id errataHeader+            , case blockMessages of+                [] -> ""+                xs -> case errataHeader of+                    Nothing -> unsplit "\n\n" xs+                    Just _  -> "\n" <> unsplit "\n\n" xs+            , TB.fromText $ maybe "" ("\n" <>) errataBody             ] --- | A single pretty block from block data and source lines.-renderBlock :: Source source => A.Array Int source -> Block -> TB.Builder-renderBlock slines block@(Block {..}) = blockMessage+-- | Renders a single block.+renderBlock+    :: Source source+    => I.IntMap [source]  -- ^ The source table.+    -> Block              -- ^ The block to render.+    -> I.IntMap [Pointer] -- ^ The pointers of this block grouped by line.+    -> (Line, Line)       -- ^ The mininum and maximum lines of this block.+    -> TB.Builder+renderBlock srcTable block@(Block {..}) blockPointersGrouped ~(minBlockLine, maxBlockLine) = blockMessage     where+        slines = zip [minBlockLine .. maxBlockLine] (maybe [] id $ I.lookup minBlockLine srcTable)++        -- Padding size before the line prefix.+        padding = length (show maxBlockLine)+         blockMessage = mconcat             [ TB.fromText $ styleLocation blockStyle blockLocation             , TB.fromText $ maybe "" ("\n" <>) blockHeader-            , maybe "" ("\n" <>) (renderSourceLines slines block <$> N.nonEmpty blockPointers)+            , maybe "" ("\n" <>) $ renderSourceLines slines block padding blockPointersGrouped             , TB.fromText $ maybe "" ("\n" <>) blockBody             ] --- | The source lines for a block.+-- | Renders the source lines for a block. renderSourceLines-    :: Source source-    => A.Array Int source-    -> Block-    -> N.NonEmpty Pointer-    -> TB.Builder-renderSourceLines slines (Block {..}) lspans = unsplit "\n" sourceLines+    :: forall source+    .  Source source+    => [(Line, source)]   -- ^ The source lines, from the minimum line to the maximum line for the block.+    -> Block              -- ^ The block to render.+    -> Int                -- ^ The length of the actual number of the maximum line.+    -> I.IntMap [Pointer] -- ^ The pointers of this block grouped by line.+    -> Maybe (TB.Builder)+renderSourceLines _ _ _ (I.null -> True) = Nothing+renderSourceLines slines (Block {..}) padding pointersGrouped = Just $ unsplit "\n" sourceLines     where         Style {..} = blockStyle -        -- Min and max line numbers, as well padding size before the line prefix.-        minLine = fst (M.findMin pointersGrouped)-        maxLine = fst (M.findMax pointersGrouped)-        padding = length (show maxLine)-         -- Shows a line in accordance to the style.         -- We might get a line that's out-of-bounds, usually the EOF line, so we can default to empty.-        showLine :: [(Column, Column)] -> Line -> TB.Builder-        showLine hs n = TB.fromText . maybe "" id . fmap (styleLine hs . sourceToText) $ indexLines slines (n - 1)+        showLine :: [(Column, Column)] -> source -> TB.Builder+        showLine hs = TB.fromText . styleLine hs . sourceToText          -- Generic prefix without line number.         prefix = mconcat@@ -98,50 +186,47 @@             , TB.fromText styleLinePrefix, " "             ] -        -- The pointers grouped by line.-        pointersGrouped = M.fromListWith (<>) $ map (\x -> (pointerLine x, pure x)) (N.toList lspans)-         -- The resulting source lines.         -- Extra prefix for padding.         sourceLines = mconcat [replicateB padding " ", " ", TB.fromText styleLinePrefix]-            : makeSourceLines 0 [minLine .. maxLine]+            : makeSourceLines 0 slines          -- Whether there will be a multiline span.-        hasConnMulti = M.size (M.filter (any pointerConnect) pointersGrouped) > 1+        hasConnMulti = I.size (I.filter (any pointerConnect) pointersGrouped) > 1          -- Whether line /n/ has a connection to somewhere else (including the same line).         hasConn :: Line -> Bool-        hasConn n = maybe False (any pointerConnect) $ M.lookup n pointersGrouped+        hasConn n = maybe False (any pointerConnect) $ I.lookup n pointersGrouped          -- Whether line /n/ has a connection to a line before or after it (but not including).         connAround :: Line -> (Bool, Bool)         connAround n =-            let (a, b) = M.split n pointersGrouped+            let (a, b) = I.split n pointersGrouped             in ((any . any) pointerConnect a, (any . any) pointerConnect b)          -- Makes the source lines.         -- We have an @extra@ parameter to keep track of extra lines when spanning multiple lines.-        makeSourceLines :: Line -> [Line] -> [TB.Builder]+        makeSourceLines :: Line -> [(Line, source)] -> [TB.Builder]          -- No lines left.         makeSourceLines _ [] = []          -- The next line is a line we have to decorate with pointers.-        makeSourceLines _ (n:ns)-            | Just p <- M.lookup n pointersGrouped = makeDecoratedLines p <> makeSourceLines 0 ns+        makeSourceLines _ (pr@(n, _):ns)+            | Just p <- I.lookup n pointersGrouped = makeDecoratedLines p pr <> makeSourceLines 0 ns          -- The next line is an extra line, within a limit (currently 2, may be configurable later).-        makeSourceLines extra (n:ns)+        makeSourceLines extra ((n, l):ns)             | extra < 2 =                 let mid = if                         | snd (connAround n) -> TB.fromText styleVertical <> " "                         | hasConnMulti       -> "  "                         | otherwise          -> ""-                in (linePrefix n <> mid <> showLine [] n) : makeSourceLines (extra + 1) ns+                in (linePrefix n <> mid <> showLine [] l) : makeSourceLines (extra + 1) ns          -- We reached the extra line limit, so now there's some logic to figure out what's next.         makeSourceLines _ ns =-            let (es, ns') = break (`M.member` pointersGrouped) ns+            let (es, ns') = break ((`I.member` pointersGrouped) . fst) ns             in case (es, ns') of                 -- There were no lines left to decorate anyways.                 (_, []) -> []@@ -151,27 +236,28 @@                  -- There is a single extra line, so we can use that as the before-line.                 -- No need for omission, because it came right before.-                ([n], _) ->+                ([(n, l)], _) ->                     let mid = if                             | snd (connAround n) -> TB.fromText styleVertical <> " "                             | hasConnMulti       -> "  "                             | otherwise          -> ""-                    in (linePrefix n <> mid <> showLine [] n) : makeSourceLines 0 ns'+                    in (linePrefix n <> mid <> showLine [] l) : makeSourceLines 0 ns'                  -- There are more than one line in between, so we omit all but the last.                 -- We use the last one as the before-line.                 (_, _) ->-                    let n = last es+                    let (n, l) = last es                         mid = if                             | snd (connAround n) -> TB.fromText styleVertical <> " "                             | hasConnMulti       -> "  "                             | otherwise          -> ""-                    in (omitPrefix <> mid) : (linePrefix n <> mid <> showLine [] n) : makeSourceLines 0 ns'+                    in (omitPrefix <> mid) : (linePrefix n <> mid <> showLine [] l) : makeSourceLines 0 ns'          -- Decorate a line that has pointers.         -- The pointers we get are assumed to be all on the same line.-        makeDecoratedLines :: N.NonEmpty Pointer -> [TB.Builder]-        makeDecoratedLines pointers = (linePrefix line <> TB.fromText lineConnector <> sline) : decorationLines+        makeDecoratedLines :: [Pointer] -> (Line, source) -> [TB.Builder]+        makeDecoratedLines pointers (num, line) =+            (linePrefix num <> TB.fromText lineConnector <> sline) : decorationLines             where                 lineConnector = if                     | hasConnBefore && hasConnUnder -> styleVertical <> " "@@ -179,41 +265,36 @@                     | otherwise                     -> ""                  -- Shortcuts to where this line connects to.-                hasConnHere = hasConn line-                (hasConnBefore, hasConnAfter) = connAround line+                hasConnHere = hasConn num+                (hasConnBefore, hasConnAfter) = connAround num                 hasConnAround = hasConnBefore || hasConnAfter                 hasConnOver = hasConnHere || hasConnBefore                 hasConnUnder = hasConnHere || hasConnAfter                  -- The sorted pointers by column.-                -- There's a reverse for when we create decorations.-                pointersSorted = N.fromList . sortOn pointerColumns $ N.toList pointers-                pointersSorted' = N.reverse pointersSorted+                pointersSorted = sortOn pointerColumns pointers -                -- The line we're on.-                line = pointerLine $ N.head pointers-                sline = showLine (map pointerColumns (N.toList pointersSorted)) line+                -- The line number we're on.+                sline = showLine (map pointerColumns pointersSorted) line                  -- The resulting decoration lines.-                decorationLines = if+                decorationLines = case filter (isJust . pointerLabel) (init pointersSorted) of                     -- There's only one pointer, so no need for more than just an underline and label.-                    | N.length pointersSorted' == 1                           -> [underline pointersSorted']+                    _ | length pointersSorted == 1 -> [underline pointersSorted]                      -- There's no labels at all, so we just need the underline.-                    | all (isNothing . pointerLabel) (N.tail pointersSorted') -> [underline pointersSorted']+                    [] -> [underline pointersSorted]                      -- Otherwise, we have three steps to do:-                    --   The underline directly underneath.-                    --   An extra connector for the labels other than the rightmost one.-                    --   The remaining connectors and the labels.-                    | otherwise ->-                        let hasLabels = filter (isJust . pointerLabel) $ N.tail pointersSorted'-                        in underline pointersSorted'-                            : connectors hasLabels-                            : parar (\a (rest, xs) -> connectorAndLabel rest a : xs) [] hasLabels+                    -- The underline directly underneath.+                    -- An extra connector for the labels other than the rightmost one.+                    -- The remaining connectors and the labels.+                    hasLabels -> underline pointersSorted+                        : connectors hasLabels+                        : (map connectorAndLabel . reverse . tail $ inits hasLabels) -                -- Create an underline directly under the source.-                underline :: N.NonEmpty Pointer -> TB.Builder+                -- Create an underline directly under the source. The last pointer can have a label on this line.+                underline :: [Pointer] -> TB.Builder                 underline ps =                     let (decor, _) = foldDecorations                             (\n isFirst rest -> if@@ -222,27 +303,24 @@                                 | any pointerConnect rest                             -> replicateB n styleHorizontal                                 | otherwise                                           -> replicateB n " "                             )-                            ""-                            (\n -> replicateB n styleUnderline)-                            (N.toList ps)-                        lbl = maybe "" (" " <>) . pointerLabel $ N.head ps+                            (\n -> (n, replicateB n styleUnderline))+                            ps+                        lbl = maybe "" (" " <>) . pointerLabel $ last ps                         mid = if                             | hasConnHere && hasConnBefore && hasConnAfter -> styleUpDownRight <> styleHorizontal                             | hasConnHere && hasConnBefore                 -> styleUpRight <> styleHorizontal                             | hasConnHere && hasConnAfter                  -> styleDownRight <> styleHorizontal                             | hasConnBefore && hasConnAfter                -> styleVertical <> " "                             | hasConnMulti                                 -> "  "-                            | otherwise -> ""+                            | otherwise                                    -> ""                     in prefix <> TB.fromText mid <> decor <> TB.fromText lbl -                -- Create connectors underneath.-                -- It's assumed all these pointers have labels.+                -- Create connectors underneath. No labels are rendered here.                 connectors :: [Pointer] -> TB.Builder                 connectors ps =                     let (decor, _) = foldDecorations                             (\n _ _ -> replicateB n " ")-                            (TB.fromText styleVertical)-                            (\n -> replicateB (n - 1) " ")+                            (\_ -> (1, TB.fromText styleVertical))                             ps                         mid = if                             | hasConnOver && hasConnAfter -> styleVertical <> " "@@ -250,25 +328,22 @@                             | otherwise                   -> ""                     in prefix <> TB.fromText mid <> decor -                -- Create connectors and labels underneath.-                -- It's assumed all these pointers have labels.-                -- The single pointer passed in is the label to make at the end of the decorations.-                connectorAndLabel :: [Pointer] -> Pointer -> TB.Builder-                connectorAndLabel ps p =+                -- Create connectors and labels underneath. The last pointer can have a label on this line.+                connectorAndLabel :: [Pointer] -> TB.Builder+                connectorAndLabel ps =                     let (decor, finalCol) = foldDecorations                             (\n _ _ -> replicateB n " ")-                            (TB.fromText styleVertical)-                            (\n -> replicateB (n - 1) " ")-                            ps+                            (\_ -> (1, TB.fromText styleVertical))+                            (init ps)                         lbl = maybe ""                             (\x -> mconcat-                                [ replicateB (pointerColStart p - finalCol) " "+                                [ replicateB (pointerColStart (last ps) - finalCol) " "                                 , TB.fromText styleUpRight                                 , " "                                 , TB.fromText x                                 ]                             )-                            (pointerLabel p)+                            (pointerLabel (last ps))                         mid = if                             | hasConnOver && hasConnAfter -> styleVertical <> " "                             | hasConnMulti                -> "  "@@ -278,36 +353,37 @@ -- | Makes a line of decorations below the source. foldDecorations     :: (Column -> Bool -> [Pointer] -> TB.Builder) -- ^ Catch up from the previous pointer to this pointer.-    -> TB.Builder                                  -- ^ Something in the middle.-    -> (Column -> TB.Builder)                      -- ^ Reach the next pointer.+    -> (Column -> (Int, TB.Builder))               -- ^ Something in the middle that ends before the next pointer.     -> [Pointer]     -> (TB.Builder, Column)-foldDecorations catchUp something reachAfter ps =-    let (decor, finalCol, _, _) = foldr-            (\(Pointer {..}) (xs, c, rest, isFirst) ->+foldDecorations catchUp reachAfter ps =+    let (decor, finalCol, _) = paral+            (\(rest, (xs, c, isFirst)) p@(Pointer {..}) ->+                let (afterLen, afterText) = reachAfter (pointerColEnd - pointerColStart)+                in                 ( mconcat                     [ xs-                    , catchUp (pointerColStart - c) isFirst rest-                    , something-                    , reachAfter (pointerColEnd - pointerColStart)+                    , catchUp (pointerColStart - c) isFirst (p:rest)+                    , afterText                     ]-                , pointerColEnd-                , tail rest+                , pointerColStart + afterLen                 , False                 )             )-            ("", 1, reverse ps, True)+            ("", 1, True)             ps     in (decor, finalCol) --- | Paramorphism on lists (lazily, from the right).-parar :: (a -> ([a], b) -> b) -> b -> [a] -> b-parar _ b []     = b-parar f b (a:as) = f a (as, parar f b as)+-- | Paramorphism on lists (strictly, from the left).+paral :: (([a], b) -> a -> b) -> b -> [a] -> b+paral _ b [] = b+paral f b (a:as) =+    let !b' = f (as, b) a+    in paral f b' as  -- | Puts text between each item. unsplit :: TB.Builder -> [TB.Builder] -> TB.Builder-unsplit _ [] = ""+unsplit _ []     = "" unsplit a (x:xs) = foldl' (\acc y -> acc <> a <> y) x xs {-# INLINE unsplit #-} @@ -315,10 +391,3 @@ replicateB :: Int -> T.Text -> TB.Builder replicateB n xs = TB.fromText (T.replicate n xs) {-# INLINE replicateB #-}---- | Index safely into an array.-indexLines :: A.Array Int s -> Int -> Maybe s-indexLines slines i = if A.inRange (A.bounds slines) i-    then Just (A.unsafeAt slines i)-    else Nothing-{-# INLINE indexLines #-}

@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-}-{-|++{- | Module      : Errata.Source Copyright   : (c) 2020 comp License     : MIT@@ -10,18 +11,20 @@ A class for source text types. You should not need to use this, except to add new source types. -} module Errata.Source-    ( Source(..)+    ( Source (..)     ) where  import qualified Data.Text as T import qualified Data.Text.Lazy as TL -{-|-A class for manipulating and converting source text.+{- | A class for manipulating and converting source text.  For @ByteString@ source types, you should convert it to one of the built-in instances with your encoding of choice.++Every @Source@ must be a 'Monoid' to allow for a 'mempty' which will be used as a source line when a pointer references+an out-of-bounds line. -}-class Source s where+class Monoid s => Source s where     -- | Splits the source into lines.     sourceToLines :: s -> [s] 

@@ -1,4 +1,4 @@-{-|+{- | Module      : Errata.Types Copyright   : (c) 2020 comp License     : MIT@@ -17,13 +17,13 @@     , Body     , Label       -- * Error format data-    , Errata(..)+    , Errata (..)       -- * Blocks and pointers-    , Block(..)-    , Pointer(..)+    , Block (..)+    , Pointer (..)     , pointerColumns       -- * Styling options-    , Style(..)+    , Style (..)     , highlight     ) where @@ -46,119 +46,126 @@  -- | A collection of information for pretty printing an error. data Errata = Errata-    { errataHeader :: Maybe Header -- ^ The message that appears above all the blocks.-    , errataBlock  :: Block        -- ^ The main error block, which will be used for sorting errors.-    , errataBlocks :: [Block]      -- ^ Extra blocks in the source code to display. Blocks themselves are not sorted.-    , errataBody   :: Maybe Body   -- ^ The message that appears below all the blocks.+    { errataHeader :: Maybe Header+      -- ^ The message that appears above all the blocks.+    , errataBlocks :: [Block]+      -- ^ Blocks in the source code to display.+    , errataBody :: Maybe Body+      -- ^ The message that appears below all the blocks.     } -{-|-Information about a block in the source code, such as pointers and messages.+{- | Information about a block in the source code, such as pointers and messages.  Each block has a style associated with it. -} data Block = Block-    { -- | The style of the block.-      blockStyle :: Style--      {-|-      The filepath, line, and column of the block. These start at 1.--      This is used for sorting errors, as well as to create the text that details the location.-      -}+    { blockStyle :: Style+      -- ^ The style of the block.     , blockLocation :: (FilePath, Line, Column)+      {- ^ The filepath, line, and column of the block. These start at 1. -      -- | The header message for the block. This will appear below the location and above the source lines.+      This is used to create the text that details the location.+      -}     , blockHeader :: Maybe Header+      {- ^ The header message for the block. -      {-|-      The block's pointers. These are used to "point out" parts of the source code in this block.+      This will appear below the location and above the source lines.+      -}+    , blockPointers :: [Pointer]+      {- ^ The block's pointers. These are used to "point out" parts of the source code in this block.        The locations of each of these pointers must be non-overlapping. If the pointers are touching at a boundary       however, that is allowed.       -}-    , blockPointers :: [Pointer]--      -- | The body message for the block. This will appear below the source lines.     , blockBody :: Maybe Body+      {- ^ The body message for the block.++      This will appear below the source lines.+      -}     } -{-|-A pointer is the span of the source code at a line, from one column to another. Each of the positions start at 1.+{- | A pointer is the span of the source code at a line, from one column to another. Each of the positions start at 1.  A pointer may also have a label that will display inline.  A pointer may also be connected to all the other pointers within the same block. -} data Pointer = Pointer-    { pointerLine     :: Line        -- ^ The line of the pointer.-    , pointerColStart :: Column      -- ^ The starting column of the pointer.-    , pointerColEnd   :: Column      -- ^ The ending column of the pointer.-    , pointerConnect  :: Bool        -- ^ Whether this pointer connects with other pointers.-    , pointerLabel    :: Maybe Label -- ^ An optional label for the pointer.+    { pointerLine :: Line+      -- ^ The line of the pointer.+    , pointerColStart :: Column+      -- ^ The starting column of the pointer.+    , pointerColEnd :: Column+      -- ^ The ending column of the pointer.+    , pointerConnect :: Bool+      -- ^ Whether this pointer connects with other pointers.+    , pointerLabel :: Maybe Label+      -- ^ An optional label for the pointer.     }+    deriving (Show, Eq)  -- | Gets the column span for a 'Pointer'.-pointerColumns :: Pointer -> (Line, Column)+pointerColumns :: Pointer -> (Column, Column) pointerColumns p = (pointerColStart p, pointerColEnd p)  -- | Stylization options for a block, e.g. characters to use. data Style = Style-    { -- | Shows the location of a block at a file, line, and column.-      styleLocation :: (FilePath, Line, Column) -> T.Text+    { styleLocation :: (FilePath, Line, Column) -> T.Text+      {- ^ Shows the location of a block at a file, line, and column. -      -- | Shows the line number /n/ for a source line. The result should visually be the same length as just @show n@.+      This is put on its own line just above the source lines.+      -}     , styleNumber :: Line -> T.Text--      {-|-      Stylize a source line.+      {- ^ Shows the line number /n/ for a source line. -      Column pointers of the text that are being underlined are given for highlighting purposes. The result of this-      should visually take up the same space as the original line.+      The result should visually be the same length as just @show n@.       -}     , styleLine :: [(Column, Column)] -> T.Text -> T.Text+      {- ^ Stylize a source line. -      {-|-      The text to use as an ellipsis in the position of line numbers for when lines are omitted. This should visually-      be one character.+      Column pointers of the text that are being underlined are given for highlighting purposes. The result of this+      should visually take up the same space as the original line.       -}     , styleEllipsis :: T.Text+      {- ^ The text to use as an ellipsis in the position of line numbers for when lines are omitted. -      -- | The prefix before the source lines.+      This should visually be one character.+      -}     , styleLinePrefix :: T.Text+      {- ^ The prefix before the source lines. -      {-|-      The text to underline a character in a pointer. This should visually be one character.+      Before it may be the line number, and after it the source line.       -}     , styleUnderline :: T.Text+      {- ^ The text to underline a character in a pointer. -      {-|-      The text to use as a vertical bar when connecting pointers. This should visually be one character.+      This should visually be one character.       -}     , styleVertical :: T.Text+      {- ^ The text to use as a vertical bar when connecting pointers. -      {-|-      The text to use as a horizontal bar when connecting pointers. This should visually be one character.+      This should visually be one character.       -}     , styleHorizontal :: T.Text+      {- ^ The text to use as a horizontal bar when connecting pointers. -      {-|-      The text to use as a connector downwards and rightwards when connecting pointers. This should visually-      be one character.+      This should visually be one character.       -}     , styleDownRight :: T.Text+      {- ^ The text to use as a connector downwards and rightwards when connecting pointers. -      {-|-      The text to use as a connector upwards and rightwards when connecting pointers. This should visually-      be one character.+      This should visually be one character.       -}     , styleUpRight :: T.Text+      {- ^ The text to use as a connector upwards and rightwards when connecting pointers. -      {-|-      The text to use as a connector upwards, downwards, and rightwards when connecting pointers. This should visually-      be one character.+      This should visually be one character.       -}     , styleUpDownRight :: T.Text+      {- ^ The text to use as a connector upwards, downwards, and rightwards when connecting pointers.++      This should visually be one character.+      -}     }  -- | Adds highlighting to spans of text by enclosing it with some text e.g ANSI escape codes.

@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}++module Errata.TypesSpec+    ( spec+    ) where++import Errata.Types+import Test.Hspec++spec :: Spec+spec = do+    describe "pointerColumns" $ do+        it "gets the columns" $+            pointerColumns (Pointer 1 2 3 False Nothing) `shouldBe` (2, 3)++    describe "highlight" $ do+        it "brackets parts of text" $+            highlight "(" ")" [(2, 4), (6, 7)] "12345678" `shouldBe` "1(23)45(6)78"++        it "brackets empty column spans" $+            highlight "(" ")" [(1, 1)] "1234" `shouldBe` "()1234"++        it "does nothing with no columns" $+            highlight "(" ")" [] "123" `shouldBe` "123"++        it "puts text for out of bounds columns at the end" $+            highlight "(" ")" [(3, 5), (6, 7)] "1234" `shouldBe` "12(34)()"

@@ -0,0 +1,290 @@+{-# LANGUAGE OverloadedStrings #-}++module ErrataSpec+    ( spec+    ) where++import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy as TL+import           Errata+import           Test.Hspec+import           Test.Hspec.Golden++spec :: Spec+spec = do+    describe "blockMerged" $ do+        it "merges pointers on the same line" $+            let b = blockMerged basicStyle "here" Nothing (1, 1, 2, Just "a") (1, 3, 4, Just "b") (Just "c") Nothing+                pointers = [Pointer 1 1 4 False (Just "c")]+            in blockPointers b `shouldBe` pointers++        it "does not merge pointers on different line" $+            let b = blockMerged basicStyle "here" Nothing (1, 1, 2, Just "a") (2, 3, 4, Just "b") (Just "c") Nothing+                pointers = [Pointer 1 1 2 True (Just "a"), Pointer 2 3 4 True (Just "b")]+            in blockPointers b `shouldBe` pointers++    describe "prettyErrors" goldenTests++goldenTests :: Spec+goldenTests = do+    golden+        "T000"+        "hello world"+        [ Errata+            (Just "error")+            [ Block+                basicStyle+                ("simple", 1, 1)+                Nothing+                [Pointer 1 1 6 False Nothing]+                Nothing+            ]+            Nothing+        ]++    golden+        "T001"+        "foo = if 1 > 2\n    then 100\n    else \"uh oh\""+        [ Errata+            (Just "error[E001]: mismatching types in `if` expression")+            [ Block+                basicStyle+                ("file.hs", 3, 10)+                Nothing+                [ Pointer 2 10 13 False (Just "this has type `Int`")+                , Pointer 3 10 17 False (Just "but this has type `String`")+                ]+                Nothing+            , Block+                basicStyle+                ("file.hs", 1, 7)+                Nothing+                [ Pointer 1 7 9 True Nothing+                , Pointer 2 5 9 True Nothing+                , Pointer 3 5 9 True (Just "in this `if` expression")+                ]+                Nothing+            ]+            (Just "\nnote: use --explain E001 to learn more")+        ]++    golden+        "T002"+        "sum xs = fold (+) 0 xs"+        [ Errata+            (Just "─────── NAME UNKNOWN ───────\n\nThe name fold was not found.\n")+            [ Block+                basicStyle+                ("file.hs", 1, 10)+                Nothing+                [Pointer 1 10 14 False Nothing]+                Nothing+            ]+            (Just "\nDid you mean to use one of these?\n\n    foldl\n    foldr")+        ]++    golden+        "T003"+        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"+        [ adhoc+            [ Pointer 1 2 4 False (Just "label")+            ]+        ]++    golden+        "T004"+        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"+        [ adhoc+            [ Pointer 1 2 4 False (Just "x")+            , Pointer 1 6 8 False (Just "y")+            , Pointer 1 10 12 False (Just "z")+            , Pointer 2 5 8 False (Just "w")+            ]+        ]++    golden+        "T005"+        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"+        [ adhoc+            [ Pointer 1 2 4 True (Just "x")+            , Pointer 1 6 8 True (Just "y")+            , Pointer 1 10 12 True (Just "z")+            , Pointer 2 5 8 True (Just "w")+            ]+        ]++    golden+        "T006"+        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"+        [ adhoc+            [ Pointer 1 2 4 True (Just "x")+            , Pointer 1 6 8 False (Just "y")+            , Pointer 1 10 12 True (Just "z")+            , Pointer 2 5 8 False (Just "w")+            ]+        ]++    golden+        "T007"+        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"+        [ adhoc+            [ Pointer 1 2 4 True (Just "x")+            , Pointer 1 6 8 True Nothing+            , Pointer 1 10 12 False (Just "z")+            , Pointer 2 5 8 False (Just "w")+            , Pointer 3 1 3 True (Just "v")+            ]+        ]++    golden+        "T008"+        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"+        [ adhoc+            [+            ]+        ]++    golden+        "T009"+        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"+        [ adhoc+            [ Pointer 4 1 2 False (Just "empty")+            ]+        ]++    golden+        "T010"+        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"+        [ adhoc+            [ Pointer 1 1 1 False (Just "empty")+            ]+        ]++    golden+        "T011"+        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"+        [ adhoc+            [ Pointer 1 15 16 False (Just "empty")+            ]+        ]++    golden+        "T012"+        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"+        [ adhoc+            [ Pointer 1 1 2 True (Just "x")+            , Pointer 1 3 4 True (Just "y")+            , Pointer 1 5 6 False (Just "z")+            , Pointer 1 7 8 False (Just "z")+            , Pointer 1 9 10 False (Just "z")+            , Pointer 2 5 8 False (Just "w")+            , Pointer 3 1 3 True (Just "v")+            ]+        ]++    golden+        "T013"+        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"+        [ adhoc+            [ Pointer 1 1 2 True (Just "x")+            , Pointer 1 3 4 True (Just "y")+            , Pointer 1 7 8 True Nothing+            , Pointer 1 9 10 True (Just "z")+            , Pointer 2 5 8 False (Just "w")+            , Pointer 3 1 3 True (Just "v")+            ]+        ]++    golden+        "T014"+        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"+        [ adhoc+            [ Pointer 1 1 4 True (Just "x")+            , Pointer 1 6 9 True (Just "x")+            , Pointer 3 1 3 True (Just "y")+            , Pointer 3 5 7 True (Just "y")+            ]+        ]++    golden+        "T015"+        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"+        [ adhoc+            [ Pointer 1 1 3 False Nothing+            , Pointer 1 5 6 False Nothing+            , Pointer 1 7 9 False (Just "x")+            ]+        ]++    golden+        "T016"+        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"+        [ adhoc+            [ Pointer 1 1 3 True Nothing+            , Pointer 1 5 6 True Nothing+            , Pointer 1 7 9 True (Just "x")+            ]+        ]++    golden+        "T017"+        "foo\nbar"+        []++    golden+        "T018"+        "foo\nbar"+        [ Errata (Just "header") [] (Just "body")+        ]++    golden+        "T019"+        "foo\nbar"+        [ Errata Nothing [] Nothing+        ]++    golden+        "T020"+        "foo\nbar"+        [ Errata+            (Just "header")+            [ Block basicStyle ("here", 1, 1) (Just "block header") [] (Just "block body")+            ]+            (Just "body")+        ]++    golden+        "T021"+        "foo\nbar"+        [ Errata+            Nothing+            [ Block basicStyle ("here", 1, 1) (Just "block header") [] (Just "block body")+            ]+            Nothing+        ]++-- | Create a golden test by printing a list of 'Errata'.+golden :: String -> T.Text -> [Errata] -> Spec+golden name source es = it name $ Golden+    { output = TL.toStrict $ prettyErrors source es+    , encodePretty = T.unpack+    , testName = name+    , writeToFile = T.writeFile+    , readFromFile = T.readFile+    , directory = "./test/.golden"+    , failFirstTime = False+    }++-- | Usually, the meat of the work is in just printing one block. This makes an 'Errata' out of a bunch of pointers.+adhoc :: [Pointer] -> Errata+adhoc ps = Errata+    (Just "an error")+    [ Block+        basicStyle+        ("here", 1, 1)+        Nothing+        ps+        (Just "an error occurred here")+    ]+    Nothing

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}