errata 0.3.0.0 → 0.4.0.0

raw patch · 12 files changed

+1185/−375 lines, 12 filesdep ~containersdep ~hspec-goldendep ~textPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: containers, hspec-golden, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +44/−0
• LICENSE +1/−1
• errata.cabal +16/−7
• example/Main.hs +100/−10
• src/Errata.hs +30/−140
• src/Errata/Internal/Render.hs +250/−110
• src/Errata/Source.hs +9/−5
• src/Errata/Styles.hs +222/−0
• src/Errata/Types.hs +111/−29
• test/Errata/StylesSpec.hs +27/−0
• test/Errata/TypesSpec.hs +2/−14
• test/ErrataSpec.hs +373/−59

@@ -2,6 +2,50 @@  **Errata** uses [PVP Versioning](https://pvp.haskell.org). +## 0.4.0.0++* Added styling individual pointers with `PointerStyle` (e.g. characters, highlighting).+    * This changes how `styleLine` and `highlight` works and moves `styleUnderline` to `PointerStyle`.++    * This also adds a `PointerStyle` parameter to the helper functions so e.g. `blockSimple fancyStyle ...` should now be `blockSimple fancyStyle fancyPointer ...`.++    * Crazy example from the tests (you can imagine coloring things differently):+        ```+        an error+        --> here:1:1+          |+        1 | abcdefghijk+          |  ..  ~~  ^^ z+          |  |   :+          |  |   2 y+          |  1 x+        2 | lmnopqrstuv+          |     ''' w+        an error occurred here+        ```++* Moved existing and added new premade styles to `Errata.Styles`. `Errata` no longer exports premade styles. Also moved `highlight` there.++* Added support for characters with different widths (full-width, combining characters, others). The cabal flag `usewcwidth` (default false) can be enabled to use the native `wcwidth` function.++* Added support for replacing tabs with spaces with the `styleTabWidth` option in `Style` (defaults to 4).++* Added option for the lines before and after the omission line with `styleExtraLinesAfter` and `styleExtraLinesBefore` in `Style`.++* Added option for padding lines before and after the source `stylePaddingTop` and `stylePaddingBottom` in `Style`.++* Added option for disabling the hook with `styleEnableHook` in `PointerStyle`.++* Added option for toggling all decorations completely with `styleEnableDecorations` in `Style`. Useful if you only want highlighting and not underlining. Combine with `stylePaddingTop = False` for a compact source code block.++* Added option for toggling the line prefixes with `styleEnableLinePrefix` in `Style`.++* Added `Show` instances to all the types. Style functions are applied to some sample text.++* Changed `Monoid` constraint of `Source` to just requiring an `emptySource` value.++* Fixed trailing whitespace in the omission line.+ ## 0.3.0.0  * Support GHC 9.0.1 (and eventually 9.2).

@@ -1,6 +1,6 @@ MIT License -Copyright (c) 2020-2021 comp+Copyright (c) 2020- 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.3.0.0+version:       0.4.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-2021 comp+copyright:     (c) 2020- comp category:      Pretty Printer build-type:    Simple extra-doc-files:     README.md     CHANGELOG.md tested-with:-    GHC == 9.0.1-  , GHC == 8.10.4+    GHC == 9.2.1+  , GHC == 9.0.2+  , GHC == 8.10.7   , GHC == 8.8.4   , GHC == 8.6.5 @@ -29,11 +30,15 @@   type:     git   location: https://github.com/1Computer1/errata.git +flag usewcwidth+  description: Enable the use of wcwidth for character widths. If disabled, uses an incomplete premade version.+  default: False+ common common-options   build-depends:       base >= 4.12 && < 4.17-    , containers >= 0.6.0.1 && < 0.7-    , text >= 1.2.3.1 && < 1.3+    , containers >= 0.6 && < 0.7+    , text >= 1.2.3 && < 2.1   ghc-options:       -Wall       -Wcompat@@ -52,7 +57,10 @@       Errata       Errata.Internal.Render       Errata.Source+      Errata.Styles       Errata.Types+  if flag(usewcwidth)+    cpp-options: -Dusewcwidth  test-suite errata-test   import:         common-options@@ -61,11 +69,12 @@   main-is:        Spec.hs   other-modules:       ErrataSpec+    , Errata.StylesSpec     , Errata.TypesSpec   build-depends:       errata     , hspec >= 2.7 && < 3-    , hspec-golden >= 0.1 && < 0.2+    , hspec-golden >= 0.2 && < 0.3   build-tool-depends:       hspec-discover:hspec-discover >= 2.7 && < 3   ghc-options:

@@ -4,10 +4,11 @@ module Main     where -import           Data.List+import           Data.List (intersperse) import qualified Data.Text as T import qualified Data.Text.Lazy.IO as TL import           Errata+import           Errata.Styles  ------------------------------------------------------------- -- Definitions from the Haddock example for 'prettyErrors' --@@ -25,7 +26,7 @@ toErrata (ParseError fp l c unexpected expected) =     errataSimple         (Just "an error occured!")-        (blockSimple basicStyle fp+        (blockSimple basicStyle basicPointer fp             (Just "error: invalid syntax")             (l, c, c + T.length unexpected, Just "this one")             (Just $ "unexpected " <> unexpected <> "\nexpected " <> T.intercalate ", " expected))@@ -51,15 +52,31 @@     [ Errata         (Just "\x1b[31m─────── NAME UNKNOWN ───────\x1b[0m\n\nThe name \x1b[31mfold\x1b[0m was not found.\n")         [ Block-            fancyRedStyle { styleUnderline = " " }+            fancyRedStyle             ("file.hs", 1, 10)             Nothing-            [Pointer 1 10 14 False Nothing]+            [Pointer 1 10 14 False Nothing fancyRedPointer]             Nothing         ]         (Just "\nDid you mean to use one of these?\n\n    \x1b[31mfoldl\x1b[0m\n    \x1b[31mfoldr\x1b[0m")     ] +-- | The fold example with no decorations and padding.+foldNoDecorExample :: IO ()+foldNoDecorExample = 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 { styleEnableDecorations = False, stylePaddingTop = False })+            ("file.hs", 1, 10)+            Nothing+            [Pointer 1 10 14 False Nothing fancyRedPointer]+            Nothing+        ]+        (Just "\nDid you mean to use one of these?\n\n    \x1b[31mfoldl\x1b[0m\n    \x1b[31mfoldr\x1b[0m")+    ]+ -- | From the README. ifExample :: IO () ifExample = TL.putStrLn $ prettyErrors @String@@ -70,26 +87,99 @@             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")+            [ Pointer 2 10 13 False (Just "\x1b[31mthis has type `Int`\x1b[0m") fancyRedPointer+            , Pointer 3 10 17 False (Just "\x1b[31mbut this has type `String`\x1b[0m") fancyRedPointer             ]             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")+            [ Pointer 1 7 9 True Nothing fancyYellowPointer+            , Pointer 2 5 9 True Nothing fancyYellowPointer+            , Pointer 3 5 9 True (Just "\x1b[33min this `if` expression\x1b[0m") fancyYellowPointer             ]             Nothing         ]         (Just "\n\x1b[33mnote: use --explain E001 to learn more\x1b[0m")     ] +-- | The if example with a mixed-colors block.+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+            fancyYellowStyle+            ("file.hs", 3, 10)+            Nothing+            [ Pointer 2 10 13 False (Just "\x1b[31mthis has type `Int`\x1b[0m") fancyRedPointer+            , Pointer 3 10 17 False (Just "\x1b[31mbut this has type `String`\x1b[0m") fancyRedPointer+            , Pointer 1 7 9 True Nothing (fancyYellowPointer { styleUnderline = "\x1b[33m-\x1b[0m" })+            , Pointer 2 5 9 True Nothing (fancyYellowPointer { styleUnderline = "\x1b[33m-\x1b[0m" })+            , Pointer 3 5 9 True (Just "\x1b[33min this `if` expression\x1b[0m") (fancyYellowPointer { styleUnderline = "\x1b[33m-\x1b[0m" })+            ]+            Nothing+        ]+        (Just "\n\x1b[33mnote: use --explain E001 to learn more\x1b[0m")+    ]++-- | From the documentation for premade styles.+stylesExample :: Style -> PointerStyle -> IO ()+stylesExample style pstyle = TL.putStrLn $ prettyErrors @String+    "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end"+    [ Errata+        (Just "error header message")+        [ Block+            style+            ("file.ext", 1, 16)+            (Just "block header message")+            [ Pointer 1 16 18 True (Just "start label") pstyle+            , Pointer 2 6 7 False (Just "unconnected label") pstyle+            , Pointer 3 6 7 True (Just "middle label") pstyle+            , Pointer 8 6 7 True (Just "inner label") pstyle+            , Pointer 8 12 15 True (Just "end label") pstyle+            ]+            (Just "block body message")+        ]+        (Just "error body message")+    ]++-- | From a test, but with colors.+noDecorExample :: IO ()+noDecorExample = TL.putStrLn $ prettyErrors @String+    "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end"+    [ Errata+        (Just "error header message")+        [ Block+            (fancyRedStyle { styleEnableDecorations = False, stylePaddingTop = False })+            ("file.ext", 1, 16)+            (Just "block header message")+            [ Pointer 1 16 18 True (Just "start label") fancyRedPointer+            , Pointer 2 6 7 False (Just "unconnected label") fancyRedPointer+            , Pointer 3 6 7 True (Just "middle label") fancyRedPointer+            , Pointer 8 6 7 True (Just "inner label") fancyRedPointer+            , Pointer 8 12 15 True (Just "end label") fancyRedPointer+            ]+            (Just "block body message")+        ]+        (Just "error body message")+    ]+ main :: IO () main = sequence_ . intersperse (putStrLn "") $     [ jsonExample     , foldExample+    , foldNoDecorExample     , ifExample-    ]+    , ifExample'+    , noDecorExample+    ] <> map (uncurry stylesExample $) themes+    where+        themes =+            [ (basicStyle, basicPointer)+            , (fancyStyle, fancyPointer)+            , (fancyRedStyle, fancyRedPointer)+            , (fancyYellowStyle, fancyYellowPointer)+            ]

@@ -1,8 +1,6 @@-{-# LANGUAGE OverloadedStrings #-}- {- | Module      : Errata-Copyright   : (c) 2020 comp+Copyright   : (c) 2020- comp License     : MIT Maintainer  : onecomputer00@gmail.com Stability   : stable@@ -18,6 +16,8 @@ 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 premade styles for blocks and pointers, take a look at "Errata.Styles".+ For easier reading, we define:  > type Line = Int@@ -41,15 +41,11 @@     , Pointer (..)       -- * Styling options     , Style (..)-    , basicStyle-    , fancyStyle-    , fancyRedStyle-    , fancyYellowStyle+    , PointerStyle (..)       -- * Pretty printer     , prettyErrors     ) where -import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import           Errata.Internal.Render@@ -70,66 +66,71 @@  -- | A simple block that points to only one line and optionally has a label, header, or body message. blockSimple-    :: Style                               -- ^ The style of the pointer.+    :: Style                               -- ^ The style of the block.+    -> PointerStyle                        -- ^ The style of the pointer.     -> FilePath                            -- ^ The filepath.     -> Maybe Header                        -- ^ The header message.     -> (Line, Column, Column, Maybe Label) -- ^ The line number and column span, starting at 1, and a label.     -> Maybe Body                          -- ^ The body message.     -> Block-blockSimple style fp hm (l, cs, ce, lbl) bm = Block+blockSimple style pstyle fp hm (l, cs, ce, lbl) bm = Block     { blockStyle = style     , blockLocation = (fp, l, cs)     , blockHeader = hm-    , blockPointers = [Pointer l cs ce False lbl]+    , blockPointers = [Pointer l cs ce False lbl pstyle]     , blockBody = bm     }  -- | A variant of 'blockSimple' that only points at one column. blockSimple'-    :: Style                       -- ^ The style of the pointer.+    :: Style                       -- ^ The style of the block.+    -> PointerStyle                -- ^ The style of the pointer.     -> FilePath                    -- ^ The filepath.     -> Maybe Header                -- ^ The header message.     -> (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 =-    blockSimple style fp hm (l, c, c + 1, lbl) bm+blockSimple' style pstyle fp hm (l, c, lbl) bm =+    blockSimple style pstyle fp hm (l, c, c + 1, lbl) bm  -- | A block that points to two parts of the source that are visually connected together. blockConnected-    :: Style                               -- ^ The style of the pointer.+    :: Style                               -- ^ The style of the block.+    -> PointerStyle                        -- ^ The style of the pointer.     -> FilePath                            -- ^ The filepath.     -> Maybe Header                        -- ^ The header message.     -> (Line, Column, Column, Maybe Label) -- ^ The first line number and column span, starting at 1, and a label.     -> (Line, Column, Column, Maybe Label) -- ^ The second line number and column span, starting at 1, and a label.     -> Maybe Body                          -- ^ The body message.     -> Block-blockConnected style fp hm (l1, cs1, ce1, lbl1) (l2, cs2, ce2, lbl2) bm = Block+blockConnected style pstyle fp hm (l1, cs1, ce1, lbl1) (l2, cs2, ce2, lbl2) bm = Block     { blockStyle = style     , blockLocation = (fp, l1, cs1)     , blockHeader = hm-    , blockPointers = [Pointer l1 cs1 ce1 True lbl1, Pointer l2 cs2 ce2 True lbl2]+    , blockPointers = [Pointer l1 cs1 ce1 True lbl1 pstyle, Pointer l2 cs2 ce2 True lbl2 pstyle]     , blockBody = bm     }  -- | A variant of 'blockConnected' where the pointers point at only one column. blockConnected'-    :: Style                       -- ^ The style of the pointer.+    :: Style                       -- ^ The style of the block.+    -> PointerStyle                -- ^ The style of the pointer.     -> FilePath                    -- ^ The filepath.     -> Maybe Header                -- ^ The header message.     -> (Line, Column, Maybe Label) -- ^ The first line number and column, starting at 1, and a label.     -> (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 =-    blockConnected style fp hm (l1, c1, c1 + 1, lbl1) (l2, c2, c2 + 1, lbl2) bm+blockConnected' style pstyle fp hm (l1, c1, lbl1) (l2, c2, lbl2) bm =+    blockConnected style pstyle 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.  If the two parts of the source happen to be on the same line, the pointers are merged into one. -} blockMerged-    :: Style                               -- ^ The style of the pointer.+    :: Style                               -- ^ The style of the block.+    -> PointerStyle                        -- ^ The style of the pointer.     -> FilePath                            -- ^ The filepath.     -> Maybe Header                        -- ^ The header message.     -> (Line, Column, Column, Maybe Label) -- ^ The first line number and column span, starting at 1, and a label.@@ -137,19 +138,20 @@     -> Maybe Label                         -- ^ The label for when the two pointers are merged into one.     -> Maybe Body                          -- ^ The body message.     -> Block-blockMerged style fp hm (l1, cs1, ce1, lbl1) (l2, cs2, ce2, lbl2) lbl bm = Block+blockMerged style pstyle fp hm (l1, cs1, ce1, lbl1) (l2, cs2, ce2, lbl2) lbl bm = Block     { blockStyle = style     , blockLocation = (fp, l1, cs1)     , blockHeader = hm     , blockPointers = if l1 == l2-        then [Pointer l1 cs1 ce2 False lbl]-        else [Pointer l1 cs1 ce1 True lbl1, Pointer l2 cs2 ce2 True lbl2]+        then [Pointer l1 cs1 ce2 False lbl pstyle]+        else [Pointer l1 cs1 ce1 True lbl1 pstyle, Pointer l2 cs2 ce2 True lbl2 pstyle]     , blockBody = bm     }  -- | A variant of 'blockMerged' where the pointers point at only one column. blockMerged'-    :: Style                       -- ^ The style of the pointer.+    :: Style                       -- ^ The style of the block.+    -> PointerStyle                -- ^ The style of the pointer.     -> FilePath                    -- ^ The filepath.     -> Maybe Header                -- ^ The header message.     -> (Line, Column, Maybe Label) -- ^ The first line number and column, starting at 1, and a label.@@ -157,120 +159,8 @@     -> 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 =-    blockMerged style fp hm (l1, c1, c1 + 1, lbl1) (l2, c2, c2 + 1, lbl2) lbl bm--{- | A basic style using only ASCII characters.--Errors should look like so:--> error header message-> --> file.ext:1:16-> block header message->   |-> 1 |   line 1 foo bar do->   |  ________________^^ start label-> 2 | | line 2->   | |      ^ unconnected label-> 3 | | line 3-> . | |______^ middle label-> 6 | | line 6-> 7 | | line 7 baz end->   | |______^_____^^^ end label->   |        |->   |        | inner label-> block body message-> error body message--}-basicStyle :: Style-basicStyle = Style-    { styleLocation = \(fp, l, c) -> T.concat ["--> ", T.pack fp, ":", T.pack $ show l, ":", T.pack $ show c]-    , styleNumber = T.pack . show-    , styleLine = const id-    , styleEllipsis = "."-    , styleLinePrefix = "|"-    , styleUnderline = "^"-    , styleVertical = "|"-    , styleHorizontal = "_"-    , styleDownRight = " "-    , styleUpRight = "|"-    , styleUpDownRight = "|"-    }--{- | A fancy style using Unicode characters.--Errors should look like so:--> error header message-> → file.ext:1:16-> block header message->   │-> 1 │   line 1 foo bar do->   │ ┌────────────────^^ start label-> 2 │ │ line 2->   │ │      ^ unconnected label-> 3 │ │ line 3-> . │ ├──────^ middle label-> 6 │ │ line 6-> 7 │ │ line 7 baz end->   │ └──────^─────^^^ end label->   │        │->   │        └ inner label-> block body message-> error body message--}-fancyStyle :: Style-fancyStyle = Style-    { styleLocation = \(fp, l, c) -> T.concat-        [ "→ ", T.pack fp, ":", T.pack $ show l, ":", T.pack $ show c-        ]-    , styleNumber = T.pack . show-    , styleLine = const id-    , styleEllipsis = "."-    , styleLinePrefix = "│"-    , styleUnderline = "^"-    , styleHorizontal = "─"-    , styleVertical = "│"-    , styleDownRight = "┌"-    , styleUpDownRight = "├"-    , styleUpRight = "└"-    }---- | A fancy style using Unicode characters and ANSI colors, similar to 'fancyStyle'. Most things are colored red.-fancyRedStyle :: Style-fancyRedStyle = Style-    { styleLocation = \(fp, l, c) -> T.concat-        [ "\x1b[34m→\x1b[0m ", T.pack fp, ":", T.pack $ show l, ":", T.pack $ show c-        ]-    , styleNumber = T.pack . show-    , styleLine = highlight "\x1b[31m" "\x1b[0m"-    , styleEllipsis = "."-    , styleLinePrefix = "\x1b[34m│\x1b[0m"-    , styleUnderline = "\x1b[31m^\x1b[0m"-    , styleHorizontal = "\x1b[31m─\x1b[0m"-    , styleVertical = "\x1b[31m│\x1b[0m"-    , styleDownRight = "\x1b[31m┌\x1b[0m"-    , styleUpDownRight = "\x1b[31m├\x1b[0m"-    , styleUpRight = "\x1b[31m└\x1b[0m"-    }---- | A fancy style using Unicode characters and ANSI colors, similar to 'fancyStyle'. Most things are colored yellow.-fancyYellowStyle :: Style-fancyYellowStyle = Style-    { styleLocation = \(fp, l, c) -> T.concat-        [ "\x1b[34m→\x1b[0m ", T.pack fp, ":", T.pack $ show l, ":", T.pack $ show c-        ]-    , styleNumber = T.pack . show-    , styleLine = highlight "\x1b[33m" "\x1b[0m"-    , styleEllipsis = "."-    , styleLinePrefix = "\x1b[34m│\x1b[0m"-    , styleUnderline = "\x1b[33m^\x1b[0m"-    , styleHorizontal = "\x1b[33m─\x1b[0m"-    , styleVertical = "\x1b[33m│\x1b[0m"-    , styleDownRight = "\x1b[33m┌\x1b[0m"-    , styleUpRight = "\x1b[33m└\x1b[0m"-    , styleUpDownRight = "\x1b[33m├\x1b[0m"-    }+blockMerged' pstyle style fp hm (l1, c1, lbl1) (l2, c2, lbl2) lbl bm =+    blockMerged pstyle style fp hm (l1, c1, c1 + 1, lbl1) (l2, c2, c2 + 1, lbl2) lbl bm  {- | Pretty prints errors. The original source is required. Returns 'Data.Text.Lazy.Text' (lazy). If the list is empty, an empty string is returned.@@ -296,7 +186,7 @@ toErrata (ParseError fp l c unexpected expected) =     'errataSimple'         (Just \"an error occured!\")-        ('blockSimple' 'basicStyle' fp+        ('blockSimple' 'Errata.Styles.basicStyle' 'Errata.Styles.basicPointer' fp             (Just \"error: invalid syntax\")             (l, c, c + T.length unexpected, Just \"this one\")             (Just $ \"unexpected \" \<> unexpected \<> \"\\nexpected \" \<> T.intercalate \", \" expected))

@@ -1,5 +1,7 @@ {-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE CPP                 #-} {-# LANGUAGE MultiWayIf          #-}+{-# LANGUAGE NamedFieldPuns      #-} {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE RecordWildCards     #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -7,7 +9,7 @@  {- | Module      : Errata.Internal.Render-Copyright   : (c) 2020 comp+Copyright   : (c) 2020- comp License     : MIT Maintainer  : onecomputer00@gmail.com Stability   : stable@@ -27,7 +29,8 @@     , makeSourceTable     ) where -import           Control.Applicative (ZipList(..))+import           Control.Applicative (ZipList (..))+import           Control.Arrow ((&&&)) import qualified Data.IntMap as I import           Data.List (foldl', inits, sortOn) import           Data.Maybe (isJust)@@ -36,6 +39,10 @@ import           Errata.Source import           Errata.Types +#if defined(usewcwidth)+import           Foreign.C+#endif+ -- | Renders a collection of 'Errata'. renderErrors :: Source source => source -> [Errata] -> TB.Builder renderErrors source errs = errorMessage@@ -89,18 +96,18 @@ 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 :: Source 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'.+the first @i@ elements of the original list and tailing an 'emptySource'.  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)+slices :: Source a => [a] -> [[a]]+slices [] = repeat (repeat emptySource)+slices xs = (xs <> repeat emptySource) : slices (tail xs)  -- | Renders a single 'Errata'. renderErrata@@ -160,38 +167,56 @@     -> 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+renderSourceLines slines (Block {..}) padding pointersGrouped = Just $ unsplit "\n" decoratedLines     where+        {- Terminology used in this code:+            ↓↓ gutter+          │    ← padding line+        1 │   line 1 foo bar do+          │ ┌────────^───────^^+          │ │        │ ← connector+          │ │ hook → └ hi ← label+        2 │ │ line 2+        3 │ │ line 3+          │ ├──────^+        4 │ │ line 4 ← extra line+        5 │ │ line 5 ← extra line+        . │ │ ← omission+        7 │ │ line 7 ← extra line+        8 │ │ line 8 baz end+          │ └──────^─────^^^ ← underline+        ↑↑↑↑        ↑↑↑↑↑+        prefix      catch up+        -}         Style {..} = blockStyle          -- 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)] -> source -> TB.Builder-        showLine hs = TB.fromText . styleLine hs . sourceToText--        -- Generic prefix without line number.-        prefix = mconcat-            [ replicateB padding " ", " ", TB.fromText styleLinePrefix, " "-            ]+        showLine :: [(PointerStyle, (Column, Column))] -> source -> TB.Builder+        showLine hs = TB.fromText . T.replace "\t" (T.replicate styleTabWidth " ") . styleLine hs . sourceToText -        -- Prefix for omitting lines when spanning many lines.-        omitPrefix = mconcat-            [ TB.fromText styleEllipsis, replicateB (padding - 1) " ", " ", TB.fromText styleLinePrefix, " "-            ]+        -- Generic prefix without line number, used for non-source lines i.e. decorations.+        prefix :: TB.Builder+        prefix = if styleEnableLinePrefix+            then mconcat [replicateB padding " ", " ", TB.fromText styleLinePrefix, " "]+            else "" -        -- Prefix with a line number.+        -- Prefix with a line number, used for source lines.         linePrefix :: Line -> TB.Builder-        linePrefix n = mconcat-            [ TB.fromText (styleNumber n), replicateB (padding - length (show n)) " ", " "-            , TB.fromText styleLinePrefix, " "-            ]+        linePrefix n = if styleEnableLinePrefix+            then mconcat [TB.fromText (styleNumber n), replicateB (padding - length (show n)) " ", " ", TB.fromText styleLinePrefix, " "]+            else "" -        -- The resulting source lines.-        -- Extra prefix for padding.-        sourceLines = mconcat [replicateB padding " ", " ", TB.fromText styleLinePrefix]-            : makeSourceLines 0 slines+        -- The resulting source lines with decorations; extra prefix included for padding.+        decoratedLines :: [TB.Builder]+        decoratedLines = [paddingLine | stylePaddingTop] <> makeDecoratedLines 0 slines<> [paddingLine | stylePaddingBottom]+            where+                paddingLine = if styleEnableLinePrefix+                    then mconcat [replicateB padding " ", " ", TB.fromText styleLinePrefix]+                    else "" -        -- Whether there will be a multiline span.+        -- Whether there will be a multiline span in the block.+        hasConnMulti :: Bool         hasConnMulti = I.size (I.filter (any pointerConnect) pointersGrouped) > 1          -- Whether line /n/ has a connection to somewhere else (including the same line).@@ -204,69 +229,69 @@             let (a, b) = I.split n pointersGrouped             in ((any . any) pointerConnect a, (any . any) pointerConnect b) -        -- Makes the source lines.+        -- Decorates all the pointed-to source lines, along with extra lines.         -- We have an @extra@ parameter to keep track of extra lines when spanning multiple lines.-        makeSourceLines :: Line -> [(Line, source)] -> [TB.Builder]-+        makeDecoratedLines :: Line -> [(Line, source)] -> [TB.Builder]         -- No lines left.-        makeSourceLines _ [] = []-+        makeDecoratedLines _ [] = []         -- The next line is a line we have to decorate with pointers.-        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, l):ns)-            | extra < 2 =+        makeDecoratedLines _ (pr@(n, _):ls)+            | Just p <- I.lookup n pointersGrouped = decorateLine p pr <> makeDecoratedLines 0 ls+        -- The next line is an extra line, within a limit.+        makeDecoratedLines extra ((n, l):ls)+            | extra < styleExtraLinesAfter =                 let mid = if-                        | snd (connAround n) -> TB.fromText styleVertical <> " "-                        | hasConnMulti       -> "  "-                        | otherwise          -> ""-                in (linePrefix n <> mid <> showLine [] l) : makeSourceLines (extra + 1) ns-+                        | not styleEnableDecorations -> ""+                        | snd (connAround n)         -> TB.fromText styleVertical <> " "+                        | hasConnMulti               -> "  "+                        | otherwise                  -> ""+                in (linePrefix n <> mid <> showLine [] l) : makeDecoratedLines (extra + 1) ls         -- We reached the extra line limit, so now there's some logic to figure out what's next.-        makeSourceLines _ ns =-            let (es, ns') = break ((`I.member` pointersGrouped) . fst) ns-            in case (es, ns') of+        makeDecoratedLines _ ls =+            let (es, ls') = break ((`I.member` pointersGrouped) . fst) ls+            in case (es, ls') of                 -- There were no lines left to decorate anyways.                 (_, []) -> []-                 -- There are lines left to decorate, and it came right after.-                ([], _) -> makeSourceLines 0 ns'--                -- 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, l)], _) ->-                    let mid = if-                            | snd (connAround n) -> TB.fromText styleVertical <> " "-                            | hasConnMulti       -> "  "-                            | otherwise          -> ""-                    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.+                ([], _) -> makeDecoratedLines 0 ls'+                -- There are more than one line in between, so we take as much as is configured.                 (_, _) ->-                    let (n, l) = last es-                        mid = if-                            | snd (connAround n) -> TB.fromText styleVertical <> " "-                            | hasConnMulti       -> "  "-                            | otherwise          -> ""-                    in (omitPrefix <> mid) : (linePrefix n <> mid <> showLine [] l) : makeSourceLines 0 ns'+                    let es' = reverse . take styleExtraLinesBefore . reverse $ es+                        extras = flip map es' $ \(n, l) ->+                            let gutter = if+                                    | not styleEnableDecorations -> ""+                                    | snd (connAround n)         -> TB.fromText styleVertical <> " "+                                    | hasConnMulti               -> "  "+                                    | otherwise                  -> ""+                            in linePrefix n <> gutter <> showLine [] l+                    in case compareLength es' es of+                        -- We only add the omission line if it doesn't take all of the lines.+                        LT -> let+                            -- Prefix and gutter for omitting lines when spanning many lines.+                            omitPrefix = if styleEnableLinePrefix+                                then mconcat [TB.fromText styleEllipsis, replicateB (padding - 1) " ", " ", TB.fromText styleLinePrefix]+                                else ""+                            omitGutter = if+                                | not styleEnableDecorations       -> ""+                                | snd . connAround . fst $ head ls -> " " <> TB.fromText styleVertical+                                | otherwise                        -> ""+                            in (omitPrefix <> omitGutter) : extras <> makeDecoratedLines 0 ls'+                        _ -> extras <> makeDecoratedLines 0 ls'          -- Decorate a line that has pointers.         -- The pointers we get are assumed to be all on the same line.-        makeDecoratedLines :: [Pointer] -> (Line, source) -> [TB.Builder]-        makeDecoratedLines pointers (num, line) =-            (linePrefix num <> TB.fromText lineConnector <> sline) : decorationLines+        decorateLine :: [Pointer] -> (Line, source) -> [TB.Builder]+        decorateLine pointers (n, l) = (linePrefix n <> gutter <> stylizedLine) : decorationLines             where-                lineConnector = if-                    | hasConnBefore && hasConnUnder -> styleVertical <> " "+                gutter = if+                    | not styleEnableDecorations    -> ""+                    | hasConnBefore && hasConnUnder -> TB.fromText styleVertical <> " "                     | hasConnMulti                  -> "  "                     | otherwise                     -> ""                  -- Shortcuts to where this line connects to.-                hasConnHere = hasConn num-                (hasConnBefore, hasConnAfter) = connAround num+                hasConnHere = hasConn n+                (hasConnBefore, hasConnAfter) = connAround n                 hasConnAround = hasConnBefore || hasConnAfter                 hasConnOver = hasConnHere || hasConnBefore                 hasConnUnder = hasConnHere || hasConnAfter@@ -274,17 +299,19 @@                 -- The sorted pointers by column.                 pointersSorted = sortOn pointerColumns pointers -                -- The line number we're on.-                sline = showLine (map pointerColumns pointersSorted) line+                -- The actual source line.+                sourceLine = sourceToText l +                -- The source line stylized.+                stylizedLine = showLine (map (pointerStyle &&& pointerColumns) pointersSorted) l+                 -- The resulting decoration lines.                 decorationLines = case filter (isJust . pointerLabel) (init pointersSorted) of+                    _ | not styleEnableDecorations -> []                     -- There's only one pointer, so no need for more than just an underline and label.                     _ | length pointersSorted == 1 -> [underline pointersSorted]-                     -- There's no labels at all, so we just need the underline.                     [] -> [underline pointersSorted]-                     -- Otherwise, we have three steps to do:                     -- The underline directly underneath.                     -- An extra connector for the labels other than the rightmost one.@@ -297,80 +324,111 @@                 underline :: [Pointer] -> TB.Builder                 underline ps =                     let (decor, _) = foldDecorations-                            (\n isFirst rest -> if-                                | isFirst && any pointerConnect rest && hasConnAround -> replicateB n styleHorizontal-                                | isFirst                                             -> replicateB n " "-                                | any pointerConnect rest                             -> replicateB n styleHorizontal-                                | otherwise                                           -> replicateB n " "+                            (\k isFirst rest text -> if+                                | isFirst && any pointerConnect rest && hasConnAround -> replaceWithWidth k styleTabWidth text styleHorizontal+                                | isFirst                                             -> replaceWithWidth k styleTabWidth text " "+                                | any pointerConnect rest                             -> replaceWithWidth k styleTabWidth text styleHorizontal+                                | otherwise                                           -> replaceWithWidth k styleTabWidth text " "                             )-                            (\n -> (n, replicateB n styleUnderline))+                            (\k p text ->+                                let x = styleUnderline (pointerStyle p)+                                in (k, replaceWithWidth k styleTabWidth text x)+                            )                             ps+                            sourceLine                         lbl = maybe "" (" " <>) . pointerLabel $ last ps-                        mid = if+                        decorGutter = if                             | hasConnHere && hasConnBefore && hasConnAfter -> styleUpDownRight <> styleHorizontal                             | hasConnHere && hasConnBefore                 -> styleUpRight <> styleHorizontal                             | hasConnHere && hasConnAfter                  -> styleDownRight <> styleHorizontal                             | hasConnBefore && hasConnAfter                -> styleVertical <> " "                             | hasConnMulti                                 -> "  "                             | otherwise                                    -> ""-                    in prefix <> TB.fromText mid <> decor <> TB.fromText lbl+                    in prefix <> TB.fromText decorGutter <> decor <> TB.fromText lbl                  -- Create connectors underneath. No labels are rendered here.                 connectors :: [Pointer] -> TB.Builder                 connectors ps =                     let (decor, _) = foldDecorations-                            (\n _ _ -> replicateB n " ")-                            (\_ -> (1, TB.fromText styleVertical))+                            (\k _ _ text -> replaceWithWidth k styleTabWidth text " ")+                            (\_ p _ ->+                                let x = styleConnector (pointerStyle p)+                                in (1, TB.fromText x)+                            )                             ps-                        mid = if+                            sourceLine+                        decorGutter = if                             | hasConnOver && hasConnAfter -> styleVertical <> " "                             | hasConnMulti                -> "  "                             | otherwise                   -> ""-                    in prefix <> TB.fromText mid <> decor+                    in prefix <> TB.fromText decorGutter <> decor                  -- 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 " ")-                            (\_ -> (1, TB.fromText styleVertical))+                            (\k _ _ text -> replaceWithWidth k styleTabWidth text " ")+                            (\_ p _ ->+                                let x = styleConnector (pointerStyle p)+                                in (1, TB.fromText x)+                            )                             (init ps)+                            sourceLine+                        pointer = last ps+                        hook = styleHook (pointerStyle pointer)                         lbl = maybe ""-                            (\x -> mconcat-                                [ replicateB (pointerColStart (last ps) - finalCol) " "-                                , TB.fromText styleUpRight-                                , " "-                                , TB.fromText x-                                ]+                            (\x -> if+                                | styleEnableHook (pointerStyle pointer) -> mconcat+                                    [ replicateB (pointerColStart pointer - finalCol) " "+                                    , TB.fromText hook+                                    , " "+                                    , TB.fromText x+                                    ]+                                | otherwise -> mconcat+                                    [ replicateB (pointerColStart pointer - finalCol) " "+                                    , TB.fromText x+                                    ]                             )-                            (pointerLabel (last ps))-                        mid = if+                            (pointerLabel pointer)+                        decorGutter = if                             | hasConnOver && hasConnAfter -> styleVertical <> " "                             | hasConnMulti                -> "  "                             | otherwise                   -> ""-                    in prefix <> TB.fromText mid <> decor <> lbl+                    in prefix <> TB.fromText decorGutter <> decor <> lbl  -- | Makes a line of decorations below the source. foldDecorations-    :: (Column -> Bool -> [Pointer] -> TB.Builder) -- ^ Catch up from the previous pointer to this pointer.-    -> (Column -> (Int, TB.Builder))               -- ^ Something in the middle that ends before the next pointer.+    :: (Int -> Bool -> [Pointer] -> T.Text -> TB.Builder)+    {- ^ Catch up from the previous pointer to this pointer.++    @catchUp distance isFirst pointers text@ should return text of at least length @distance@.+    -}+    -> (Int -> Pointer -> T.Text -> (Int, TB.Builder))+    {- ^ Add text underneath the pointer before the next pointer.++    @underlinePointer pointerLen pointer text@ should return the text and its length.+    -}     -> [Pointer]+    -> T.Text     -> (TB.Builder, Column)-foldDecorations catchUp reachAfter ps =-    let (decor, finalCol, _) = paral-            (\(rest, (xs, c, isFirst)) p@(Pointer {..}) ->-                let (afterLen, afterText) = reachAfter (pointerColEnd - pointerColStart)+foldDecorations catchUp underlinePointer ps line =+    let (decor, finalCol, _, _) = paral+            (\(rest, (xs, c, isFirst, remainingLine)) p@(Pointer {..}) ->+                let (textBefore, textUnderAndRest) = T.splitAt (pointerColStart - c) remainingLine+                    (textUnder, textRest) = T.splitAt (pointerColEnd - pointerColStart) textUnderAndRest+                    (afterLen, afterText) = underlinePointer (pointerColEnd - pointerColStart) p textUnder                 in                 ( mconcat                     [ xs-                    , catchUp (pointerColStart - c) isFirst (p:rest)+                    , catchUp (pointerColStart - c) isFirst (p:rest) textBefore                     , afterText                     ]                 , pointerColStart + afterLen                 , False+                , textRest                 )             )-            ("", 1, True)+            ("", 1, True, line)             ps     in (decor, finalCol) @@ -381,6 +439,13 @@     let !b' = f (as, b) a     in paral f b' as +-- | Compares length of two lists without traversing them completely.+compareLength :: [a] -> [b] -> Ordering+compareLength []     []     = EQ+compareLength (_:xs) (_:ys) = compareLength xs ys+compareLength []     _      = LT+compareLength _      []     = GT+ -- | Puts text between each item. unsplit :: TB.Builder -> [TB.Builder] -> TB.Builder unsplit _ []     = ""@@ -391,3 +456,78 @@ replicateB :: Int -> T.Text -> TB.Builder replicateB n xs = TB.fromText (T.replicate n xs) {-# INLINE replicateB #-}++{- | Replaces each character in the text with the appropriate instances of the given text based on character width.++The result will also be right-padded with the given text to the given length.++For tabs, the tab width given is used to make it equivalent to that many spaces.+-}+replaceWithWidth :: Int -> Int -> T.Text -> T.Text -> TB.Builder+replaceWithWidth len tab ref xs = T.foldl' (\acc c -> acc <> replicateB (width c) xs) "" ref <> replicateB (len - T.length ref) xs+    where+        width '\t' = tab+        width c = charWidth c+{-# INLINE replaceWithWidth #-}++#if defined(usewcwidth)+foreign import ccall unsafe "wchar.h wcwidth" wcwidth :: CWchar -> CInt+{-| Get the designated render width of a character, based on the native wcwidth.+Where wcwidth would return -1, 0 is returned instead.++The result will depend on the current locale and Unicode version.+-}+charWidth :: Char -> Int+charWidth = max 0 . fromEnum . wcwidth . toEnum . fromEnum+#else+{-| Get the designated render width of a character: 0 for a combining character, 1 for a regular character,+2 for a wide character. (Wide characters are rendered as exactly double width in apps and fonts that support it.)++(From Pandoc.)+-}+charWidth :: Char -> Int+charWidth c = if+    | c < '\x0300'                     -> 1+    -- Combining+    | c >= '\x0300' && c <= '\x036F'   -> 0+    | c >= '\x0370' && c <= '\x10FC'   -> 1+    | c >= '\x1100' && c <= '\x115F'   -> 2+    | c >= '\x1160' && c <= '\x11A2'   -> 1+    | c >= '\x11A3' && c <= '\x11A7'   -> 2+    | c >= '\x11A8' && c <= '\x11F9'   -> 1+    | c >= '\x11FA' && c <= '\x11FF'   -> 2+    | c >= '\x1200' && c <= '\x2328'   -> 1+    | c >= '\x2329' && c <= '\x232A'   -> 2+    | c >= '\x232B' && c <= '\x2E31'   -> 1+    | c >= '\x2E80' && c <= '\x303E'   -> 2+    | c == '\x303F'                    -> 1+    | c >= '\x3041' && c <= '\x3247'   -> 2+    -- Ambiguous+    | c >= '\x3248' && c <= '\x324F'   -> 1+    | c >= '\x3250' && c <= '\x4DBF'   -> 2+    | c >= '\x4DC0' && c <= '\x4DFF'   -> 1+    | c >= '\x4E00' && c <= '\xA4C6'   -> 2+    | c >= '\xA4D0' && c <= '\xA95F'   -> 1+    | c >= '\xA960' && c <= '\xA97C'   -> 2+    | c >= '\xA980' && c <= '\xABF9'   -> 1+    | c >= '\xAC00' && c <= '\xD7FB'   -> 2+    | c >= '\xD800' && c <= '\xDFFF'   -> 1+    -- Ambiguous+    | c >= '\xE000' && c <= '\xF8FF'   -> 1+    | c >= '\xF900' && c <= '\xFAFF'   -> 2+    | c >= '\xFB00' && c <= '\xFDFD'   -> 1+    -- Ambiguous+    | c >= '\xFE00' && c <= '\xFE0F'   -> 1+    | c >= '\xFE10' && c <= '\xFE19'   -> 2+    | c >= '\xFE20' && c <= '\xFE26'   -> 1+    | c >= '\xFE30' && c <= '\xFE6B'   -> 2+    | c >= '\xFE70' && c <= '\xFEFF'   -> 1+    | c >= '\xFF01' && c <= '\xFF60'   -> 2+    | c >= '\xFF61' && c <= '\x16A38'  -> 1+    | c >= '\x1B000' && c <= '\x1B001' -> 2+    | c >= '\x1D000' && c <= '\x1F1FF' -> 1+    | c >= '\x1F200' && c <= '\x1F251' -> 2+    | c >= '\x1F300' && c <= '\x1F773' -> 1+    | c >= '\x20000' && c <= '\x3FFFD' -> 2+    | otherwise                        -> 1+#endif

@@ -1,8 +1,9 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}  {- | Module      : Errata.Source-Copyright   : (c) 2020 comp+Copyright   : (c) 2020- comp License     : MIT Maintainer  : onecomputer00@gmail.com Stability   : stable@@ -20,11 +21,11 @@ {- | 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 Monoid s => Source s where+class Source s where+    -- | The empty source, used when a pointer references an out-of-bounds line.+    emptySource :: s+     -- | Splits the source into lines.     sourceToLines :: s -> [s] @@ -32,13 +33,16 @@     sourceToText :: s -> T.Text  instance Source String where+    emptySource = ""     sourceToLines = lines     sourceToText = T.pack  instance Source T.Text where+    emptySource = ""     sourceToLines = T.lines     sourceToText = id  instance Source TL.Text where+    emptySource = ""     sourceToLines = TL.lines     sourceToText = TL.toStrict

@@ -0,0 +1,222 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Errata.Styles+Copyright   : (c) 2020- comp+License     : MIT+Maintainer  : onecomputer00@gmail.com+Stability   : stable+Portability : portable++Premade styles for blocks and pointers.+-}+module Errata.Styles+    ( basicStyle+    , basicPointer+    , fancyStyle+    , fancyPointer+    , fancyRedStyle+    , fancyRedPointer+    , fancyYellowStyle+    , fancyYellowPointer+    , highlight+    ) where++import           Data.Bifunctor (bimap, second)+import qualified Data.Text as T+import           Errata.Types++{- | A basic style using only ASCII characters.++Errors should look like so (with 'basicPointer'):++> error header message+> --> file.ext:1:16+> block header message+>   |+> 1 |   line 1 foo bar do+>   |  ________________^^ start label+> 2 | | line 2+>   | |      ^ unconnected label+> 3 | | line 3+>   | |______^ middle label+> 4 | | line 4+> 5 | | line 5+> . | |+> 7 | | line 7+> 8 | | line 8 baz end+>   | |______^_____^^^ end label+>   |        |+>   |        | inner label+> block body message+> error body message+-}+basicStyle :: Style+basicStyle = Style+    { styleLocation = \(fp, l, c) -> T.concat ["--> ", T.pack fp, ":", T.pack $ show l, ":", T.pack $ show c]+    , styleNumber = T.pack . show+    , styleLine = highlight+    , styleEllipsis = "."+    , styleLinePrefix = "|"+    , styleVertical = "|"+    , styleHorizontal = "_"+    , styleDownRight = " "+    , styleUpRight = "|"+    , styleUpDownRight = "|"+    , styleTabWidth = 4+    , styleExtraLinesAfter = 2+    , styleExtraLinesBefore = 1+    , stylePaddingTop = True+    , stylePaddingBottom = False+    , styleEnableDecorations = True+    , styleEnableLinePrefix = True+    }++-- | Pointers using only ASCII characters.+basicPointer :: PointerStyle+basicPointer = PointerStyle+    { styleHighlight = id+    , styleUnderline = "^"+    , styleHook = "|"+    , styleConnector = "|"+    , styleEnableHook = True+    }++{- | A fancy style using Unicode characters.++Errors should look like so (with 'fancyPointer'):++> error header message+> → file.ext:1:16+> block header message+>   │+> 1 │   line 1 foo bar do+>   │ ┌────────────────^^ start label+> 2 │ │ line 2+>   │ │      ^ unconnected label+> 3 │ │ line 3+>   │ ├──────^ middle label+> 4 │ │ line 4+> 5 │ │ line 5+> . │ │+> 7 │ │ line 7+> 8 │ │ line 8 baz end+>   │ └──────^─────^^^ end label+>   │        │+>   │        └ inner label+-}+fancyStyle :: Style+fancyStyle = Style+    { styleLocation = \(fp, l, c) -> T.concat+        [ "→ ", T.pack fp, ":", T.pack $ show l, ":", T.pack $ show c+        ]+    , styleNumber = T.pack . show+    , styleLine = highlight+    , styleEllipsis = "."+    , styleLinePrefix = "│"+    , styleHorizontal = "─"+    , styleVertical = "│"+    , styleDownRight = "┌"+    , styleUpDownRight = "├"+    , styleUpRight = "└"+    , styleTabWidth = 4+    , styleExtraLinesAfter = 2+    , styleExtraLinesBefore = 1+    , stylePaddingTop = True+    , stylePaddingBottom = False+    , styleEnableDecorations = True+    , styleEnableLinePrefix = True+    }++-- | Pointers using Unicode characters and ANSI colors.+fancyPointer :: PointerStyle+fancyPointer = PointerStyle+    { styleHighlight = id+    , styleUnderline = "^"+    , styleHook = "└"+    , styleConnector = "│"+    , styleEnableHook = True+    }++-- | A fancy style using Unicode characters and ANSI colors, similar to 'fancyStyle'. Most things are colored red.+fancyRedStyle :: Style+fancyRedStyle = Style+    { styleLocation = \(fp, l, c) -> T.concat+        [ "\x1b[34m→\x1b[0m ", T.pack fp, ":", T.pack $ show l, ":", T.pack $ show c+        ]+    , styleNumber = T.pack . show+    , styleLine = highlight+    , styleEllipsis = "."+    , styleLinePrefix = "\x1b[34m│\x1b[0m"+    , styleHorizontal = "\x1b[31m─\x1b[0m"+    , styleVertical = "\x1b[31m│\x1b[0m"+    , styleDownRight = "\x1b[31m┌\x1b[0m"+    , styleUpDownRight = "\x1b[31m├\x1b[0m"+    , styleUpRight = "\x1b[31m└\x1b[0m"+    , styleTabWidth = 4+    , styleExtraLinesAfter = 2+    , styleExtraLinesBefore = 1+    , stylePaddingTop = True+    , stylePaddingBottom = False+    , styleEnableDecorations = True+    , styleEnableLinePrefix = True+    }++-- | Red pointers using Unicode characters and ANSI colors.+fancyRedPointer :: PointerStyle+fancyRedPointer = PointerStyle+    { styleHighlight = \x -> "\x1b[31m" <> x <> "\x1b[0m"+    , styleUnderline = "\x1b[31m^\x1b[0m"+    , styleHook = "\x1b[31m└\x1b[0m"+    , styleConnector = "\x1b[31m│\x1b[0m"+    , styleEnableHook = True+    }++-- | A fancy style using Unicode characters and ANSI colors, similar to 'fancyStyle'. Most things are colored yellow.+fancyYellowStyle :: Style+fancyYellowStyle = Style+    { styleLocation = \(fp, l, c) -> T.concat+        [ "\x1b[34m→\x1b[0m ", T.pack fp, ":", T.pack $ show l, ":", T.pack $ show c+        ]+    , styleNumber = T.pack . show+    , styleLine = highlight+    , styleEllipsis = "."+    , styleLinePrefix = "\x1b[34m│\x1b[0m"+    , styleHorizontal = "\x1b[33m─\x1b[0m"+    , styleVertical = "\x1b[33m│\x1b[0m"+    , styleDownRight = "\x1b[33m┌\x1b[0m"+    , styleUpRight = "\x1b[33m└\x1b[0m"+    , styleUpDownRight = "\x1b[33m├\x1b[0m"+    , styleTabWidth = 4+    , styleExtraLinesAfter = 2+    , styleExtraLinesBefore = 1+    , stylePaddingTop = True+    , stylePaddingBottom = False+    , styleEnableDecorations = True+    , styleEnableLinePrefix = True+    }++-- | Yellow pointers using Unicode characters and ANSI colors.+fancyYellowPointer :: PointerStyle+fancyYellowPointer = PointerStyle+    { styleHighlight = \x -> "\x1b[33m" <> x <> "\x1b[0m"+    , styleUnderline = "\x1b[33m^\x1b[0m"+    , styleHook = "\x1b[33m└\x1b[0m"+    , styleConnector = "\x1b[33m│\x1b[0m"+    , styleEnableHook = True+    }++-- | Adds highlighting to spans of text by modifying it with the given styles' highlights.+highlight+    :: [(PointerStyle, (Column, Column))] -- ^ Styles and columns to work on. These are sorted, starting at 1. They must not overlap.+    -> T.Text                             -- ^ Text to highlight.+    -> T.Text+highlight [] xs = xs+highlight ((p, (s, e)):ps) xs =+    let (pre, xs') = T.splitAt (s - 1) xs+        (txt, xs'') = T.splitAt (e - s) xs'+        hi = styleHighlight p+        ps' = second (both (\i -> i - e + 1)) <$> ps+    in pre <> hi txt <> highlight ps' xs''+    where+        both f = bimap f f

@@ -1,6 +1,9 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}+ {- | Module      : Errata.Types-Copyright   : (c) 2020 comp+Copyright   : (c) 2020- comp License     : MIT Maintainer  : onecomputer00@gmail.com Stability   : stable@@ -22,17 +25,18 @@     , Block (..)     , Pointer (..)     , pointerColumns+    , pointerData       -- * Styling options     , Style (..)-    , highlight+    , PointerStyle (..)     ) where  import qualified Data.Text as T --- | Line number, starts at 1.+-- | Line number, starts at 1, increments every new line character. type Line = Int --- | Column number, starts at 1.+-- | Column number, starts at 1, increments every 'Char'. type Column = Int  -- | Header text. Generally goes above things.@@ -53,6 +57,7 @@     , errataBody :: Maybe Body       -- ^ The message that appears below all the blocks.     }+    deriving (Show)  {- | Information about a block in the source code, such as pointers and messages. @@ -83,6 +88,7 @@       This will appear below the source lines.       -}     }+    deriving (Show)  {- | A pointer is the span of the source code at a line, from one column to another. Each of the positions start at 1. @@ -101,13 +107,19 @@       -- ^ Whether this pointer connects with other pointers.     , pointerLabel :: Maybe Label       -- ^ An optional label for the pointer.+    , pointerStyle :: PointerStyle+      -- ^ A style for this pointer.     }-    deriving (Show, Eq)+    deriving (Show)  -- | Gets the column span for a 'Pointer'. pointerColumns :: Pointer -> (Column, Column)-pointerColumns p = (pointerColStart p, pointerColEnd p)+pointerColumns (Pointer {..}) = (pointerColStart, pointerColEnd) +-- | Gets physical information about a pointer.+pointerData :: Pointer -> (Line, Column, Column, Bool, Maybe Label)+pointerData (Pointer {..}) = (pointerLine, pointerColStart, pointerColEnd, pointerConnect, pointerLabel)+ -- | Stylization options for a block, e.g. characters to use. data Style = Style     { styleLocation :: (FilePath, Line, Column) -> T.Text@@ -120,11 +132,13 @@        The result should visually be the same length as just @show n@.       -}-    , styleLine :: [(Column, Column)] -> T.Text -> T.Text+    , styleLine :: [(PointerStyle, (Column, Column))] -> T.Text -> T.Text       {- ^ Stylize 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 style and the column span (sorted, starting at 1) of the text that is being underlined are given for+      highlighting purposes (see 'Errata.Styles.highlight').+      They can be ignored for source code highlighting instead, for example.+      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.@@ -136,11 +150,6 @@        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.--      This should visually be one character.-      -}     , styleVertical :: T.Text       {- ^ The text to use as a vertical bar when connecting pointers. @@ -166,21 +175,94 @@        This should visually be one character.       -}+    , styleTabWidth :: Int+      {- ^ The number of spaces a tab character is equivalent to.++      Your source will have tabs replaced with this many spaces.+      -}+    , styleExtraLinesAfter :: Int+      -- ^ Maximum number of extra lines that can be added after the first line when skipping lines between two lines.+    , styleExtraLinesBefore :: Int+      -- ^ Maximum number of extra lines that can be added before the second line when skipping lines between two lines.+    , stylePaddingTop :: Bool+      -- ^ Whether to add a padding line before the first source line.+    , stylePaddingBottom :: Bool+      -- ^ Whether to add a padding line after the last source line.+    , styleEnableDecorations :: Bool+      {- ^ Whether to enable decorations at all in this block.++      This includes the pointer connectors (as in 'Style') and the underlines, connectors, and labels+      (as in 'PointerStyle'). However, highlighting will still be applied.+      -}+    , styleEnableLinePrefix :: Bool+      -- ^ Whether to enable the line prefix.     } --- | Adds highlighting to spans of text by enclosing it with some text e.g ANSI escape codes.-highlight-    :: T.Text             -- ^ Text to add before.-    -> T.Text             -- ^ Text to add after.-    -> [(Column, Column)] -- ^ Indices to enclose. These are column spans, starting at 1. They must not overlap.-    -> T.Text             -- ^ Text to highlight.-    -> T.Text-highlight open close = go False . concatMap (\(a, b) -> [a, b])+instance Show Style where+  show (Style {..}) = concat+    [ "Style {"+    , "styleLocation = ", show $ styleLocation ("file", 1, 1)+    , ", styleNumber = ", show $ styleNumber 3+    , ", styleLine = ", show $ styleLine [(basicPointer, (1, 5))] "text"+    , ", styleEllipsis = ", show styleEllipsis+    , ", styleLinePrefix = ", show styleLinePrefix+    , ", styleVertical = ", show styleVertical+    , ", styleHorizontal = ", show styleHorizontal+    , ", styleDownRight = ", show styleDownRight+    , ", styleUpRight = ", show styleUpRight+    , ", styleUpDownRight = ", show styleUpDownRight+    , ", styleTabWidth = ", show styleTabWidth+    , ", styleExtraLinesAfter = ", show styleExtraLinesAfter+    , ", styleExtraLinesBefore = ", show styleExtraLinesBefore+    , ", stylePaddingTop = ", show stylePaddingTop+    , ", stylePaddingBottom = ", show stylePaddingBottom+    , ", styleEnableDecorations = ", show styleEnableDecorations+    , ", styleEnableLinePrefix = ", show styleEnableLinePrefix+    , "}"+    ]     where-        go _ [] xs = xs-        go False (i:is) xs =-            let (a, ys) = T.splitAt (i - 1) xs-            in a <> open <> go True (map (\x -> x - i + 1) is) ys-        go True (i:is) xs =-            let (a, ys) = T.splitAt (i - 1) xs-            in a <> close <> go False (map (\x -> x - i + 1) is) ys+      basicPointer = PointerStyle+        { styleHighlight = id+        , styleUnderline = "^"+        , styleHook = "|"+        , styleConnector = "|"+        , styleEnableHook = True+        }++-- | Stylization options for an individual pointer, e.g. characters to use.+data PointerStyle = PointerStyle+  { styleHighlight :: T.Text -> T.Text+    {- ^ Stylize the text that this pointer is underlining.++    This is only used if 'styleLine' uses the given pointer styles, for example with 'Errata.Styles.highlight'.+    The result of this should visually take up the same space as the original text.+    -}+  , styleUnderline :: T.Text+    {- ^ The text to underline a character in a pointer.++    This should visually be one character.+    -}+  , styleHook :: T.Text+    {- ^ The text to use as a connector upwards and hooking to the right for the label of a pointer that drops down.++    This probably looks best as one character.+    -}+  , styleConnector :: T.Text+    {- ^ The text to use as a vertical bar when connecting a pointer that drops down to its label.++    This should visually be one character.+    -}+  , styleEnableHook :: Bool+    -- ^ Whether to use the hook for labels that drop down, or simply start the label directly under the connector.+  }++instance Show PointerStyle where+  show (PointerStyle {..}) = concat+    [ "PointerStyle {"+    , "styleHighlight = ", show $ styleHighlight "text"+    , ", styleUnderline = ", show styleUnderline+    , ", styleHook = ", show styleHook+    , ", styleConnector = ", show styleConnector+    , ", styleEnableHook = ", show styleEnableHook+    , "}"+    ]

@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}++module Errata.StylesSpec+    ( spec+    ) where++import Errata.Styles+import Errata.Types+import Test.Hspec++spec :: Spec+spec = do+    describe "highlight" $ do+        it "brackets parts of text" $+            highlight [(bracketPointer, (2, 4)), (bracketPointer, (6, 7))] "12345678" `shouldBe` "1(23)45(6)78"++        it "brackets empty column spans" $+            highlight [(bracketPointer, (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 [(bracketPointer, (3, 5)), (bracketPointer, (6, 7))] "1234" `shouldBe` "12(34)()"++bracketPointer :: PointerStyle+bracketPointer = basicPointer { styleHighlight = \x -> "(" <> x <> ")" }

@@ -4,6 +4,7 @@     ( spec     ) where +import Errata.Styles import Errata.Types import Test.Hspec @@ -11,17 +12,4 @@ 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)()"+            pointerColumns (Pointer 1 2 3 False Nothing basicPointer) `shouldBe` (2, 3)

@@ -8,6 +8,8 @@ import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL import           Errata+import           Errata.Styles+import           Errata.Types import           Test.Hspec import           Test.Hspec.Golden @@ -15,14 +17,14 @@ 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+            let b = blockMerged basicStyle basicPointer "here" Nothing (1, 1, 2, Just "a") (1, 3, 4, Just "b") (Just "c") Nothing+                pointers = [Pointer 1 1 4 False (Just "c") basicPointer]+            in pointerData <$> blockPointers b `shouldBe` pointerData <$> 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+            let b = blockMerged basicStyle basicPointer "here" Nothing (1, 1, 2, Just "a") (2, 3, 4, Just "b") (Just "c") Nothing+                pointers = [Pointer 1 1 2 True (Just "a") basicPointer, Pointer 2 3 4 True (Just "b") basicPointer]+            in pointerData <$> blockPointers b `shouldBe` pointerData <$> pointers      describe "prettyErrors" goldenTests @@ -37,7 +39,7 @@                 basicStyle                 ("simple", 1, 1)                 Nothing-                [Pointer 1 1 6 False Nothing]+                [Pointer 1 1 6 False Nothing basicPointer]                 Nothing             ]             Nothing@@ -52,17 +54,17 @@                 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`")+                [ Pointer 2 10 13 False (Just "this has type `Int`") basicPointer+                , Pointer 3 10 17 False (Just "but this has type `String`") basicPointer                 ]                 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")+                [ Pointer 1 7 9 True Nothing basicPointer+                , Pointer 2 5 9 True Nothing basicPointer+                , Pointer 3 5 9 True (Just "in this `if` expression") basicPointer                 ]                 Nothing             ]@@ -78,7 +80,7 @@                 basicStyle                 ("file.hs", 1, 10)                 Nothing-                [Pointer 1 10 14 False Nothing]+                [Pointer 1 10 14 False Nothing basicPointer]                 Nothing             ]             (Just "\nDid you mean to use one of these?\n\n    foldl\n    foldr")@@ -88,7 +90,7 @@         "T003"         "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"         [ adhoc-            [ Pointer 1 2 4 False (Just "label")+            [ Pointer 1 2 4 False (Just "label") basicPointer             ]         ] @@ -96,10 +98,10 @@         "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")+            [ Pointer 1 2 4 False (Just "x") basicPointer+            , Pointer 1 6 8 False (Just "y") basicPointer+            , Pointer 1 10 12 False (Just "z") basicPointer+            , Pointer 2 5 8 False (Just "w") basicPointer             ]         ] @@ -107,10 +109,10 @@         "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")+            [ Pointer 1 2 4 True (Just "x") basicPointer+            , Pointer 1 6 8 True (Just "y") basicPointer+            , Pointer 1 10 12 True (Just "z") basicPointer+            , Pointer 2 5 8 True (Just "w") basicPointer             ]         ] @@ -118,10 +120,10 @@         "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")+            [ Pointer 1 2 4 True (Just "x") basicPointer+            , Pointer 1 6 8 False (Just "y") basicPointer+            , Pointer 1 10 12 True (Just "z") basicPointer+            , Pointer 2 5 8 False (Just "w") basicPointer             ]         ] @@ -129,11 +131,11 @@         "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")+            [ Pointer 1 2 4 True (Just "x") basicPointer+            , Pointer 1 6 8 True Nothing basicPointer+            , Pointer 1 10 12 False (Just "z") basicPointer+            , Pointer 2 5 8 False (Just "w") basicPointer+            , Pointer 3 1 3 True (Just "v") basicPointer             ]         ] @@ -149,7 +151,7 @@         "T009"         "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"         [ adhoc-            [ Pointer 4 1 2 False (Just "empty")+            [ Pointer 4 1 2 False (Just "empty") basicPointer             ]         ] @@ -157,7 +159,7 @@         "T010"         "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"         [ adhoc-            [ Pointer 1 1 1 False (Just "empty")+            [ Pointer 1 1 1 False (Just "empty") basicPointer             ]         ] @@ -165,7 +167,7 @@         "T011"         "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"         [ adhoc-            [ Pointer 1 15 16 False (Just "empty")+            [ Pointer 1 15 16 False (Just "empty") basicPointer             ]         ] @@ -173,13 +175,13 @@         "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")+            [ Pointer 1 1 2 True (Just "x") basicPointer+            , Pointer 1 3 4 True (Just "y") basicPointer+            , Pointer 1 5 6 False (Just "z") basicPointer+            , Pointer 1 7 8 False (Just "z") basicPointer+            , Pointer 1 9 10 False (Just "z") basicPointer+            , Pointer 2 5 8 False (Just "w") basicPointer+            , Pointer 3 1 3 True (Just "v") basicPointer             ]         ] @@ -187,12 +189,12 @@         "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")+            [ Pointer 1 1 2 True (Just "x") basicPointer+            , Pointer 1 3 4 True (Just "y") basicPointer+            , Pointer 1 7 8 True Nothing basicPointer+            , Pointer 1 9 10 True (Just "z") basicPointer+            , Pointer 2 5 8 False (Just "w") basicPointer+            , Pointer 3 1 3 True (Just "v") basicPointer             ]         ] @@ -200,10 +202,10 @@         "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")+            [ Pointer 1 1 4 True (Just "x") basicPointer+            , Pointer 1 6 9 True (Just "x") basicPointer+            , Pointer 3 1 3 True (Just "y") basicPointer+            , Pointer 3 5 7 True (Just "y") basicPointer             ]         ] @@ -211,9 +213,9 @@         "T015"         "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"         [ adhoc-            [ Pointer 1 1 3 False Nothing-            , Pointer 1 5 6 False Nothing-            , Pointer 1 7 9 False (Just "x")+            [ Pointer 1 1 3 False Nothing basicPointer+            , Pointer 1 5 6 False Nothing basicPointer+            , Pointer 1 7 9 False (Just "x") basicPointer             ]         ] @@ -221,9 +223,9 @@         "T016"         "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"         [ adhoc-            [ Pointer 1 1 3 True Nothing-            , Pointer 1 5 6 True Nothing-            , Pointer 1 7 9 True (Just "x")+            [ Pointer 1 1 3 True Nothing basicPointer+            , Pointer 1 5 6 True Nothing basicPointer+            , Pointer 1 7 9 True (Just "x") basicPointer             ]         ] @@ -264,15 +266,327 @@             Nothing         ] +    golden+        "T022"+        "foo\n\tbar"+        [ adhoc+            [ Pointer 2 2 3 False Nothing basicPointer+            ]+        ]++    golden+        "T023"+        "こんにちは、日本語です"+        [ adhoc+            [ Pointer 1 1 6 False Nothing basicPointer+            ]+        ]++    golden+        "T024"+        "jalapeño poppers"+        [ adhoc+            [ Pointer 1 2 4 False Nothing basicPointer+            , Pointer 1 7 9 False Nothing basicPointer+            , Pointer 1 12 14 False Nothing basicPointer+            ]+        ]++    golden+        "T025"+        "bar\t\t\t.foo"+        [ adhoc+            [ Pointer 1 1 11 False Nothing basicPointer+            ]+        ]++    golden+        "T026"+        "l1\nl2\nl3\nl4\nl5\nl6\nl7\nl8"+        [ adhoc+            [ Pointer 1 1 3 False Nothing basicPointer+            , Pointer 7 1 3 False Nothing basicPointer+            ]+        ]++    golden+        "T027"+        "l1\nl2\nl3\nl4\nl5\nl6\nl7\nl8"+        [ adhoc+            [ Pointer 1 1 3 True Nothing basicPointer+            , Pointer 7 1 3 True Nothing basicPointer+            ]+        ]++    golden+        "T028"+        "l1\nl2\nl3\nl4\nl5\nl6\nl7\nl8"+        [ adhoc+            [ Pointer 1 1 3 True (Just "label") basicPointer+            , Pointer 7 1 3 True Nothing basicPointer+            ]+        ]++    golden+        "T029"+        "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end"+        [ Errata+            (Just "error header message")+            [ Block+                basicStyle+                ("file.ext", 1, 16)+                (Just "block header message")+                [ Pointer 1 16 18 True (Just "start label") basicPointer+                , Pointer 2 6 7 False (Just "unconnected label") basicPointer+                , Pointer 3 6 7 True (Just "middle label") basicPointer+                , Pointer 8 6 7 True (Just "inner label") basicPointer+                , Pointer 8 12 15 True (Just "end label") basicPointer+                ]+                (Just "block body message")+            ]+            (Just "error body message")+        ]++    golden+        "T030"+        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"+        [ adhoc+            [ Pointer 1 2 4 False (Just "x") (basicPointer { styleHook = "1", styleUnderline = "." })+            , Pointer 1 6 8 False (Just "y") (basicPointer { styleHook = "2", styleConnector = ":", styleUnderline = "~" })+            , Pointer 1 10 12 False (Just "z") (basicPointer { styleUnderline = "^" })+            , Pointer 2 5 8 False (Just "w") (basicPointer { styleUnderline = "'" })+            ]+        ]++    golden+        "T031"+        "abcdefghijk\nlmnopqrstuv\nwxyzfoobar"+        [ adhoc+            [ Pointer 1 2 4 False (Just "x") (basicPointer { styleEnableHook = False })+            , Pointer 1 6 8 False (Just "y") (basicPointer { styleEnableHook = False })+            , Pointer 1 10 12 False (Just "z") (basicPointer { styleEnableHook = False })+            ]+        ]++    golden+        "T032"+        "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end"+        [ Errata+            (Just "error header message")+            [ Block+                (basicStyle { styleExtraLinesAfter = 0, styleExtraLinesBefore = 0 })+                ("file.ext", 1, 16)+                (Just "block header message")+                [ Pointer 1 16 18 True (Just "start label") basicPointer+                , Pointer 2 6 7 False (Just "unconnected label") basicPointer+                , Pointer 3 6 7 True (Just "middle label") basicPointer+                , Pointer 8 6 7 True (Just "inner label") basicPointer+                , Pointer 8 12 15 True (Just "end label") basicPointer+                ]+                (Just "block body message")+            ]+            (Just "error body message")+        ]++    golden+        "T033"+        "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end"+        [ Errata+            (Just "error header message")+            [ Block+                (basicStyle { styleExtraLinesAfter = 2, styleExtraLinesBefore = 2 })+                ("file.ext", 1, 16)+                (Just "block header message")+                [ Pointer 1 16 18 True (Just "start label") basicPointer+                , Pointer 2 6 7 False (Just "unconnected label") basicPointer+                , Pointer 3 6 7 True (Just "middle label") basicPointer+                , Pointer 8 6 7 True (Just "inner label") basicPointer+                , Pointer 8 12 15 True (Just "end label") basicPointer+                ]+                (Just "block body message")+            ]+            (Just "error body message")+        ]++    golden+        "T034"+        "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end"+        [ Errata+            (Just "error header message")+            [ Block+                (basicStyle { styleExtraLinesAfter = 1, styleExtraLinesBefore = 2 })+                ("file.ext", 1, 16)+                (Just "block header message")+                [ Pointer 1 16 18 True (Just "start label") basicPointer+                , Pointer 2 6 7 False (Just "unconnected label") basicPointer+                , Pointer 3 6 7 True (Just "middle label") basicPointer+                , Pointer 8 6 7 True (Just "inner label") basicPointer+                , Pointer 8 12 15 True (Just "end label") basicPointer+                ]+                (Just "block body message")+            ]+            (Just "error body message")+        ]++    golden+        "T035"+        "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end"+        [ Errata+            (Just "error header message")+            [ Block+                (basicStyle { styleExtraLinesAfter = 1, styleExtraLinesBefore = 1 })+                ("file.ext", 1, 16)+                (Just "block header message")+                [ Pointer 1 16 18 True (Just "start label") basicPointer+                , Pointer 2 6 7 False (Just "unconnected label") basicPointer+                , Pointer 3 6 7 True (Just "middle label") basicPointer+                , Pointer 8 6 7 True (Just "inner label") basicPointer+                , Pointer 8 12 15 True (Just "end label") basicPointer+                ]+                (Just "block body message")+            ]+            (Just "error body message")+        ]++    golden+        "T036"+        "hello world"+        [ Errata+            (Just "error")+            [ Block+                (basicStyle { stylePaddingTop = False })+                ("simple", 1, 1)+                Nothing+                [Pointer 1 1 6 False Nothing basicPointer]+                Nothing+            ]+            Nothing+        ]++    golden+        "T037"+        "hello world"+        [ Errata+            (Just "error")+            [ Block+                (basicStyle { stylePaddingBottom = True })+                ("simple", 1, 1)+                Nothing+                [Pointer 1 1 6 False Nothing basicPointer]+                Nothing+            ]+            Nothing+        ]++    golden+        "T038"+        "hello world"+        [ Errata+            (Just "error")+            [ Block+                (basicStyle { styleEnableDecorations = False, stylePaddingTop = False })+                ("simple", 1, 1)+                Nothing+                [Pointer 1 1 6 False (Just "ignored") basicPointer]+                Nothing+            ]+            Nothing+        ]++    golden+        "T039"+        "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end"+        [ Errata+            (Just "error header message")+            [ Block+                (basicStyle { styleEnableDecorations = False, stylePaddingTop = False })+                ("file.ext", 1, 16)+                (Just "block header message")+                [ Pointer 1 16 18 True (Just "start label") basicPointer+                , Pointer 2 6 7 False (Just "unconnected label") basicPointer+                , Pointer 3 6 7 True (Just "middle label") basicPointer+                , Pointer 8 6 7 True (Just "inner label") basicPointer+                , Pointer 8 12 15 True (Just "end label") basicPointer+                ]+                (Just "block body message")+            ]+            (Just "error body message")+        ]++    golden+        "T040"+        "sum xs = fold (+) 0 xs"+        [ Errata+            (Just "─────── NAME UNKNOWN ───────\n\nThe name fold was not found.\n")+            [ Block+                (basicStyle { styleEnableDecorations = False, stylePaddingTop = False })+                ("file.hs", 1, 10)+                Nothing+                [Pointer 1 10 14 False Nothing basicPointer]+                Nothing+            ]+            (Just "\nDid you mean to use one of these?\n\n    foldl\n    foldr")+        ]++    golden+        "T041"+        "hello world"+        [ Errata+            (Just "error")+            [ Block+                (basicStyle { styleEnableLinePrefix = False })+                ("simple", 1, 1)+                Nothing+                [Pointer 1 1 6 False (Just "ignored") basicPointer]+                Nothing+            ]+            Nothing+        ]++    golden+        "T042"+        "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end"+        [ Errata+            (Just "error header message")+            [ Block+                (basicStyle { styleEnableLinePrefix = False })+                ("file.ext", 1, 16)+                (Just "block header message")+                [ Pointer 1 16 18 True (Just "start label") basicPointer+                , Pointer 2 6 7 False (Just "unconnected label") basicPointer+                , Pointer 3 6 7 True (Just "middle label") basicPointer+                , Pointer 8 6 7 True (Just "inner label") basicPointer+                , Pointer 8 12 15 True (Just "end label") basicPointer+                ]+                (Just "block body message")+            ]+            (Just "error body message")+        ]++    golden+        "T043"+        "sum xs = fold (+) 0 xs"+        [ Errata+            (Just "─────── NAME UNKNOWN ───────\n\nThe name fold was not found.\n")+            [ Block+                (basicStyle { styleEnableLinePrefix = False })+                ("file.hs", 1, 10)+                Nothing+                [Pointer 1 10 14 False Nothing basicPointer]+                Nothing+            ]+            (Just "\nDid you mean to use one of these?\n\n    foldl\n    foldr")+        ]+ -- | 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"+    , goldenFile = "./test/.golden/" <> name <> "/golden"+    , actualFile = Just ("./test/.golden/" <> name <> "/actual")     , failFirstTime = False     }