├── .github └── workflows │ ├── ci.yaml │ └── publish.yaml ├── .gitignore ├── .stylish-haskell.yaml ├── CHANGELOG.md ├── LICENSE ├── README.md ├── errata.cabal ├── errata_fold.png ├── errata_if.png ├── example └── Main.hs ├── hie.yaml ├── src ├── Errata.hs └── Errata │ ├── Internal │ └── Render.hs │ ├── Source.hs │ ├── Styles.hs │ └── Types.hs └── test ├── .golden ├── T000 │ └── golden ├── T001 │ └── golden ├── T002 │ └── golden ├── T003 │ └── golden ├── T004 │ └── golden ├── T005 │ └── golden ├── T006 │ └── golden ├── T007 │ └── golden ├── T008 │ └── golden ├── T009 │ └── golden ├── T010 │ └── golden ├── T011 │ └── golden ├── T012 │ └── golden ├── T013 │ └── golden ├── T014 │ └── golden ├── T015 │ └── golden ├── T016 │ └── golden ├── T017 │ └── golden ├── T018 │ └── golden ├── T019 │ └── golden ├── T020 │ └── golden ├── T021 │ └── golden ├── T022 │ └── golden ├── T023 │ └── golden ├── T024 │ └── golden ├── T025 │ └── golden ├── T026 │ └── golden ├── T027 │ └── golden ├── T028 │ └── golden ├── T029 │ └── golden ├── T030 │ └── golden ├── T031 │ └── golden ├── T032 │ └── golden ├── T033 │ └── golden ├── T034 │ └── golden ├── T035 │ └── golden ├── T036 │ └── golden ├── T037 │ └── golden ├── T038 │ └── golden ├── T039 │ └── golden ├── T040 │ └── golden ├── T041 │ └── golden ├── T042 │ └── golden └── T043 │ └── golden ├── Errata ├── StylesSpec.hs └── TypesSpec.hs ├── ErrataSpec.hs └── Spec.hs /.github/workflows/ci.yaml: -------------------------------------------------------------------------------- 1 | name: CI 2 | on: [push, pull_request] 3 | 4 | jobs: 5 | build: 6 | runs-on: ubuntu-latest 7 | strategy: 8 | matrix: 9 | cabal: ["latest"] 10 | ghc: ["9.2", "9.4", "9.6", "9.8", "9.10"] 11 | env: 12 | CONFIG: "--enable-tests" 13 | steps: 14 | - uses: actions/checkout@v3 15 | - uses: haskell-actions/setup@v2 16 | id: setup-haskell 17 | with: 18 | ghc-version: ${{ matrix.ghc }} 19 | cabal-version: ${{ matrix.cabal }} 20 | - run: cabal update 21 | - run: cabal freeze $CONFIG 22 | - uses: actions/cache@v3 23 | with: 24 | path: | 25 | ${{ steps.setup-haskell.outputs.cabal-store }} 26 | dist-newstyle 27 | key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }} 28 | restore-keys: ${{ runner.os }}-${{ matrix.ghc }}- 29 | - run: cabal build $CONFIG 30 | - run: cabal test $CONFIG 31 | - run: cabal haddock $CONFIG 32 | - run: cabal check 33 | -------------------------------------------------------------------------------- /.github/workflows/publish.yaml: -------------------------------------------------------------------------------- 1 | name: Publish 2 | on: 3 | release: 4 | types: [created] 5 | 6 | jobs: 7 | publish: 8 | runs-on: ubuntu-latest 9 | 10 | steps: 11 | - uses: actions/checkout@v3 12 | 13 | - uses: haskell-actions/setup@v2 14 | id: setup-haskell 15 | with: 16 | ghc-version: "9.8" 17 | cabal-version: "latest" 18 | 19 | - run: cabal sdist 20 | - run: cabal haddock --haddock-for-hackage --enable-doc 21 | 22 | - uses: haskell-actions/hackage-publish@v1 23 | with: 24 | hackageToken: ${{ secrets.HACKAGE_AUTH_TOKEN }} 25 | packagesPath: dist-newstyle/sdist/ 26 | docsPath: dist-newstyle/ 27 | publish: false 28 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Haskell 2 | dist 3 | dist-* 4 | cabal-dev 5 | *.o 6 | *.hi 7 | *.chi 8 | *.chs.h 9 | *.dyn_o 10 | *.dyn_hi 11 | *.prof 12 | *.aux 13 | *.hp 14 | *.eventlog 15 | .virtualenv 16 | .hsenv 17 | .hpc 18 | .cabal-sandbox/ 19 | cabal.sandbox.config 20 | cabal.config 21 | cabal.project.local 22 | .ghc.environment.* 23 | .HTF/ 24 | .stack-work/ 25 | stack.yaml.lock 26 | test/.golden/**/actual 27 | 28 | # Vim 29 | [._]*.s[a-v][a-z] 30 | [._]*.sw[a-p] 31 | [._]s[a-v][a-z] 32 | [._]sw[a-p] 33 | *~ 34 | tags 35 | 36 | # IntellijIDEA 37 | .idea/ 38 | .ideaHaskellLib/ 39 | *.iml 40 | 41 | # Atom 42 | .haskell-ghc-mod.json 43 | 44 | # VS 45 | .vscode/ 46 | 47 | # Emacs 48 | *# 49 | .dir-locals.el 50 | TAGS 51 | 52 | # Other 53 | .DS_Store 54 | -------------------------------------------------------------------------------- /.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | # Current version is 0.12.2.0. 2 | # See https://github.com/jaspervdj/stylish-haskell/blob/main/data/stylish-haskell.yaml for documentation. 3 | 4 | steps: 5 | - module_header: 6 | indent: 4 7 | sort: false 8 | separate_lists: true 9 | 10 | - records: 11 | equals: "indent 4" 12 | first_field: "indent 4" 13 | field_comment: 2 14 | deriving: 4 15 | via: "indent 4" 16 | sort_deriving: false 17 | break_enums: false 18 | break_single_constructors: false 19 | curried_context: false 20 | 21 | - simple_align: 22 | cases: adjacent 23 | top_level_patterns: adjacent 24 | records: adjacent 25 | multi_way_if: adjacent 26 | 27 | - imports: 28 | align: group 29 | list_align: with_module_name 30 | pad_module_names: false 31 | long_list_align: inline 32 | empty_list_align: inherit 33 | list_padding: 4 34 | separate_lists: true 35 | space_surround: false 36 | ghc_lib_parser: true 37 | 38 | - language_pragmas: 39 | style: vertical 40 | align: true 41 | remove_redundant: true 42 | language_prefix: LANGUAGE 43 | 44 | - trailing_whitespace: {} 45 | 46 | columns: 120 47 | newline: native 48 | cabal: true 49 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | **Errata** uses [PVP Versioning](https://pvp.haskell.org). 4 | 5 | ## 0.4.0.3 6 | 7 | * Updated for GHC 9.10. 8 | 9 | ## 0.4.0.2 10 | 11 | * Updated for GHC 9.8. 12 | 13 | ## 0.4.0.1 14 | 15 | * Updated for GHC 9.4 and 9.6. 16 | 17 | ## 0.4.0.0 18 | 19 | * Added styling individual pointers with `PointerStyle` (e.g. characters, highlighting). 20 | * This changes how `styleLine` and `highlight` works and moves `styleUnderline` to `PointerStyle`. 21 | 22 | * This also adds a `PointerStyle` parameter to the helper functions so e.g. `blockSimple fancyStyle ...` should now be `blockSimple fancyStyle fancyPointer ...`. 23 | 24 | * Crazy example from the tests (you can imagine coloring things differently): 25 | ``` 26 | an error 27 | --> here:1:1 28 | | 29 | 1 | abcdefghijk 30 | | .. ~~ ^^ z 31 | | | : 32 | | | 2 y 33 | | 1 x 34 | 2 | lmnopqrstuv 35 | | ''' w 36 | an error occurred here 37 | ``` 38 | 39 | * Moved existing and added new premade styles to `Errata.Styles`. `Errata` no longer exports premade styles. Also moved `highlight` there. 40 | 41 | * 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. 42 | 43 | * Added support for replacing tabs with spaces with the `styleTabWidth` option in `Style` (defaults to 4). 44 | 45 | * Added option for the lines before and after the omission line with `styleExtraLinesAfter` and `styleExtraLinesBefore` in `Style`. 46 | 47 | * Added option for padding lines before and after the source `stylePaddingTop` and `stylePaddingBottom` in `Style`. 48 | 49 | * Added option for disabling the hook with `styleEnableHook` in `PointerStyle`. 50 | 51 | * 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. 52 | 53 | * Added option for toggling the line prefixes with `styleEnableLinePrefix` in `Style`. 54 | 55 | * Added `Show` instances to all the types. Style functions are applied to some sample text. 56 | 57 | * Changed `Monoid` constraint of `Source` to just requiring an `emptySource` value. 58 | 59 | * Fixed trailing whitespace in the omission line. 60 | 61 | ## 0.3.0.0 62 | 63 | * Support GHC 9.0.1 (and eventually 9.2). 64 | 65 | * 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`. 66 | 67 | * Reworked the pretty printer so that it no longer prints trailing whitespace in most places. 68 | 69 | * 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. 70 | 71 | * Removed `prettyErrorsNE`, as it is no longer useful for what it was documented for. 72 | 73 | * Fixed the rendering of `Block`s with no `Pointer`s adding extra blank lines. 74 | 75 | ## 0.2.0.0 76 | 77 | * 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. 78 | 79 | * The `blockSimple` and `blockSimple'` functions are now passed tuples of positions and labels instead of `Int`s, which is more consistent with the rest of the helper functions. 80 | 81 | * Defined type synonyms for line, column, headers, bodies, and labels, for the purpose of documentation. It should be much easier to know what is expected by just reading the types now. 82 | 83 | * Use `GHC.Arr.Array` for keeping source lines, which should be faster for indexing and should not force the individual lines until they are needed. 84 | 85 | ## 0.1.0.0 86 | 87 | * Initial release. 88 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020- comp 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Errata 2 | 3 | [![MIT License](https://img.shields.io/badge/license-MIT-blue.svg)](./LICENSE) 4 | [![Hackage](https://img.shields.io/hackage/v/errata.svg?logo=haskell)](https://hackage.haskell.org/package/errata) 5 | [![CI](https://github.com/1Computer1/errata/workflows/CI/badge.svg)](https://github.com/1Computer1/errata/actions?query=workflow%3ACI) 6 | 7 | **Errata** is an extremely customizable error pretty printer that can handle many kinds of error formatting. 8 | 9 | ## Features 10 | 11 | **Errata** can handle errors that are all over the source or errors that are connected to each other spanning multiple lines. You can be as simple or as fancy as you like! 12 | 13 | You can also customize the format of the printer in several ways: 14 | 15 | - Custom messages and labels 16 | - Custom character sets for symbols 17 | - Highlighting the source, messages, and symbols 18 | 19 | ## Examples 20 | 21 | A clean, modern error message that is trying to be helpful: 22 | 23 | ![An error message that points out that the `fold` function was not found in scope. It then asks if the user meant to use `foldl` or `foldr`](./errata_fold.png) 24 | 25 | A busy error message with underlining and connections: 26 | 27 | ![An error message that highlights mismatching types in an `if` expression. The first section underlines the mismatching values, and the second section underlines the `if` expression](./errata_if.png) 28 | -------------------------------------------------------------------------------- /errata.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | name: errata 3 | version: 0.4.0.3 4 | synopsis: Source code error pretty printing 5 | description: 6 | An extremely customizable error pretty printer that can handle many kinds of error formatting. 7 | It can handle errors that are connected, disconnected, and those spanning multiple lines. 8 | . 9 | You can get started by importing the "Errata" module. 10 | homepage: https://github.com/1Computer1/errata 11 | bug-reports: https://github.com/1Computer1/errata/issues 12 | license: MIT 13 | license-file: LICENSE 14 | author: comp 15 | maintainer: onecomputer00@gmail.com 16 | copyright: (c) 2020- comp 17 | category: Pretty Printer 18 | build-type: Simple 19 | extra-doc-files: 20 | README.md 21 | CHANGELOG.md 22 | tested-with: 23 | GHC == 9.2.8 24 | , GHC == 9.4.8 25 | , GHC == 9.6.6 26 | , GHC == 9.8.4 27 | , GHC == 9.10.1 28 | 29 | source-repository head 30 | type: git 31 | location: https://github.com/1Computer1/errata.git 32 | 33 | flag usewcwidth 34 | description: Enable the use of wcwidth for character widths. If disabled, uses an incomplete premade version. 35 | default: False 36 | 37 | common common-options 38 | build-depends: 39 | base >= 4.12 && < 4.21 40 | , containers >= 0.6 && < 0.8 41 | , text >= 1.2.3 && < 2.2 42 | ghc-options: 43 | -Wall 44 | -Wcompat 45 | -Widentities 46 | -Wincomplete-uni-patterns 47 | -Wincomplete-record-updates 48 | -Wredundant-constraints 49 | -Wpartial-fields 50 | -Wno-unused-do-bind 51 | default-language: Haskell2010 52 | 53 | library 54 | import: common-options 55 | hs-source-dirs: src 56 | exposed-modules: 57 | Errata 58 | Errata.Internal.Render 59 | Errata.Source 60 | Errata.Styles 61 | Errata.Types 62 | if flag(usewcwidth) 63 | cpp-options: -Dusewcwidth 64 | 65 | test-suite errata-test 66 | import: common-options 67 | type: exitcode-stdio-1.0 68 | hs-source-dirs: test 69 | main-is: Spec.hs 70 | other-modules: 71 | ErrataSpec 72 | , Errata.StylesSpec 73 | , Errata.TypesSpec 74 | build-depends: 75 | errata 76 | , hspec >= 2.7 && < 3 77 | , hspec-golden >= 0.2 && < 0.3 78 | build-tool-depends: 79 | hspec-discover:hspec-discover >= 2.7 && < 3 80 | ghc-options: 81 | -threaded 82 | -rtsopts 83 | -with-rtsopts=-N 84 | 85 | executable errata-example 86 | import: common-options 87 | hs-source-dirs: example 88 | main-is: Main.hs 89 | build-depends: 90 | errata 91 | ghc-options: 92 | -threaded 93 | -rtsopts 94 | -with-rtsopts=-N 95 | -------------------------------------------------------------------------------- /errata_fold.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/1Computer1/errata/f8f9530c73b635233b3dfa4ae3fe46740489da86/errata_fold.png -------------------------------------------------------------------------------- /errata_if.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/1Computer1/errata/f8f9530c73b635233b3dfa4ae3fe46740489da86/errata_if.png -------------------------------------------------------------------------------- /example/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE TypeApplications #-} 3 | 4 | module Main 5 | where 6 | 7 | import Data.List (intersperse) 8 | import qualified Data.Text as T 9 | import qualified Data.Text.Lazy.IO as TL 10 | import Errata 11 | import Errata.Styles 12 | 13 | ------------------------------------------------------------- 14 | -- Definitions from the Haddock example for 'prettyErrors' -- 15 | ------------------------------------------------------------- 16 | 17 | data ParseError = ParseError 18 | { peFile :: FilePath 19 | , peLine :: Int 20 | , peCol :: Int 21 | , peUnexpected :: T.Text 22 | , peExpected :: [T.Text] 23 | } 24 | 25 | toErrata :: ParseError -> Errata 26 | toErrata (ParseError fp l c unexpected expected) = 27 | errataSimple 28 | (Just "an error occured!") 29 | (blockSimple basicStyle basicPointer fp 30 | (Just "error: invalid syntax") 31 | (l, c, c + T.length unexpected, Just "this one") 32 | (Just $ "unexpected " <> unexpected <> "\nexpected " <> T.intercalate ", " expected)) 33 | Nothing 34 | 35 | printErrors :: T.Text -> [ParseError] -> IO () 36 | printErrors source es = TL.putStrLn $ prettyErrors source (toErrata <$> es) 37 | 38 | -------------- 39 | -- Examples -- 40 | -------------- 41 | 42 | -- | From the Haddock for 'prettyErrors'. 43 | jsonExample :: IO () 44 | jsonExample = printErrors 45 | "{\n \"bad\": [1, 2,]\n }" 46 | [ParseError "./comma.json" 2 18 "]" ["null", "true", "false", "\"", "-", "digit", "[", "{"]] 47 | 48 | -- | From the README. 49 | foldExample :: IO () 50 | foldExample = TL.putStrLn $ prettyErrors @String 51 | "sum xs = fold (+) 0 xs" 52 | [ Errata 53 | (Just "\x1b[31m─────── NAME UNKNOWN ───────\x1b[0m\n\nThe name \x1b[31mfold\x1b[0m was not found.\n") 54 | [ Block 55 | fancyRedStyle 56 | ("file.hs", 1, 10) 57 | Nothing 58 | [Pointer 1 10 14 False Nothing fancyRedPointer] 59 | Nothing 60 | ] 61 | (Just "\nDid you mean to use one of these?\n\n \x1b[31mfoldl\x1b[0m\n \x1b[31mfoldr\x1b[0m") 62 | ] 63 | 64 | -- | The fold example with no decorations and padding. 65 | foldNoDecorExample :: IO () 66 | foldNoDecorExample = TL.putStrLn $ prettyErrors @String 67 | "sum xs = fold (+) 0 xs" 68 | [ Errata 69 | (Just "\x1b[31m─────── NAME UNKNOWN ───────\x1b[0m\n\nThe name \x1b[31mfold\x1b[0m was not found.\n") 70 | [ Block 71 | (fancyRedStyle { styleEnableDecorations = False, stylePaddingTop = False }) 72 | ("file.hs", 1, 10) 73 | Nothing 74 | [Pointer 1 10 14 False Nothing fancyRedPointer] 75 | Nothing 76 | ] 77 | (Just "\nDid you mean to use one of these?\n\n \x1b[31mfoldl\x1b[0m\n \x1b[31mfoldr\x1b[0m") 78 | ] 79 | 80 | -- | From the README. 81 | ifExample :: IO () 82 | ifExample = TL.putStrLn $ prettyErrors @String 83 | "foo = if 1 > 2\n then 100\n else \"uh oh\"" 84 | [ Errata 85 | (Just "\x1b[31merror[E001]: mismatching types in `if` expression\x1b[0m") 86 | [ Block 87 | fancyRedStyle 88 | ("file.hs", 3, 10) 89 | Nothing 90 | [ Pointer 2 10 13 False (Just "\x1b[31mthis has type `Int`\x1b[0m") fancyRedPointer 91 | , Pointer 3 10 17 False (Just "\x1b[31mbut this has type `String`\x1b[0m") fancyRedPointer 92 | ] 93 | Nothing 94 | , Block 95 | fancyYellowStyle 96 | ("file.hs", 1, 7) 97 | Nothing 98 | [ Pointer 1 7 9 True Nothing fancyYellowPointer 99 | , Pointer 2 5 9 True Nothing fancyYellowPointer 100 | , Pointer 3 5 9 True (Just "\x1b[33min this `if` expression\x1b[0m") fancyYellowPointer 101 | ] 102 | Nothing 103 | ] 104 | (Just "\n\x1b[33mnote: use --explain E001 to learn more\x1b[0m") 105 | ] 106 | 107 | -- | The if example with a mixed-colors block. 108 | ifExample' :: IO () 109 | ifExample' = TL.putStrLn $ prettyErrors @String 110 | "foo = if 1 > 2\n then 100\n else \"uh oh\"" 111 | [ Errata 112 | (Just "\x1b[31merror[E001]: mismatching types in `if` expression\x1b[0m") 113 | [ Block 114 | fancyYellowStyle 115 | ("file.hs", 3, 10) 116 | Nothing 117 | [ Pointer 2 10 13 False (Just "\x1b[31mthis has type `Int`\x1b[0m") fancyRedPointer 118 | , Pointer 3 10 17 False (Just "\x1b[31mbut this has type `String`\x1b[0m") fancyRedPointer 119 | , Pointer 1 7 9 True Nothing (fancyYellowPointer { styleUnderline = "\x1b[33m-\x1b[0m" }) 120 | , Pointer 2 5 9 True Nothing (fancyYellowPointer { styleUnderline = "\x1b[33m-\x1b[0m" }) 121 | , Pointer 3 5 9 True (Just "\x1b[33min this `if` expression\x1b[0m") (fancyYellowPointer { styleUnderline = "\x1b[33m-\x1b[0m" }) 122 | ] 123 | Nothing 124 | ] 125 | (Just "\n\x1b[33mnote: use --explain E001 to learn more\x1b[0m") 126 | ] 127 | 128 | -- | From the documentation for premade styles. 129 | stylesExample :: Style -> PointerStyle -> IO () 130 | stylesExample style pstyle = TL.putStrLn $ prettyErrors @String 131 | "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end" 132 | [ Errata 133 | (Just "error header message") 134 | [ Block 135 | style 136 | ("file.ext", 1, 16) 137 | (Just "block header message") 138 | [ Pointer 1 16 18 True (Just "start label") pstyle 139 | , Pointer 2 6 7 False (Just "unconnected label") pstyle 140 | , Pointer 3 6 7 True (Just "middle label") pstyle 141 | , Pointer 8 6 7 True (Just "inner label") pstyle 142 | , Pointer 8 12 15 True (Just "end label") pstyle 143 | ] 144 | (Just "block body message") 145 | ] 146 | (Just "error body message") 147 | ] 148 | 149 | -- | From a test, but with colors. 150 | noDecorExample :: IO () 151 | noDecorExample = TL.putStrLn $ prettyErrors @String 152 | "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end" 153 | [ Errata 154 | (Just "error header message") 155 | [ Block 156 | (fancyRedStyle { styleEnableDecorations = False, stylePaddingTop = False }) 157 | ("file.ext", 1, 16) 158 | (Just "block header message") 159 | [ Pointer 1 16 18 True (Just "start label") fancyRedPointer 160 | , Pointer 2 6 7 False (Just "unconnected label") fancyRedPointer 161 | , Pointer 3 6 7 True (Just "middle label") fancyRedPointer 162 | , Pointer 8 6 7 True (Just "inner label") fancyRedPointer 163 | , Pointer 8 12 15 True (Just "end label") fancyRedPointer 164 | ] 165 | (Just "block body message") 166 | ] 167 | (Just "error body message") 168 | ] 169 | 170 | main :: IO () 171 | main = sequence_ . intersperse (putStrLn "") $ 172 | [ jsonExample 173 | , foldExample 174 | , foldNoDecorExample 175 | , ifExample 176 | , ifExample' 177 | , noDecorExample 178 | ] <> map (uncurry stylesExample $) themes 179 | where 180 | themes = 181 | [ (basicStyle, basicPointer) 182 | , (fancyStyle, fancyPointer) 183 | , (fancyRedStyle, fancyRedPointer) 184 | , (fancyYellowStyle, fancyYellowPointer) 185 | ] 186 | -------------------------------------------------------------------------------- /hie.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | cabal: 3 | - path: "./src" 4 | component: "lib:errata" 5 | - path: "./test" 6 | component: "test:errata-test" 7 | - path: "./example" 8 | component: "executable:errata-example" 9 | -------------------------------------------------------------------------------- /src/Errata.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Errata 3 | Copyright : (c) 2020- comp 4 | License : MIT 5 | Maintainer : onecomputer00@gmail.com 6 | Stability : stable 7 | Portability : portable 8 | 9 | This module is for creating pretty error messages. We assume very little about the format you want to use, so much of 10 | this module is to allow you to customize your error messages. 11 | 12 | To get started, see the documentation for 'prettyErrors'. When using this module, we recommend you turn on the 13 | @OverloadedStrings@ extension and import "Data.Text" at the very least due to the use of 'Data.Text.Text' (strict). 14 | 15 | The overall workflow to use the printer is to convert your error type to 'Errata', which entails filling in messages 16 | and 'Block's. You can create 'Errata' and 'Block' from their constructors, or use the convenience functions for 17 | common usecases, like 'errataSimple' and 'blockSimple'. 18 | 19 | For premade styles for blocks and pointers, take a look at "Errata.Styles". 20 | 21 | For easier reading, we define: 22 | 23 | > type Line = Int 24 | > type Column = Int 25 | > type Header = Text 26 | > type Body = Text 27 | > type Label = Text 28 | -} 29 | module Errata 30 | ( -- * Error format data 31 | Errata (..) 32 | , errataSimple 33 | -- * Blocks and pointers 34 | , Block (..) 35 | , blockSimple 36 | , blockSimple' 37 | , blockConnected 38 | , blockConnected' 39 | , blockMerged 40 | , blockMerged' 41 | , Pointer (..) 42 | -- * Styling options 43 | , Style (..) 44 | , PointerStyle (..) 45 | -- * Pretty printer 46 | , prettyErrors 47 | ) where 48 | 49 | import qualified Data.Text.Lazy as TL 50 | import qualified Data.Text.Lazy.Builder as TB 51 | import Errata.Internal.Render 52 | import Errata.Source 53 | import Errata.Types 54 | 55 | -- | Creates a simple error that has a single block, with an optional header or body. 56 | errataSimple 57 | :: Maybe Header -- ^ The header. 58 | -> Block -- ^ The block. 59 | -> Maybe Body -- ^ The body. 60 | -> Errata 61 | errataSimple header block body = Errata 62 | { errataHeader = header 63 | , errataBlocks = [block] 64 | , errataBody = body 65 | } 66 | 67 | -- | A simple block that points to only one line and optionally has a label, header, or body message. 68 | blockSimple 69 | :: Style -- ^ The style of the block. 70 | -> PointerStyle -- ^ The style of the pointer. 71 | -> FilePath -- ^ The filepath. 72 | -> Maybe Header -- ^ The header message. 73 | -> (Line, Column, Column, Maybe Label) -- ^ The line number and column span, starting at 1, and a label. 74 | -> Maybe Body -- ^ The body message. 75 | -> Block 76 | blockSimple style pstyle fp hm (l, cs, ce, lbl) bm = Block 77 | { blockStyle = style 78 | , blockLocation = (fp, l, cs) 79 | , blockHeader = hm 80 | , blockPointers = [Pointer l cs ce False lbl pstyle] 81 | , blockBody = bm 82 | } 83 | 84 | -- | A variant of 'blockSimple' that only points at one column. 85 | blockSimple' 86 | :: Style -- ^ The style of the block. 87 | -> PointerStyle -- ^ The style of the pointer. 88 | -> FilePath -- ^ The filepath. 89 | -> Maybe Header -- ^ The header message. 90 | -> (Line, Column, Maybe Label) -- ^ The line number and column, starting at 1, and a label. 91 | -> Maybe Body -- ^ The body message. 92 | -> Block 93 | blockSimple' style pstyle fp hm (l, c, lbl) bm = 94 | blockSimple style pstyle fp hm (l, c, c + 1, lbl) bm 95 | 96 | -- | A block that points to two parts of the source that are visually connected together. 97 | blockConnected 98 | :: Style -- ^ The style of the block. 99 | -> PointerStyle -- ^ The style of the pointer. 100 | -> FilePath -- ^ The filepath. 101 | -> Maybe Header -- ^ The header message. 102 | -> (Line, Column, Column, Maybe Label) -- ^ The first line number and column span, starting at 1, and a label. 103 | -> (Line, Column, Column, Maybe Label) -- ^ The second line number and column span, starting at 1, and a label. 104 | -> Maybe Body -- ^ The body message. 105 | -> Block 106 | blockConnected style pstyle fp hm (l1, cs1, ce1, lbl1) (l2, cs2, ce2, lbl2) bm = Block 107 | { blockStyle = style 108 | , blockLocation = (fp, l1, cs1) 109 | , blockHeader = hm 110 | , blockPointers = [Pointer l1 cs1 ce1 True lbl1 pstyle, Pointer l2 cs2 ce2 True lbl2 pstyle] 111 | , blockBody = bm 112 | } 113 | 114 | -- | A variant of 'blockConnected' where the pointers point at only one column. 115 | blockConnected' 116 | :: Style -- ^ The style of the block. 117 | -> PointerStyle -- ^ The style of the pointer. 118 | -> FilePath -- ^ The filepath. 119 | -> Maybe Header -- ^ The header message. 120 | -> (Line, Column, Maybe Label) -- ^ The first line number and column, starting at 1, and a label. 121 | -> (Line, Column, Maybe Label) -- ^ The second line number and column, starting at 1, and a label. 122 | -> Maybe Body -- ^ The body message. 123 | -> Block 124 | blockConnected' style pstyle fp hm (l1, c1, lbl1) (l2, c2, lbl2) bm = 125 | blockConnected style pstyle fp hm (l1, c1, c1 + 1, lbl1) (l2, c2, c2 + 1, lbl2) bm 126 | 127 | {- | A block that points to two parts of the source that are visually connected together. 128 | 129 | If the two parts of the source happen to be on the same line, the pointers are merged into one. 130 | -} 131 | blockMerged 132 | :: Style -- ^ The style of the block. 133 | -> PointerStyle -- ^ The style of the pointer. 134 | -> FilePath -- ^ The filepath. 135 | -> Maybe Header -- ^ The header message. 136 | -> (Line, Column, Column, Maybe Label) -- ^ The first line number and column span, starting at 1, and a label. 137 | -> (Line, Column, Column, Maybe Label) -- ^ The second line number and column span, starting at 1, and a label. 138 | -> Maybe Label -- ^ The label for when the two pointers are merged into one. 139 | -> Maybe Body -- ^ The body message. 140 | -> Block 141 | blockMerged style pstyle fp hm (l1, cs1, ce1, lbl1) (l2, cs2, ce2, lbl2) lbl bm = Block 142 | { blockStyle = style 143 | , blockLocation = (fp, l1, cs1) 144 | , blockHeader = hm 145 | , blockPointers = if l1 == l2 146 | then [Pointer l1 cs1 ce2 False lbl pstyle] 147 | else [Pointer l1 cs1 ce1 True lbl1 pstyle, Pointer l2 cs2 ce2 True lbl2 pstyle] 148 | , blockBody = bm 149 | } 150 | 151 | -- | A variant of 'blockMerged' where the pointers point at only one column. 152 | blockMerged' 153 | :: Style -- ^ The style of the block. 154 | -> PointerStyle -- ^ The style of the pointer. 155 | -> FilePath -- ^ The filepath. 156 | -> Maybe Header -- ^ The header message. 157 | -> (Line, Column, Maybe Label) -- ^ The first line number and column, starting at 1, and a label. 158 | -> (Line, Column, Maybe Label) -- ^ The second line number and column, starting at 1, and a label. 159 | -> Maybe Label -- ^ The label for when the two pointers are merged into one. 160 | -> Maybe Body -- ^ The body message. 161 | -> Block 162 | blockMerged' pstyle style fp hm (l1, c1, lbl1) (l2, c2, lbl2) lbl bm = 163 | blockMerged pstyle style fp hm (l1, c1, c1 + 1, lbl1) (l2, c2, c2 + 1, lbl2) lbl bm 164 | 165 | {- | Pretty prints errors. The original source is required. Returns 'Data.Text.Lazy.Text' (lazy). If the list is empty, 166 | an empty string is returned. 167 | 168 | Suppose we had an error of this type: 169 | 170 | > data ParseError = ParseError 171 | > { peFile :: FilePath 172 | > , peLine :: Int 173 | > , peCol :: Int 174 | > , peUnexpected :: T.Text 175 | > , peExpected :: [T.Text] 176 | > } 177 | 178 | Then we can create a simple pretty printer like so: 179 | 180 | @ 181 | import qualified Data.Text as T 182 | import qualified Data.Text.Lazy.IO as TL 183 | import "Errata" 184 | 185 | toErrata :: ParseError -> 'Errata' 186 | toErrata (ParseError fp l c unexpected expected) = 187 | 'errataSimple' 188 | (Just \"an error occured!\") 189 | ('blockSimple' 'Errata.Styles.basicStyle' 'Errata.Styles.basicPointer' fp 190 | (Just \"error: invalid syntax\") 191 | (l, c, c + T.length unexpected, Just \"this one\") 192 | (Just $ \"unexpected \" \<> unexpected \<> \"\\nexpected \" \<> T.intercalate \", \" expected)) 193 | Nothing 194 | 195 | printErrors :: T.Text -> [ParseError] -> IO () 196 | printErrors source es = TL.putStrLn $ 'prettyErrors' source (map toErrata es) 197 | @ 198 | 199 | Note that in the above example, we have @OverloadedStrings@ enabled to reduce uses of 'Data.Text.pack'. 200 | 201 | An example error message from this might be: 202 | 203 | > an error occured! 204 | > --> ./comma.json:2:18 205 | > error: invalid syntax 206 | > | 207 | > 2 | "bad": [1, 2,] 208 | > | ^ this one 209 | > unexpected ] 210 | > expected null, true, false, ", -, digit, [, { 211 | -} 212 | prettyErrors :: Source source => source -> [Errata] -> TL.Text 213 | prettyErrors source errs = TB.toLazyText $ renderErrors source errs 214 | -------------------------------------------------------------------------------- /src/Errata/Internal/Render.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE CPP #-} 3 | {-# LANGUAGE MultiWayIf #-} 4 | {-# LANGUAGE NamedFieldPuns #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE RecordWildCards #-} 7 | {-# LANGUAGE ScopedTypeVariables #-} 8 | {-# LANGUAGE ViewPatterns #-} 9 | 10 | {- | 11 | Module : Errata.Internal.Render 12 | Copyright : (c) 2020- comp 13 | License : MIT 14 | Maintainer : onecomputer00@gmail.com 15 | Stability : stable 16 | Portability : portable 17 | 18 | Functions for rendering the errors. You should not need to import this, as these functions are lower-level. 19 | 20 | This module is internal, and may break across non-breaking versions. 21 | -} 22 | module Errata.Internal.Render 23 | ( renderErrors 24 | , renderErrata 25 | , renderBlock 26 | , renderSourceLines 27 | , groupBlockPointers 28 | , slices 29 | , makeSourceTable 30 | ) where 31 | 32 | import Control.Applicative (ZipList (..)) 33 | import Control.Arrow ((&&&)) 34 | import qualified Data.IntMap as I 35 | import Data.List (foldl', inits, sortOn) 36 | import Data.Maybe (isJust) 37 | import qualified Data.Text as T 38 | import qualified Data.Text.Lazy.Builder as TB 39 | import Errata.Source 40 | import Errata.Types 41 | 42 | #if defined(usewcwidth) 43 | import Foreign.C 44 | #endif 45 | 46 | -- | Renders a collection of 'Errata'. 47 | renderErrors :: Source source => source -> [Errata] -> TB.Builder 48 | renderErrors source errs = errorMessage 49 | where 50 | -- The pointers grouped by line, for each Errata. 51 | blockPointersGrouped = map (map groupBlockPointers . errataBlocks) errs 52 | 53 | -- Min and max line numbers as defined by the pointers of each block, for each Errata. 54 | minPointers = (map . map) (maybe 1 id . fmap fst . I.lookupMin) blockPointersGrouped 55 | maxPointers = (map . map) (maybe 0 id . fmap fst . I.lookupMax) blockPointersGrouped 56 | 57 | minLine = minimum (concat minPointers) 58 | maxLine = maximum (concat maxPointers) 59 | 60 | {- Optimization: we use a Patricia tree (IntMap) indexed by start line 61 | into respective tail slices of the list of source lines @slines@. 62 | 63 | If we were to use the list @slines@ as-is: 64 | O(n) seeking per source block, O(n) traversal 65 | Since, we would be linearly traversing to the start of each source block every 66 | time with no caching for future source blocks at (or close to) the same starting 67 | line as previous source blocks. 68 | 69 | If we were to use an IntMap of source lines by itself: 70 | Seeking becomes free, at the expense of O(n log n) traversal per source block 71 | Since, we are performing an O(log n) average case Patricia lookup per line. 72 | 73 | Whereas if we use a hybrid IntMap + association list approach: 74 | O(n + log n) worst case, O(log n) average case, seeking per source block, O(n) traversal 75 | Worse case is unevaluated slices, as this would force @slices@ evaluation, which is 76 | an O(n) list traversal, on top of an O(log n) Patricia lookup. Partially-evaluated leafs will 77 | have slightly better asymptotics, and fully-evaluated leafs will be O(log n) average case, 78 | which is just the cost of a Patricia lookup. 79 | 80 | For sufficiently large block counts with scattered pointers per block, which we assume 81 | holds for real-world use cases, the traversal savings on repeat lookups will quickly favor 82 | hybrid association list + IntMap asymptotics. 83 | -} 84 | srcTable = makeSourceTable minLine maxLine (sourceToLines source) 85 | 86 | errataMessages = getZipList $ renderErrata srcTable 87 | <$> ZipList errs 88 | <*> ZipList blockPointersGrouped 89 | <*> ZipList minPointers 90 | <*> ZipList maxPointers 91 | 92 | errorMessage = unsplit "\n\n" errataMessages 93 | 94 | -- | Group the pointers of a block by the line they appear on. 95 | groupBlockPointers :: Block -> I.IntMap [Pointer] 96 | groupBlockPointers = I.fromListWith (<>) . map (\p -> (pointerLine p, pure p)) . blockPointers 97 | 98 | -- | Create a source table from the given line span and source lines. 99 | makeSourceTable :: Source a => Line -> Line -> [a] -> I.IntMap [a] 100 | makeSourceTable minLine maxLine slines = I.fromDistinctAscList $ 101 | zip [minLine .. maxLine] (drop (minLine - 1) (slices slines)) 102 | 103 | {- | Turns a list into a list of tail slices of the original list, with each element at index @i@ dropping 104 | the first @i@ elements of the original list and tailing an 'emptySource'. 105 | 106 | This allows for correct behavior on out-of-source-bounds pointers. 107 | -} 108 | slices :: Source a => [a] -> [[a]] 109 | slices [] = repeat (repeat emptySource) 110 | slices xs = (xs <> repeat emptySource) : slices (tail xs) 111 | 112 | -- | Renders a single 'Errata'. 113 | renderErrata 114 | :: Source source 115 | => I.IntMap [source] -- ^ The source table. 116 | -> Errata -- ^ The 'Errata' to render. 117 | -> [I.IntMap [Pointer]] -- ^ The pointers of each block grouped by line. 118 | -> [Line] -- ^ The mininum line of each block. 119 | -> [Line] -- ^ The maxinum line of each block. 120 | -> TB.Builder 121 | renderErrata srcTable (Errata {..}) blockPointersGrouped minPointers maxPointers = errorMessage 122 | where 123 | blockMessages = getZipList $ renderBlock srcTable 124 | <$> ZipList errataBlocks 125 | <*> ZipList blockPointersGrouped 126 | <*> ZipList (zip minPointers maxPointers) 127 | 128 | errorMessage = mconcat 129 | [ TB.fromText $ maybe "" id errataHeader 130 | , case blockMessages of 131 | [] -> "" 132 | xs -> case errataHeader of 133 | Nothing -> unsplit "\n\n" xs 134 | Just _ -> "\n" <> unsplit "\n\n" xs 135 | , TB.fromText $ maybe "" ("\n" <>) errataBody 136 | ] 137 | 138 | -- | Renders a single block. 139 | renderBlock 140 | :: Source source 141 | => I.IntMap [source] -- ^ The source table. 142 | -> Block -- ^ The block to render. 143 | -> I.IntMap [Pointer] -- ^ The pointers of this block grouped by line. 144 | -> (Line, Line) -- ^ The mininum and maximum lines of this block. 145 | -> TB.Builder 146 | renderBlock srcTable block@(Block {..}) blockPointersGrouped ~(minBlockLine, maxBlockLine) = blockMessage 147 | where 148 | slines = zip [minBlockLine .. maxBlockLine] (maybe [] id $ I.lookup minBlockLine srcTable) 149 | 150 | -- Padding size before the line prefix. 151 | padding = length (show maxBlockLine) 152 | 153 | blockMessage = mconcat 154 | [ TB.fromText $ styleLocation blockStyle blockLocation 155 | , TB.fromText $ maybe "" ("\n" <>) blockHeader 156 | , maybe "" ("\n" <>) $ renderSourceLines slines block padding blockPointersGrouped 157 | , TB.fromText $ maybe "" ("\n" <>) blockBody 158 | ] 159 | 160 | -- | Renders the source lines for a block. 161 | renderSourceLines 162 | :: forall source 163 | . Source source 164 | => [(Line, source)] -- ^ The source lines, from the minimum line to the maximum line for the block. 165 | -> Block -- ^ The block to render. 166 | -> Int -- ^ The length of the actual number of the maximum line. 167 | -> I.IntMap [Pointer] -- ^ The pointers of this block grouped by line. 168 | -> Maybe (TB.Builder) 169 | renderSourceLines _ _ _ (I.null -> True) = Nothing 170 | renderSourceLines slines (Block {..}) padding pointersGrouped = Just $ unsplit "\n" decoratedLines 171 | where 172 | {- Terminology used in this code: 173 | ↓↓ gutter 174 | │ ← padding line 175 | 1 │ line 1 foo bar do 176 | │ ┌────────^───────^^ 177 | │ │ │ ← connector 178 | │ │ hook → └ hi ← label 179 | 2 │ │ line 2 180 | 3 │ │ line 3 181 | │ ├──────^ 182 | 4 │ │ line 4 ← extra line 183 | 5 │ │ line 5 ← extra line 184 | . │ │ ← omission 185 | 7 │ │ line 7 ← extra line 186 | 8 │ │ line 8 baz end 187 | │ └──────^─────^^^ ← underline 188 | ↑↑↑↑ ↑↑↑↑↑ 189 | prefix catch up 190 | -} 191 | Style {..} = blockStyle 192 | 193 | -- Shows a line in accordance to the style. 194 | -- We might get a line that's out-of-bounds, usually the EOF line, so we can default to empty. 195 | showLine :: [(PointerStyle, (Column, Column))] -> source -> TB.Builder 196 | showLine hs = TB.fromText . T.replace "\t" (T.replicate styleTabWidth " ") . styleLine hs . sourceToText 197 | 198 | -- Generic prefix without line number, used for non-source lines i.e. decorations. 199 | prefix :: TB.Builder 200 | prefix = if styleEnableLinePrefix 201 | then mconcat [replicateB padding " ", " ", TB.fromText styleLinePrefix, " "] 202 | else "" 203 | 204 | -- Prefix with a line number, used for source lines. 205 | linePrefix :: Line -> TB.Builder 206 | linePrefix n = if styleEnableLinePrefix 207 | then mconcat [TB.fromText (styleNumber n), replicateB (padding - length (show n)) " ", " ", TB.fromText styleLinePrefix, " "] 208 | else "" 209 | 210 | -- The resulting source lines with decorations; extra prefix included for padding. 211 | decoratedLines :: [TB.Builder] 212 | decoratedLines = [paddingLine | stylePaddingTop] <> makeDecoratedLines 0 slines<> [paddingLine | stylePaddingBottom] 213 | where 214 | paddingLine = if styleEnableLinePrefix 215 | then mconcat [replicateB padding " ", " ", TB.fromText styleLinePrefix] 216 | else "" 217 | 218 | -- Whether there will be a multiline span in the block. 219 | hasConnMulti :: Bool 220 | hasConnMulti = I.size (I.filter (any pointerConnect) pointersGrouped) > 1 221 | 222 | -- Whether line /n/ has a connection to somewhere else (including the same line). 223 | hasConn :: Line -> Bool 224 | hasConn n = maybe False (any pointerConnect) $ I.lookup n pointersGrouped 225 | 226 | -- Whether line /n/ has a connection to a line before or after it (but not including). 227 | connAround :: Line -> (Bool, Bool) 228 | connAround n = 229 | let (a, b) = I.split n pointersGrouped 230 | in ((any . any) pointerConnect a, (any . any) pointerConnect b) 231 | 232 | -- Decorates all the pointed-to source lines, along with extra lines. 233 | -- We have an @extra@ parameter to keep track of extra lines when spanning multiple lines. 234 | makeDecoratedLines :: Line -> [(Line, source)] -> [TB.Builder] 235 | -- No lines left. 236 | makeDecoratedLines _ [] = [] 237 | -- The next line is a line we have to decorate with pointers. 238 | makeDecoratedLines _ (pr@(n, _):ls) 239 | | Just p <- I.lookup n pointersGrouped = decorateLine p pr <> makeDecoratedLines 0 ls 240 | -- The next line is an extra line, within a limit. 241 | makeDecoratedLines extra ((n, l):ls) 242 | | extra < styleExtraLinesAfter = 243 | let mid = if 244 | | not styleEnableDecorations -> "" 245 | | snd (connAround n) -> TB.fromText styleVertical <> " " 246 | | hasConnMulti -> " " 247 | | otherwise -> "" 248 | in (linePrefix n <> mid <> showLine [] l) : makeDecoratedLines (extra + 1) ls 249 | -- We reached the extra line limit, so now there's some logic to figure out what's next. 250 | makeDecoratedLines _ ls = 251 | let (es, ls') = break ((`I.member` pointersGrouped) . fst) ls 252 | in case (es, ls') of 253 | -- There were no lines left to decorate anyways. 254 | (_, []) -> [] 255 | -- There are lines left to decorate, and it came right after. 256 | ([], _) -> makeDecoratedLines 0 ls' 257 | -- There are more than one line in between, so we take as much as is configured. 258 | (_, _) -> 259 | let es' = reverse . take styleExtraLinesBefore . reverse $ es 260 | extras = flip map es' $ \(n, l) -> 261 | let gutter = if 262 | | not styleEnableDecorations -> "" 263 | | snd (connAround n) -> TB.fromText styleVertical <> " " 264 | | hasConnMulti -> " " 265 | | otherwise -> "" 266 | in linePrefix n <> gutter <> showLine [] l 267 | in case compareLength es' es of 268 | -- We only add the omission line if it doesn't take all of the lines. 269 | LT -> let 270 | -- Prefix and gutter for omitting lines when spanning many lines. 271 | omitPrefix = if styleEnableLinePrefix 272 | then mconcat [TB.fromText styleEllipsis, replicateB (padding - 1) " ", " ", TB.fromText styleLinePrefix] 273 | else "" 274 | omitGutter = if 275 | | not styleEnableDecorations -> "" 276 | | snd . connAround . fst $ head ls -> " " <> TB.fromText styleVertical 277 | | otherwise -> "" 278 | in (omitPrefix <> omitGutter) : extras <> makeDecoratedLines 0 ls' 279 | _ -> extras <> makeDecoratedLines 0 ls' 280 | 281 | -- Decorate a line that has pointers. 282 | -- The pointers we get are assumed to be all on the same line. 283 | decorateLine :: [Pointer] -> (Line, source) -> [TB.Builder] 284 | decorateLine pointers (n, l) = (linePrefix n <> gutter <> stylizedLine) : decorationLines 285 | where 286 | gutter = if 287 | | not styleEnableDecorations -> "" 288 | | hasConnBefore && hasConnUnder -> TB.fromText styleVertical <> " " 289 | | hasConnMulti -> " " 290 | | otherwise -> "" 291 | 292 | -- Shortcuts to where this line connects to. 293 | hasConnHere = hasConn n 294 | (hasConnBefore, hasConnAfter) = connAround n 295 | hasConnAround = hasConnBefore || hasConnAfter 296 | hasConnOver = hasConnHere || hasConnBefore 297 | hasConnUnder = hasConnHere || hasConnAfter 298 | 299 | -- The sorted pointers by column. 300 | pointersSorted = sortOn pointerColumns pointers 301 | 302 | -- The actual source line. 303 | sourceLine = sourceToText l 304 | 305 | -- The source line stylized. 306 | stylizedLine = showLine (map (pointerStyle &&& pointerColumns) pointersSorted) l 307 | 308 | -- The resulting decoration lines. 309 | decorationLines = case filter (isJust . pointerLabel) (init pointersSorted) of 310 | _ | not styleEnableDecorations -> [] 311 | -- There's only one pointer, so no need for more than just an underline and label. 312 | _ | length pointersSorted == 1 -> [underline pointersSorted] 313 | -- There's no labels at all, so we just need the underline. 314 | [] -> [underline pointersSorted] 315 | -- Otherwise, we have three steps to do: 316 | -- The underline directly underneath. 317 | -- An extra connector for the labels other than the rightmost one. 318 | -- The remaining connectors and the labels. 319 | hasLabels -> underline pointersSorted 320 | : connectors hasLabels 321 | : (map connectorAndLabel . reverse . tail $ inits hasLabels) 322 | 323 | -- Create an underline directly under the source. The last pointer can have a label on this line. 324 | underline :: [Pointer] -> TB.Builder 325 | underline ps = 326 | let (decor, _) = foldDecorations 327 | (\k isFirst rest text -> if 328 | | isFirst && any pointerConnect rest && hasConnAround -> replaceWithWidth k styleTabWidth text styleHorizontal 329 | | isFirst -> replaceWithWidth k styleTabWidth text " " 330 | | any pointerConnect rest -> replaceWithWidth k styleTabWidth text styleHorizontal 331 | | otherwise -> replaceWithWidth k styleTabWidth text " " 332 | ) 333 | (\k p text -> 334 | let x = styleUnderline (pointerStyle p) 335 | in (k, replaceWithWidth k styleTabWidth text x) 336 | ) 337 | ps 338 | sourceLine 339 | lbl = maybe "" (" " <>) . pointerLabel $ last ps 340 | decorGutter = if 341 | | hasConnHere && hasConnBefore && hasConnAfter -> styleUpDownRight <> styleHorizontal 342 | | hasConnHere && hasConnBefore -> styleUpRight <> styleHorizontal 343 | | hasConnHere && hasConnAfter -> styleDownRight <> styleHorizontal 344 | | hasConnBefore && hasConnAfter -> styleVertical <> " " 345 | | hasConnMulti -> " " 346 | | otherwise -> "" 347 | in prefix <> TB.fromText decorGutter <> decor <> TB.fromText lbl 348 | 349 | -- Create connectors underneath. No labels are rendered here. 350 | connectors :: [Pointer] -> TB.Builder 351 | connectors ps = 352 | let (decor, _) = foldDecorations 353 | (\k _ _ text -> replaceWithWidth k styleTabWidth text " ") 354 | (\_ p _ -> 355 | let x = styleConnector (pointerStyle p) 356 | in (1, TB.fromText x) 357 | ) 358 | ps 359 | sourceLine 360 | decorGutter = if 361 | | hasConnOver && hasConnAfter -> styleVertical <> " " 362 | | hasConnMulti -> " " 363 | | otherwise -> "" 364 | in prefix <> TB.fromText decorGutter <> decor 365 | 366 | -- Create connectors and labels underneath. The last pointer can have a label on this line. 367 | connectorAndLabel :: [Pointer] -> TB.Builder 368 | connectorAndLabel ps = 369 | let (decor, finalCol) = foldDecorations 370 | (\k _ _ text -> replaceWithWidth k styleTabWidth text " ") 371 | (\_ p _ -> 372 | let x = styleConnector (pointerStyle p) 373 | in (1, TB.fromText x) 374 | ) 375 | (init ps) 376 | sourceLine 377 | pointer = last ps 378 | hook = styleHook (pointerStyle pointer) 379 | lbl = maybe "" 380 | (\x -> if 381 | | styleEnableHook (pointerStyle pointer) -> mconcat 382 | [ replicateB (pointerColStart pointer - finalCol) " " 383 | , TB.fromText hook 384 | , " " 385 | , TB.fromText x 386 | ] 387 | | otherwise -> mconcat 388 | [ replicateB (pointerColStart pointer - finalCol) " " 389 | , TB.fromText x 390 | ] 391 | ) 392 | (pointerLabel pointer) 393 | decorGutter = if 394 | | hasConnOver && hasConnAfter -> styleVertical <> " " 395 | | hasConnMulti -> " " 396 | | otherwise -> "" 397 | in prefix <> TB.fromText decorGutter <> decor <> lbl 398 | 399 | -- | Makes a line of decorations below the source. 400 | foldDecorations 401 | :: (Int -> Bool -> [Pointer] -> T.Text -> TB.Builder) 402 | {- ^ Catch up from the previous pointer to this pointer. 403 | 404 | @catchUp distance isFirst pointers text@ should return text of at least length @distance@. 405 | -} 406 | -> (Int -> Pointer -> T.Text -> (Int, TB.Builder)) 407 | {- ^ Add text underneath the pointer before the next pointer. 408 | 409 | @underlinePointer pointerLen pointer text@ should return the text and its length. 410 | -} 411 | -> [Pointer] 412 | -> T.Text 413 | -> (TB.Builder, Column) 414 | foldDecorations catchUp underlinePointer ps line = 415 | let (decor, finalCol, _, _) = paral 416 | (\(rest, (xs, c, isFirst, remainingLine)) p@(Pointer {..}) -> 417 | let (textBefore, textUnderAndRest) = T.splitAt (pointerColStart - c) remainingLine 418 | (textUnder, textRest) = T.splitAt (pointerColEnd - pointerColStart) textUnderAndRest 419 | (afterLen, afterText) = underlinePointer (pointerColEnd - pointerColStart) p textUnder 420 | in 421 | ( mconcat 422 | [ xs 423 | , catchUp (pointerColStart - c) isFirst (p:rest) textBefore 424 | , afterText 425 | ] 426 | , pointerColStart + afterLen 427 | , False 428 | , textRest 429 | ) 430 | ) 431 | ("", 1, True, line) 432 | ps 433 | in (decor, finalCol) 434 | 435 | -- | Paramorphism on lists (strictly, from the left). 436 | paral :: (([a], b) -> a -> b) -> b -> [a] -> b 437 | paral _ b [] = b 438 | paral f b (a:as) = 439 | let !b' = f (as, b) a 440 | in paral f b' as 441 | 442 | -- | Compares length of two lists without traversing them completely. 443 | compareLength :: [a] -> [b] -> Ordering 444 | compareLength [] [] = EQ 445 | compareLength (_:xs) (_:ys) = compareLength xs ys 446 | compareLength [] _ = LT 447 | compareLength _ [] = GT 448 | 449 | -- | Puts text between each item. 450 | unsplit :: TB.Builder -> [TB.Builder] -> TB.Builder 451 | unsplit _ [] = "" 452 | unsplit a (x:xs) = foldl' (\acc y -> acc <> a <> y) x xs 453 | {-# INLINE unsplit #-} 454 | 455 | -- | Replicates text into a builder. 456 | replicateB :: Int -> T.Text -> TB.Builder 457 | replicateB n xs = TB.fromText (T.replicate n xs) 458 | {-# INLINE replicateB #-} 459 | 460 | {- | Replaces each character in the text with the appropriate instances of the given text based on character width. 461 | 462 | The result will also be right-padded with the given text to the given length. 463 | 464 | For tabs, the tab width given is used to make it equivalent to that many spaces. 465 | -} 466 | replaceWithWidth :: Int -> Int -> T.Text -> T.Text -> TB.Builder 467 | replaceWithWidth len tab ref xs = T.foldl' (\acc c -> acc <> replicateB (width c) xs) "" ref <> replicateB (len - T.length ref) xs 468 | where 469 | width '\t' = tab 470 | width c = charWidth c 471 | {-# INLINE replaceWithWidth #-} 472 | 473 | #if defined(usewcwidth) 474 | foreign import ccall unsafe "wchar.h wcwidth" wcwidth :: CWchar -> CInt 475 | {-| Get the designated render width of a character, based on the native wcwidth. 476 | Where wcwidth would return -1, 0 is returned instead. 477 | 478 | The result will depend on the current locale and Unicode version. 479 | -} 480 | charWidth :: Char -> Int 481 | charWidth = max 0 . fromEnum . wcwidth . toEnum . fromEnum 482 | #else 483 | {-| Get the designated render width of a character: 0 for a combining character, 1 for a regular character, 484 | 2 for a wide character. (Wide characters are rendered as exactly double width in apps and fonts that support it.) 485 | 486 | (From Pandoc.) 487 | -} 488 | charWidth :: Char -> Int 489 | charWidth c = if 490 | | c < '\x0300' -> 1 491 | -- Combining 492 | | c >= '\x0300' && c <= '\x036F' -> 0 493 | | c >= '\x0370' && c <= '\x10FC' -> 1 494 | | c >= '\x1100' && c <= '\x115F' -> 2 495 | | c >= '\x1160' && c <= '\x11A2' -> 1 496 | | c >= '\x11A3' && c <= '\x11A7' -> 2 497 | | c >= '\x11A8' && c <= '\x11F9' -> 1 498 | | c >= '\x11FA' && c <= '\x11FF' -> 2 499 | | c >= '\x1200' && c <= '\x2328' -> 1 500 | | c >= '\x2329' && c <= '\x232A' -> 2 501 | | c >= '\x232B' && c <= '\x2E31' -> 1 502 | | c >= '\x2E80' && c <= '\x303E' -> 2 503 | | c == '\x303F' -> 1 504 | | c >= '\x3041' && c <= '\x3247' -> 2 505 | -- Ambiguous 506 | | c >= '\x3248' && c <= '\x324F' -> 1 507 | | c >= '\x3250' && c <= '\x4DBF' -> 2 508 | | c >= '\x4DC0' && c <= '\x4DFF' -> 1 509 | | c >= '\x4E00' && c <= '\xA4C6' -> 2 510 | | c >= '\xA4D0' && c <= '\xA95F' -> 1 511 | | c >= '\xA960' && c <= '\xA97C' -> 2 512 | | c >= '\xA980' && c <= '\xABF9' -> 1 513 | | c >= '\xAC00' && c <= '\xD7FB' -> 2 514 | | c >= '\xD800' && c <= '\xDFFF' -> 1 515 | -- Ambiguous 516 | | c >= '\xE000' && c <= '\xF8FF' -> 1 517 | | c >= '\xF900' && c <= '\xFAFF' -> 2 518 | | c >= '\xFB00' && c <= '\xFDFD' -> 1 519 | -- Ambiguous 520 | | c >= '\xFE00' && c <= '\xFE0F' -> 1 521 | | c >= '\xFE10' && c <= '\xFE19' -> 2 522 | | c >= '\xFE20' && c <= '\xFE26' -> 1 523 | | c >= '\xFE30' && c <= '\xFE6B' -> 2 524 | | c >= '\xFE70' && c <= '\xFEFF' -> 1 525 | | c >= '\xFF01' && c <= '\xFF60' -> 2 526 | | c >= '\xFF61' && c <= '\x16A38' -> 1 527 | | c >= '\x1B000' && c <= '\x1B001' -> 2 528 | | c >= '\x1D000' && c <= '\x1F1FF' -> 1 529 | | c >= '\x1F200' && c <= '\x1F251' -> 2 530 | | c >= '\x1F300' && c <= '\x1F773' -> 1 531 | | c >= '\x20000' && c <= '\x3FFFD' -> 2 532 | | otherwise -> 1 533 | #endif 534 | -------------------------------------------------------------------------------- /src/Errata/Source.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | {- | 5 | Module : Errata.Source 6 | Copyright : (c) 2020- comp 7 | License : MIT 8 | Maintainer : onecomputer00@gmail.com 9 | Stability : stable 10 | Portability : portable 11 | 12 | A class for source text types. You should not need to use this, except to add new source types. 13 | -} 14 | module Errata.Source 15 | ( Source (..) 16 | ) where 17 | 18 | import qualified Data.Text as T 19 | import qualified Data.Text.Lazy as TL 20 | 21 | {- | A class for manipulating and converting source text. 22 | 23 | For @ByteString@ source types, you should convert it to one of the built-in instances with your encoding of choice. 24 | -} 25 | class Source s where 26 | -- | The empty source, used when a pointer references an out-of-bounds line. 27 | emptySource :: s 28 | 29 | -- | Splits the source into lines. 30 | sourceToLines :: s -> [s] 31 | 32 | -- | Converts the source text to 'Data.Text.Text' (strict). The given source text is a single line of the source. 33 | sourceToText :: s -> T.Text 34 | 35 | instance Source String where 36 | emptySource = "" 37 | sourceToLines = lines 38 | sourceToText = T.pack 39 | 40 | instance Source T.Text where 41 | emptySource = "" 42 | sourceToLines = T.lines 43 | sourceToText = id 44 | 45 | instance Source TL.Text where 46 | emptySource = "" 47 | sourceToLines = TL.lines 48 | sourceToText = TL.toStrict 49 | -------------------------------------------------------------------------------- /src/Errata/Styles.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | {- | 4 | Module : Errata.Styles 5 | Copyright : (c) 2020- comp 6 | License : MIT 7 | Maintainer : onecomputer00@gmail.com 8 | Stability : stable 9 | Portability : portable 10 | 11 | Premade styles for blocks and pointers. 12 | -} 13 | module Errata.Styles 14 | ( basicStyle 15 | , basicPointer 16 | , fancyStyle 17 | , fancyPointer 18 | , fancyRedStyle 19 | , fancyRedPointer 20 | , fancyYellowStyle 21 | , fancyYellowPointer 22 | , highlight 23 | ) where 24 | 25 | import Data.Bifunctor (bimap, second) 26 | import qualified Data.Text as T 27 | import Errata.Types 28 | 29 | {- | A basic style using only ASCII characters. 30 | 31 | Errors should look like so (with 'basicPointer'): 32 | 33 | > error header message 34 | > --> file.ext:1:16 35 | > block header message 36 | > | 37 | > 1 | line 1 foo bar do 38 | > | ________________^^ start label 39 | > 2 | | line 2 40 | > | | ^ unconnected label 41 | > 3 | | line 3 42 | > | |______^ middle label 43 | > 4 | | line 4 44 | > 5 | | line 5 45 | > . | | 46 | > 7 | | line 7 47 | > 8 | | line 8 baz end 48 | > | |______^_____^^^ end label 49 | > | | 50 | > | | inner label 51 | > block body message 52 | > error body message 53 | -} 54 | basicStyle :: Style 55 | basicStyle = Style 56 | { styleLocation = \(fp, l, c) -> T.concat ["--> ", T.pack fp, ":", T.pack $ show l, ":", T.pack $ show c] 57 | , styleNumber = T.pack . show 58 | , styleLine = highlight 59 | , styleEllipsis = "." 60 | , styleLinePrefix = "|" 61 | , styleVertical = "|" 62 | , styleHorizontal = "_" 63 | , styleDownRight = " " 64 | , styleUpRight = "|" 65 | , styleUpDownRight = "|" 66 | , styleTabWidth = 4 67 | , styleExtraLinesAfter = 2 68 | , styleExtraLinesBefore = 1 69 | , stylePaddingTop = True 70 | , stylePaddingBottom = False 71 | , styleEnableDecorations = True 72 | , styleEnableLinePrefix = True 73 | } 74 | 75 | -- | Pointers using only ASCII characters. 76 | basicPointer :: PointerStyle 77 | basicPointer = PointerStyle 78 | { styleHighlight = id 79 | , styleUnderline = "^" 80 | , styleHook = "|" 81 | , styleConnector = "|" 82 | , styleEnableHook = True 83 | } 84 | 85 | {- | A fancy style using Unicode characters. 86 | 87 | Errors should look like so (with 'fancyPointer'): 88 | 89 | > error header message 90 | > → file.ext:1:16 91 | > block header message 92 | > │ 93 | > 1 │ line 1 foo bar do 94 | > │ ┌────────────────^^ start label 95 | > 2 │ │ line 2 96 | > │ │ ^ unconnected label 97 | > 3 │ │ line 3 98 | > │ ├──────^ middle label 99 | > 4 │ │ line 4 100 | > 5 │ │ line 5 101 | > . │ │ 102 | > 7 │ │ line 7 103 | > 8 │ │ line 8 baz end 104 | > │ └──────^─────^^^ end label 105 | > │ │ 106 | > │ └ inner label 107 | -} 108 | fancyStyle :: Style 109 | fancyStyle = Style 110 | { styleLocation = \(fp, l, c) -> T.concat 111 | [ "→ ", T.pack fp, ":", T.pack $ show l, ":", T.pack $ show c 112 | ] 113 | , styleNumber = T.pack . show 114 | , styleLine = highlight 115 | , styleEllipsis = "." 116 | , styleLinePrefix = "│" 117 | , styleHorizontal = "─" 118 | , styleVertical = "│" 119 | , styleDownRight = "┌" 120 | , styleUpDownRight = "├" 121 | , styleUpRight = "└" 122 | , styleTabWidth = 4 123 | , styleExtraLinesAfter = 2 124 | , styleExtraLinesBefore = 1 125 | , stylePaddingTop = True 126 | , stylePaddingBottom = False 127 | , styleEnableDecorations = True 128 | , styleEnableLinePrefix = True 129 | } 130 | 131 | -- | Pointers using Unicode characters and ANSI colors. 132 | fancyPointer :: PointerStyle 133 | fancyPointer = PointerStyle 134 | { styleHighlight = id 135 | , styleUnderline = "^" 136 | , styleHook = "└" 137 | , styleConnector = "│" 138 | , styleEnableHook = True 139 | } 140 | 141 | -- | A fancy style using Unicode characters and ANSI colors, similar to 'fancyStyle'. Most things are colored red. 142 | fancyRedStyle :: Style 143 | fancyRedStyle = Style 144 | { styleLocation = \(fp, l, c) -> T.concat 145 | [ "\x1b[34m→\x1b[0m ", T.pack fp, ":", T.pack $ show l, ":", T.pack $ show c 146 | ] 147 | , styleNumber = T.pack . show 148 | , styleLine = highlight 149 | , styleEllipsis = "." 150 | , styleLinePrefix = "\x1b[34m│\x1b[0m" 151 | , styleHorizontal = "\x1b[31m─\x1b[0m" 152 | , styleVertical = "\x1b[31m│\x1b[0m" 153 | , styleDownRight = "\x1b[31m┌\x1b[0m" 154 | , styleUpDownRight = "\x1b[31m├\x1b[0m" 155 | , styleUpRight = "\x1b[31m└\x1b[0m" 156 | , styleTabWidth = 4 157 | , styleExtraLinesAfter = 2 158 | , styleExtraLinesBefore = 1 159 | , stylePaddingTop = True 160 | , stylePaddingBottom = False 161 | , styleEnableDecorations = True 162 | , styleEnableLinePrefix = True 163 | } 164 | 165 | -- | Red pointers using Unicode characters and ANSI colors. 166 | fancyRedPointer :: PointerStyle 167 | fancyRedPointer = PointerStyle 168 | { styleHighlight = \x -> "\x1b[31m" <> x <> "\x1b[0m" 169 | , styleUnderline = "\x1b[31m^\x1b[0m" 170 | , styleHook = "\x1b[31m└\x1b[0m" 171 | , styleConnector = "\x1b[31m│\x1b[0m" 172 | , styleEnableHook = True 173 | } 174 | 175 | -- | A fancy style using Unicode characters and ANSI colors, similar to 'fancyStyle'. Most things are colored yellow. 176 | fancyYellowStyle :: Style 177 | fancyYellowStyle = Style 178 | { styleLocation = \(fp, l, c) -> T.concat 179 | [ "\x1b[34m→\x1b[0m ", T.pack fp, ":", T.pack $ show l, ":", T.pack $ show c 180 | ] 181 | , styleNumber = T.pack . show 182 | , styleLine = highlight 183 | , styleEllipsis = "." 184 | , styleLinePrefix = "\x1b[34m│\x1b[0m" 185 | , styleHorizontal = "\x1b[33m─\x1b[0m" 186 | , styleVertical = "\x1b[33m│\x1b[0m" 187 | , styleDownRight = "\x1b[33m┌\x1b[0m" 188 | , styleUpRight = "\x1b[33m└\x1b[0m" 189 | , styleUpDownRight = "\x1b[33m├\x1b[0m" 190 | , styleTabWidth = 4 191 | , styleExtraLinesAfter = 2 192 | , styleExtraLinesBefore = 1 193 | , stylePaddingTop = True 194 | , stylePaddingBottom = False 195 | , styleEnableDecorations = True 196 | , styleEnableLinePrefix = True 197 | } 198 | 199 | -- | Yellow pointers using Unicode characters and ANSI colors. 200 | fancyYellowPointer :: PointerStyle 201 | fancyYellowPointer = PointerStyle 202 | { styleHighlight = \x -> "\x1b[33m" <> x <> "\x1b[0m" 203 | , styleUnderline = "\x1b[33m^\x1b[0m" 204 | , styleHook = "\x1b[33m└\x1b[0m" 205 | , styleConnector = "\x1b[33m│\x1b[0m" 206 | , styleEnableHook = True 207 | } 208 | 209 | -- | Adds highlighting to spans of text by modifying it with the given styles' highlights. 210 | highlight 211 | :: [(PointerStyle, (Column, Column))] -- ^ Styles and columns to work on. These are sorted, starting at 1. They must not overlap. 212 | -> T.Text -- ^ Text to highlight. 213 | -> T.Text 214 | highlight [] xs = xs 215 | highlight ((p, (s, e)):ps) xs = 216 | let (pre, xs') = T.splitAt (s - 1) xs 217 | (txt, xs'') = T.splitAt (e - s) xs' 218 | hi = styleHighlight p 219 | ps' = second (both (\i -> i - e + 1)) <$> ps 220 | in pre <> hi txt <> highlight ps' xs'' 221 | where 222 | both f = bimap f f 223 | -------------------------------------------------------------------------------- /src/Errata/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | {- | 5 | Module : Errata.Types 6 | Copyright : (c) 2020- comp 7 | License : MIT 8 | Maintainer : onecomputer00@gmail.com 9 | Stability : stable 10 | Portability : portable 11 | 12 | Type definitions. Most of these are re-exported in "Errata", so you should not need to import this module, unless you 13 | need some of the helper functions for making new functionality on top of Errata. 14 | -} 15 | module Errata.Types 16 | ( -- * Type synonyms 17 | Line 18 | , Column 19 | , Header 20 | , Body 21 | , Label 22 | -- * Error format data 23 | , Errata (..) 24 | -- * Blocks and pointers 25 | , Block (..) 26 | , Pointer (..) 27 | , pointerColumns 28 | , pointerData 29 | -- * Styling options 30 | , Style (..) 31 | , PointerStyle (..) 32 | ) where 33 | 34 | import qualified Data.Text as T 35 | 36 | -- | Line number, starts at 1, increments every new line character. 37 | type Line = Int 38 | 39 | -- | Column number, starts at 1, increments every 'Char'. 40 | type Column = Int 41 | 42 | -- | Header text. Generally goes above things. 43 | type Header = T.Text 44 | 45 | -- | Body text. Generally goes below things. 46 | type Body = T.Text 47 | 48 | -- | Label text. Generally goes inline with things. 49 | type Label = T.Text 50 | 51 | -- | A collection of information for pretty printing an error. 52 | data Errata = Errata 53 | { errataHeader :: Maybe Header 54 | -- ^ The message that appears above all the blocks. 55 | , errataBlocks :: [Block] 56 | -- ^ Blocks in the source code to display. 57 | , errataBody :: Maybe Body 58 | -- ^ The message that appears below all the blocks. 59 | } 60 | deriving (Show) 61 | 62 | {- | Information about a block in the source code, such as pointers and messages. 63 | 64 | Each block has a style associated with it. 65 | -} 66 | data Block = Block 67 | { blockStyle :: Style 68 | -- ^ The style of the block. 69 | , blockLocation :: (FilePath, Line, Column) 70 | {- ^ The filepath, line, and column of the block. These start at 1. 71 | 72 | This is used to create the text that details the location. 73 | -} 74 | , blockHeader :: Maybe Header 75 | {- ^ The header message for the block. 76 | 77 | This will appear below the location and above the source lines. 78 | -} 79 | , blockPointers :: [Pointer] 80 | {- ^ The block's pointers. These are used to "point out" parts of the source code in this block. 81 | 82 | The locations of each of these pointers must be non-overlapping. If the pointers are touching at a boundary 83 | however, that is allowed. 84 | -} 85 | , blockBody :: Maybe Body 86 | {- ^ The body message for the block. 87 | 88 | This will appear below the source lines. 89 | -} 90 | } 91 | deriving (Show) 92 | 93 | {- | A pointer is the span of the source code at a line, from one column to another. Each of the positions start at 1. 94 | 95 | A pointer may also have a label that will display inline. 96 | 97 | A pointer may also be connected to all the other pointers within the same block. 98 | -} 99 | data Pointer = Pointer 100 | { pointerLine :: Line 101 | -- ^ The line of the pointer. 102 | , pointerColStart :: Column 103 | -- ^ The starting column of the pointer. 104 | , pointerColEnd :: Column 105 | -- ^ The ending column of the pointer. 106 | , pointerConnect :: Bool 107 | -- ^ Whether this pointer connects with other pointers. 108 | , pointerLabel :: Maybe Label 109 | -- ^ An optional label for the pointer. 110 | , pointerStyle :: PointerStyle 111 | -- ^ A style for this pointer. 112 | } 113 | deriving (Show) 114 | 115 | -- | Gets the column span for a 'Pointer'. 116 | pointerColumns :: Pointer -> (Column, Column) 117 | pointerColumns (Pointer {..}) = (pointerColStart, pointerColEnd) 118 | 119 | -- | Gets physical information about a pointer. 120 | pointerData :: Pointer -> (Line, Column, Column, Bool, Maybe Label) 121 | pointerData (Pointer {..}) = (pointerLine, pointerColStart, pointerColEnd, pointerConnect, pointerLabel) 122 | 123 | -- | Stylization options for a block, e.g. characters to use. 124 | data Style = Style 125 | { styleLocation :: (FilePath, Line, Column) -> T.Text 126 | {- ^ Shows the location of a block at a file, line, and column. 127 | 128 | This is put on its own line just above the source lines. 129 | -} 130 | , styleNumber :: Line -> T.Text 131 | {- ^ Shows the line number /n/ for a source line. 132 | 133 | The result should visually be the same length as just @show n@. 134 | -} 135 | , styleLine :: [(PointerStyle, (Column, Column))] -> T.Text -> T.Text 136 | {- ^ Stylize a source line. 137 | 138 | The style and the column span (sorted, starting at 1) of the text that is being underlined are given for 139 | highlighting purposes (see 'Errata.Styles.highlight'). 140 | They can be ignored for source code highlighting instead, for example. 141 | The result of this should visually take up the same space as the original line. 142 | -} 143 | , styleEllipsis :: T.Text 144 | {- ^ The text to use as an ellipsis in the position of line numbers for when lines are omitted. 145 | 146 | This should visually be one character. 147 | -} 148 | , styleLinePrefix :: T.Text 149 | {- ^ The prefix before the source lines. 150 | 151 | Before it may be the line number, and after it the source line. 152 | -} 153 | , styleVertical :: T.Text 154 | {- ^ The text to use as a vertical bar when connecting pointers. 155 | 156 | This should visually be one character. 157 | -} 158 | , styleHorizontal :: T.Text 159 | {- ^ The text to use as a horizontal bar when connecting pointers. 160 | 161 | This should visually be one character. 162 | -} 163 | , styleDownRight :: T.Text 164 | {- ^ The text to use as a connector downwards and rightwards when connecting pointers. 165 | 166 | This should visually be one character. 167 | -} 168 | , styleUpRight :: T.Text 169 | {- ^ The text to use as a connector upwards and rightwards when connecting pointers. 170 | 171 | This should visually be one character. 172 | -} 173 | , styleUpDownRight :: T.Text 174 | {- ^ The text to use as a connector upwards, downwards, and rightwards when connecting pointers. 175 | 176 | This should visually be one character. 177 | -} 178 | , styleTabWidth :: Int 179 | {- ^ The number of spaces a tab character is equivalent to. 180 | 181 | Your source will have tabs replaced with this many spaces. 182 | -} 183 | , styleExtraLinesAfter :: Int 184 | -- ^ Maximum number of extra lines that can be added after the first line when skipping lines between two lines. 185 | , styleExtraLinesBefore :: Int 186 | -- ^ Maximum number of extra lines that can be added before the second line when skipping lines between two lines. 187 | , stylePaddingTop :: Bool 188 | -- ^ Whether to add a padding line before the first source line. 189 | , stylePaddingBottom :: Bool 190 | -- ^ Whether to add a padding line after the last source line. 191 | , styleEnableDecorations :: Bool 192 | {- ^ Whether to enable decorations at all in this block. 193 | 194 | This includes the pointer connectors (as in 'Style') and the underlines, connectors, and labels 195 | (as in 'PointerStyle'). However, highlighting will still be applied. 196 | -} 197 | , styleEnableLinePrefix :: Bool 198 | -- ^ Whether to enable the line prefix. 199 | } 200 | 201 | instance Show Style where 202 | show (Style {..}) = concat 203 | [ "Style {" 204 | , "styleLocation = ", show $ styleLocation ("file", 1, 1) 205 | , ", styleNumber = ", show $ styleNumber 3 206 | , ", styleLine = ", show $ styleLine [(basicPointer, (1, 5))] "text" 207 | , ", styleEllipsis = ", show styleEllipsis 208 | , ", styleLinePrefix = ", show styleLinePrefix 209 | , ", styleVertical = ", show styleVertical 210 | , ", styleHorizontal = ", show styleHorizontal 211 | , ", styleDownRight = ", show styleDownRight 212 | , ", styleUpRight = ", show styleUpRight 213 | , ", styleUpDownRight = ", show styleUpDownRight 214 | , ", styleTabWidth = ", show styleTabWidth 215 | , ", styleExtraLinesAfter = ", show styleExtraLinesAfter 216 | , ", styleExtraLinesBefore = ", show styleExtraLinesBefore 217 | , ", stylePaddingTop = ", show stylePaddingTop 218 | , ", stylePaddingBottom = ", show stylePaddingBottom 219 | , ", styleEnableDecorations = ", show styleEnableDecorations 220 | , ", styleEnableLinePrefix = ", show styleEnableLinePrefix 221 | , "}" 222 | ] 223 | where 224 | basicPointer = PointerStyle 225 | { styleHighlight = id 226 | , styleUnderline = "^" 227 | , styleHook = "|" 228 | , styleConnector = "|" 229 | , styleEnableHook = True 230 | } 231 | 232 | -- | Stylization options for an individual pointer, e.g. characters to use. 233 | data PointerStyle = PointerStyle 234 | { styleHighlight :: T.Text -> T.Text 235 | {- ^ Stylize the text that this pointer is underlining. 236 | 237 | This is only used if 'styleLine' uses the given pointer styles, for example with 'Errata.Styles.highlight'. 238 | The result of this should visually take up the same space as the original text. 239 | -} 240 | , styleUnderline :: T.Text 241 | {- ^ The text to underline a character in a pointer. 242 | 243 | This should visually be one character. 244 | -} 245 | , styleHook :: T.Text 246 | {- ^ The text to use as a connector upwards and hooking to the right for the label of a pointer that drops down. 247 | 248 | This probably looks best as one character. 249 | -} 250 | , styleConnector :: T.Text 251 | {- ^ The text to use as a vertical bar when connecting a pointer that drops down to its label. 252 | 253 | This should visually be one character. 254 | -} 255 | , styleEnableHook :: Bool 256 | -- ^ Whether to use the hook for labels that drop down, or simply start the label directly under the connector. 257 | } 258 | 259 | instance Show PointerStyle where 260 | show (PointerStyle {..}) = concat 261 | [ "PointerStyle {" 262 | , "styleHighlight = ", show $ styleHighlight "text" 263 | , ", styleUnderline = ", show styleUnderline 264 | , ", styleHook = ", show styleHook 265 | , ", styleConnector = ", show styleConnector 266 | , ", styleEnableHook = ", show styleEnableHook 267 | , "}" 268 | ] 269 | -------------------------------------------------------------------------------- /test/.golden/T000/golden: -------------------------------------------------------------------------------- 1 | error 2 | --> simple:1:1 3 | | 4 | 1 | hello world 5 | | ^^^^^ -------------------------------------------------------------------------------- /test/.golden/T001/golden: -------------------------------------------------------------------------------- 1 | error[E001]: mismatching types in `if` expression 2 | --> file.hs:3:10 3 | | 4 | 2 | then 100 5 | | ^^^ this has type `Int` 6 | 3 | else "uh oh" 7 | | ^^^^^^^ but this has type `String` 8 | 9 | --> file.hs:1:7 10 | | 11 | 1 | foo = if 1 > 2 12 | | _______^^ 13 | 2 | | then 100 14 | | |_____^^^^ 15 | 3 | | else "uh oh" 16 | | |_____^^^^ in this `if` expression 17 | 18 | note: use --explain E001 to learn more -------------------------------------------------------------------------------- /test/.golden/T002/golden: -------------------------------------------------------------------------------- 1 | ─────── NAME UNKNOWN ─────── 2 | 3 | The name fold was not found. 4 | 5 | --> file.hs:1:10 6 | | 7 | 1 | sum xs = fold (+) 0 xs 8 | | ^^^^ 9 | 10 | Did you mean to use one of these? 11 | 12 | foldl 13 | foldr -------------------------------------------------------------------------------- /test/.golden/T003/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | abcdefghijk 5 | | ^^ label 6 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T004/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | abcdefghijk 5 | | ^^ ^^ ^^ z 6 | | | | 7 | | | | y 8 | | | x 9 | 2 | lmnopqrstuv 10 | | ^^^ w 11 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T005/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | abcdefghijk 5 | | __^^__^^__^^ z 6 | | | | | 7 | | | | | y 8 | | | | x 9 | 2 | | lmnopqrstuv 10 | | |_____^^^ w 11 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T006/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | abcdefghijk 5 | | ^^__^^__^^ z 6 | | | | 7 | | | | y 8 | | | x 9 | 2 | lmnopqrstuv 10 | | ^^^ w 11 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T007/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | abcdefghijk 5 | | __^^__^^ ^^ z 6 | | | | 7 | | | | x 8 | 2 | | lmnopqrstuv 9 | | | ^^^ w 10 | 3 | | wxyzfoobar 11 | | |_^^ v 12 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T008/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T009/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 4 | 5 | | ^ empty 6 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T010/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | abcdefghijk 5 | | empty 6 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T011/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | abcdefghijk 5 | | ^ empty 6 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T012/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | abcdefghijk 5 | | _^_^ ^ ^ ^ z 6 | | | | | | | 7 | | | | | | | z 8 | | | | | | z 9 | | | | | y 10 | | | | x 11 | 2 | | lmnopqrstuv 12 | | | ^^^ w 13 | 3 | | wxyzfoobar 14 | | |_^^ v 15 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T013/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | abcdefghijk 5 | | _^_^___^_^ z 6 | | | | | 7 | | | | | y 8 | | | | x 9 | 2 | | lmnopqrstuv 10 | | | ^^^ w 11 | 3 | | wxyzfoobar 12 | | |_^^ v 13 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T014/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | abcdefghijk 5 | | _^^^__^^^ x 6 | | | | 7 | | | | x 8 | 2 | | lmnopqrstuv 9 | 3 | | wxyzfoobar 10 | | |_^^__^^ y 11 | | | 12 | | | y 13 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T015/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | abcdefghijk 5 | | ^^ ^ ^^ x 6 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T016/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | abcdefghijk 5 | | ^^__^_^^ x 6 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T017/golden: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/1Computer1/errata/f8f9530c73b635233b3dfa4ae3fe46740489da86/test/.golden/T017/golden -------------------------------------------------------------------------------- /test/.golden/T018/golden: -------------------------------------------------------------------------------- 1 | header 2 | body -------------------------------------------------------------------------------- /test/.golden/T019/golden: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/1Computer1/errata/f8f9530c73b635233b3dfa4ae3fe46740489da86/test/.golden/T019/golden -------------------------------------------------------------------------------- /test/.golden/T020/golden: -------------------------------------------------------------------------------- 1 | header 2 | --> here:1:1 3 | block header 4 | block body 5 | body -------------------------------------------------------------------------------- /test/.golden/T021/golden: -------------------------------------------------------------------------------- 1 | --> here:1:1 2 | block header 3 | block body -------------------------------------------------------------------------------- /test/.golden/T022/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 2 | bar 5 | | ^ 6 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T023/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | こんにちは、日本語です 5 | | ^^^^^^^^^^ 6 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T024/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | jalapeño poppers 5 | | ^^ ^ ^^ 6 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T025/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | bar .foo 5 | | ^^^^^^^^^^^^^^^^^^^ 6 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T026/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | l1 5 | | ^^ 6 | 2 | l2 7 | 3 | l3 8 | . | 9 | 6 | l6 10 | 7 | l7 11 | | ^^ 12 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T027/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | l1 5 | | _^^ 6 | 2 | | l2 7 | 3 | | l3 8 | . | | 9 | 6 | | l6 10 | 7 | | l7 11 | | |_^^ 12 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T028/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | l1 5 | | _^^ label 6 | 2 | | l2 7 | 3 | | l3 8 | . | | 9 | 6 | | l6 10 | 7 | | l7 11 | | |_^^ 12 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T029/golden: -------------------------------------------------------------------------------- 1 | error header message 2 | --> file.ext:1:16 3 | block header message 4 | | 5 | 1 | line 1 foo bar do 6 | | ________________^^ start label 7 | 2 | | line 2 8 | | | ^ unconnected label 9 | 3 | | line 3 10 | | |______^ middle label 11 | 4 | | line 4 12 | 5 | | line 5 13 | . | | 14 | 7 | | line 7 15 | 8 | | line 8 baz end 16 | | |______^_____^^^ end label 17 | | | 18 | | | inner label 19 | block body message 20 | error body message -------------------------------------------------------------------------------- /test/.golden/T030/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | abcdefghijk 5 | | .. ~~ ^^ z 6 | | | : 7 | | | 2 y 8 | | 1 x 9 | 2 | lmnopqrstuv 10 | | ''' w 11 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T031/golden: -------------------------------------------------------------------------------- 1 | an error 2 | --> here:1:1 3 | | 4 | 1 | abcdefghijk 5 | | ^^ ^^ ^^ z 6 | | | | 7 | | | y 8 | | x 9 | an error occurred here -------------------------------------------------------------------------------- /test/.golden/T032/golden: -------------------------------------------------------------------------------- 1 | error header message 2 | --> file.ext:1:16 3 | block header message 4 | | 5 | 1 | line 1 foo bar do 6 | | ________________^^ start label 7 | 2 | | line 2 8 | | | ^ unconnected label 9 | 3 | | line 3 10 | | |______^ middle label 11 | . | | 12 | 8 | | line 8 baz end 13 | | |______^_____^^^ end label 14 | | | 15 | | | inner label 16 | block body message 17 | error body message -------------------------------------------------------------------------------- /test/.golden/T033/golden: -------------------------------------------------------------------------------- 1 | error header message 2 | --> file.ext:1:16 3 | block header message 4 | | 5 | 1 | line 1 foo bar do 6 | | ________________^^ start label 7 | 2 | | line 2 8 | | | ^ unconnected label 9 | 3 | | line 3 10 | | |______^ middle label 11 | 4 | | line 4 12 | 5 | | line 5 13 | 6 | | line 6 14 | 7 | | line 7 15 | 8 | | line 8 baz end 16 | | |______^_____^^^ end label 17 | | | 18 | | | inner label 19 | block body message 20 | error body message -------------------------------------------------------------------------------- /test/.golden/T034/golden: -------------------------------------------------------------------------------- 1 | error header message 2 | --> file.ext:1:16 3 | block header message 4 | | 5 | 1 | line 1 foo bar do 6 | | ________________^^ start label 7 | 2 | | line 2 8 | | | ^ unconnected label 9 | 3 | | line 3 10 | | |______^ middle label 11 | 4 | | line 4 12 | . | | 13 | 6 | | line 6 14 | 7 | | line 7 15 | 8 | | line 8 baz end 16 | | |______^_____^^^ end label 17 | | | 18 | | | inner label 19 | block body message 20 | error body message -------------------------------------------------------------------------------- /test/.golden/T035/golden: -------------------------------------------------------------------------------- 1 | error header message 2 | --> file.ext:1:16 3 | block header message 4 | | 5 | 1 | line 1 foo bar do 6 | | ________________^^ start label 7 | 2 | | line 2 8 | | | ^ unconnected label 9 | 3 | | line 3 10 | | |______^ middle label 11 | 4 | | line 4 12 | . | | 13 | 7 | | line 7 14 | 8 | | line 8 baz end 15 | | |______^_____^^^ end label 16 | | | 17 | | | inner label 18 | block body message 19 | error body message -------------------------------------------------------------------------------- /test/.golden/T036/golden: -------------------------------------------------------------------------------- 1 | error 2 | --> simple:1:1 3 | 1 | hello world 4 | | ^^^^^ -------------------------------------------------------------------------------- /test/.golden/T037/golden: -------------------------------------------------------------------------------- 1 | error 2 | --> simple:1:1 3 | | 4 | 1 | hello world 5 | | ^^^^^ 6 | | -------------------------------------------------------------------------------- /test/.golden/T038/golden: -------------------------------------------------------------------------------- 1 | error 2 | --> simple:1:1 3 | 1 | hello world -------------------------------------------------------------------------------- /test/.golden/T039/golden: -------------------------------------------------------------------------------- 1 | error header message 2 | --> file.ext:1:16 3 | block header message 4 | 1 | line 1 foo bar do 5 | 2 | line 2 6 | 3 | line 3 7 | 4 | line 4 8 | 5 | line 5 9 | . | 10 | 7 | line 7 11 | 8 | line 8 baz end 12 | block body message 13 | error body message -------------------------------------------------------------------------------- /test/.golden/T040/golden: -------------------------------------------------------------------------------- 1 | ─────── NAME UNKNOWN ─────── 2 | 3 | The name fold was not found. 4 | 5 | --> file.hs:1:10 6 | 1 | sum xs = fold (+) 0 xs 7 | 8 | Did you mean to use one of these? 9 | 10 | foldl 11 | foldr -------------------------------------------------------------------------------- /test/.golden/T041/golden: -------------------------------------------------------------------------------- 1 | error 2 | --> simple:1:1 3 | 4 | hello world 5 | ^^^^^ ignored -------------------------------------------------------------------------------- /test/.golden/T042/golden: -------------------------------------------------------------------------------- 1 | error header message 2 | --> file.ext:1:16 3 | block header message 4 | 5 | line 1 foo bar do 6 | ________________^^ start label 7 | | line 2 8 | | ^ unconnected label 9 | | line 3 10 | |______^ middle label 11 | | line 4 12 | | line 5 13 | | 14 | | line 7 15 | | line 8 baz end 16 | |______^_____^^^ end label 17 | | 18 | | inner label 19 | block body message 20 | error body message -------------------------------------------------------------------------------- /test/.golden/T043/golden: -------------------------------------------------------------------------------- 1 | ─────── NAME UNKNOWN ─────── 2 | 3 | The name fold was not found. 4 | 5 | --> file.hs:1:10 6 | 7 | sum xs = fold (+) 0 xs 8 | ^^^^ 9 | 10 | Did you mean to use one of these? 11 | 12 | foldl 13 | foldr -------------------------------------------------------------------------------- /test/Errata/StylesSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Errata.StylesSpec 4 | ( spec 5 | ) where 6 | 7 | import Errata.Styles 8 | import Errata.Types 9 | import Test.Hspec 10 | 11 | spec :: Spec 12 | spec = do 13 | describe "highlight" $ do 14 | it "brackets parts of text" $ 15 | highlight [(bracketPointer, (2, 4)), (bracketPointer, (6, 7))] "12345678" `shouldBe` "1(23)45(6)78" 16 | 17 | it "brackets empty column spans" $ 18 | highlight [(bracketPointer, (1, 1))] "1234" `shouldBe` "()1234" 19 | 20 | it "does nothing with no columns" $ 21 | highlight [] "123" `shouldBe` "123" 22 | 23 | it "puts text for out of bounds columns at the end" $ 24 | highlight [(bracketPointer, (3, 5)), (bracketPointer, (6, 7))] "1234" `shouldBe` "12(34)()" 25 | 26 | bracketPointer :: PointerStyle 27 | bracketPointer = basicPointer { styleHighlight = \x -> "(" <> x <> ")" } 28 | -------------------------------------------------------------------------------- /test/Errata/TypesSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Errata.TypesSpec 4 | ( spec 5 | ) where 6 | 7 | import Errata.Styles 8 | import Errata.Types 9 | import Test.Hspec 10 | 11 | spec :: Spec 12 | spec = do 13 | describe "pointerColumns" $ do 14 | it "gets the columns" $ 15 | pointerColumns (Pointer 1 2 3 False Nothing basicPointer) `shouldBe` (2, 3) 16 | -------------------------------------------------------------------------------- /test/ErrataSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module ErrataSpec 4 | ( spec 5 | ) where 6 | 7 | import qualified Data.Text as T 8 | import qualified Data.Text.IO as T 9 | import qualified Data.Text.Lazy as TL 10 | import Errata 11 | import Errata.Styles 12 | import Errata.Types 13 | import Test.Hspec 14 | import Test.Hspec.Golden (Golden(..)) 15 | 16 | spec :: Spec 17 | spec = do 18 | describe "blockMerged" $ do 19 | it "merges pointers on the same line" $ 20 | let b = blockMerged basicStyle basicPointer "here" Nothing (1, 1, 2, Just "a") (1, 3, 4, Just "b") (Just "c") Nothing 21 | pointers = [Pointer 1 1 4 False (Just "c") basicPointer] 22 | in pointerData <$> blockPointers b `shouldBe` pointerData <$> pointers 23 | 24 | it "does not merge pointers on different line" $ 25 | let b = blockMerged basicStyle basicPointer "here" Nothing (1, 1, 2, Just "a") (2, 3, 4, Just "b") (Just "c") Nothing 26 | pointers = [Pointer 1 1 2 True (Just "a") basicPointer, Pointer 2 3 4 True (Just "b") basicPointer] 27 | in pointerData <$> blockPointers b `shouldBe` pointerData <$> pointers 28 | 29 | describe "prettyErrors" goldenTests 30 | 31 | goldenTests :: Spec 32 | goldenTests = do 33 | golden 34 | "T000" 35 | "hello world" 36 | [ Errata 37 | (Just "error") 38 | [ Block 39 | basicStyle 40 | ("simple", 1, 1) 41 | Nothing 42 | [Pointer 1 1 6 False Nothing basicPointer] 43 | Nothing 44 | ] 45 | Nothing 46 | ] 47 | 48 | golden 49 | "T001" 50 | "foo = if 1 > 2\n then 100\n else \"uh oh\"" 51 | [ Errata 52 | (Just "error[E001]: mismatching types in `if` expression") 53 | [ Block 54 | basicStyle 55 | ("file.hs", 3, 10) 56 | Nothing 57 | [ Pointer 2 10 13 False (Just "this has type `Int`") basicPointer 58 | , Pointer 3 10 17 False (Just "but this has type `String`") basicPointer 59 | ] 60 | Nothing 61 | , Block 62 | basicStyle 63 | ("file.hs", 1, 7) 64 | Nothing 65 | [ Pointer 1 7 9 True Nothing basicPointer 66 | , Pointer 2 5 9 True Nothing basicPointer 67 | , Pointer 3 5 9 True (Just "in this `if` expression") basicPointer 68 | ] 69 | Nothing 70 | ] 71 | (Just "\nnote: use --explain E001 to learn more") 72 | ] 73 | 74 | golden 75 | "T002" 76 | "sum xs = fold (+) 0 xs" 77 | [ Errata 78 | (Just "─────── NAME UNKNOWN ───────\n\nThe name fold was not found.\n") 79 | [ Block 80 | basicStyle 81 | ("file.hs", 1, 10) 82 | Nothing 83 | [Pointer 1 10 14 False Nothing basicPointer] 84 | Nothing 85 | ] 86 | (Just "\nDid you mean to use one of these?\n\n foldl\n foldr") 87 | ] 88 | 89 | golden 90 | "T003" 91 | "abcdefghijk\nlmnopqrstuv\nwxyzfoobar" 92 | [ adhoc 93 | [ Pointer 1 2 4 False (Just "label") basicPointer 94 | ] 95 | ] 96 | 97 | golden 98 | "T004" 99 | "abcdefghijk\nlmnopqrstuv\nwxyzfoobar" 100 | [ adhoc 101 | [ Pointer 1 2 4 False (Just "x") basicPointer 102 | , Pointer 1 6 8 False (Just "y") basicPointer 103 | , Pointer 1 10 12 False (Just "z") basicPointer 104 | , Pointer 2 5 8 False (Just "w") basicPointer 105 | ] 106 | ] 107 | 108 | golden 109 | "T005" 110 | "abcdefghijk\nlmnopqrstuv\nwxyzfoobar" 111 | [ adhoc 112 | [ Pointer 1 2 4 True (Just "x") basicPointer 113 | , Pointer 1 6 8 True (Just "y") basicPointer 114 | , Pointer 1 10 12 True (Just "z") basicPointer 115 | , Pointer 2 5 8 True (Just "w") basicPointer 116 | ] 117 | ] 118 | 119 | golden 120 | "T006" 121 | "abcdefghijk\nlmnopqrstuv\nwxyzfoobar" 122 | [ adhoc 123 | [ Pointer 1 2 4 True (Just "x") basicPointer 124 | , Pointer 1 6 8 False (Just "y") basicPointer 125 | , Pointer 1 10 12 True (Just "z") basicPointer 126 | , Pointer 2 5 8 False (Just "w") basicPointer 127 | ] 128 | ] 129 | 130 | golden 131 | "T007" 132 | "abcdefghijk\nlmnopqrstuv\nwxyzfoobar" 133 | [ adhoc 134 | [ Pointer 1 2 4 True (Just "x") basicPointer 135 | , Pointer 1 6 8 True Nothing basicPointer 136 | , Pointer 1 10 12 False (Just "z") basicPointer 137 | , Pointer 2 5 8 False (Just "w") basicPointer 138 | , Pointer 3 1 3 True (Just "v") basicPointer 139 | ] 140 | ] 141 | 142 | golden 143 | "T008" 144 | "abcdefghijk\nlmnopqrstuv\nwxyzfoobar" 145 | [ adhoc 146 | [ 147 | ] 148 | ] 149 | 150 | golden 151 | "T009" 152 | "abcdefghijk\nlmnopqrstuv\nwxyzfoobar" 153 | [ adhoc 154 | [ Pointer 4 1 2 False (Just "empty") basicPointer 155 | ] 156 | ] 157 | 158 | golden 159 | "T010" 160 | "abcdefghijk\nlmnopqrstuv\nwxyzfoobar" 161 | [ adhoc 162 | [ Pointer 1 1 1 False (Just "empty") basicPointer 163 | ] 164 | ] 165 | 166 | golden 167 | "T011" 168 | "abcdefghijk\nlmnopqrstuv\nwxyzfoobar" 169 | [ adhoc 170 | [ Pointer 1 15 16 False (Just "empty") basicPointer 171 | ] 172 | ] 173 | 174 | golden 175 | "T012" 176 | "abcdefghijk\nlmnopqrstuv\nwxyzfoobar" 177 | [ adhoc 178 | [ Pointer 1 1 2 True (Just "x") basicPointer 179 | , Pointer 1 3 4 True (Just "y") basicPointer 180 | , Pointer 1 5 6 False (Just "z") basicPointer 181 | , Pointer 1 7 8 False (Just "z") basicPointer 182 | , Pointer 1 9 10 False (Just "z") basicPointer 183 | , Pointer 2 5 8 False (Just "w") basicPointer 184 | , Pointer 3 1 3 True (Just "v") basicPointer 185 | ] 186 | ] 187 | 188 | golden 189 | "T013" 190 | "abcdefghijk\nlmnopqrstuv\nwxyzfoobar" 191 | [ adhoc 192 | [ Pointer 1 1 2 True (Just "x") basicPointer 193 | , Pointer 1 3 4 True (Just "y") basicPointer 194 | , Pointer 1 7 8 True Nothing basicPointer 195 | , Pointer 1 9 10 True (Just "z") basicPointer 196 | , Pointer 2 5 8 False (Just "w") basicPointer 197 | , Pointer 3 1 3 True (Just "v") basicPointer 198 | ] 199 | ] 200 | 201 | golden 202 | "T014" 203 | "abcdefghijk\nlmnopqrstuv\nwxyzfoobar" 204 | [ adhoc 205 | [ Pointer 1 1 4 True (Just "x") basicPointer 206 | , Pointer 1 6 9 True (Just "x") basicPointer 207 | , Pointer 3 1 3 True (Just "y") basicPointer 208 | , Pointer 3 5 7 True (Just "y") basicPointer 209 | ] 210 | ] 211 | 212 | golden 213 | "T015" 214 | "abcdefghijk\nlmnopqrstuv\nwxyzfoobar" 215 | [ adhoc 216 | [ Pointer 1 1 3 False Nothing basicPointer 217 | , Pointer 1 5 6 False Nothing basicPointer 218 | , Pointer 1 7 9 False (Just "x") basicPointer 219 | ] 220 | ] 221 | 222 | golden 223 | "T016" 224 | "abcdefghijk\nlmnopqrstuv\nwxyzfoobar" 225 | [ adhoc 226 | [ Pointer 1 1 3 True Nothing basicPointer 227 | , Pointer 1 5 6 True Nothing basicPointer 228 | , Pointer 1 7 9 True (Just "x") basicPointer 229 | ] 230 | ] 231 | 232 | golden 233 | "T017" 234 | "foo\nbar" 235 | [] 236 | 237 | golden 238 | "T018" 239 | "foo\nbar" 240 | [ Errata (Just "header") [] (Just "body") 241 | ] 242 | 243 | golden 244 | "T019" 245 | "foo\nbar" 246 | [ Errata Nothing [] Nothing 247 | ] 248 | 249 | golden 250 | "T020" 251 | "foo\nbar" 252 | [ Errata 253 | (Just "header") 254 | [ Block basicStyle ("here", 1, 1) (Just "block header") [] (Just "block body") 255 | ] 256 | (Just "body") 257 | ] 258 | 259 | golden 260 | "T021" 261 | "foo\nbar" 262 | [ Errata 263 | Nothing 264 | [ Block basicStyle ("here", 1, 1) (Just "block header") [] (Just "block body") 265 | ] 266 | Nothing 267 | ] 268 | 269 | golden 270 | "T022" 271 | "foo\n\tbar" 272 | [ adhoc 273 | [ Pointer 2 2 3 False Nothing basicPointer 274 | ] 275 | ] 276 | 277 | golden 278 | "T023" 279 | "こんにちは、日本語です" 280 | [ adhoc 281 | [ Pointer 1 1 6 False Nothing basicPointer 282 | ] 283 | ] 284 | 285 | golden 286 | "T024" 287 | "jalapeño poppers" 288 | [ adhoc 289 | [ Pointer 1 2 4 False Nothing basicPointer 290 | , Pointer 1 7 9 False Nothing basicPointer 291 | , Pointer 1 12 14 False Nothing basicPointer 292 | ] 293 | ] 294 | 295 | golden 296 | "T025" 297 | "bar\t\t\t.foo" 298 | [ adhoc 299 | [ Pointer 1 1 11 False Nothing basicPointer 300 | ] 301 | ] 302 | 303 | golden 304 | "T026" 305 | "l1\nl2\nl3\nl4\nl5\nl6\nl7\nl8" 306 | [ adhoc 307 | [ Pointer 1 1 3 False Nothing basicPointer 308 | , Pointer 7 1 3 False Nothing basicPointer 309 | ] 310 | ] 311 | 312 | golden 313 | "T027" 314 | "l1\nl2\nl3\nl4\nl5\nl6\nl7\nl8" 315 | [ adhoc 316 | [ Pointer 1 1 3 True Nothing basicPointer 317 | , Pointer 7 1 3 True Nothing basicPointer 318 | ] 319 | ] 320 | 321 | golden 322 | "T028" 323 | "l1\nl2\nl3\nl4\nl5\nl6\nl7\nl8" 324 | [ adhoc 325 | [ Pointer 1 1 3 True (Just "label") basicPointer 326 | , Pointer 7 1 3 True Nothing basicPointer 327 | ] 328 | ] 329 | 330 | golden 331 | "T029" 332 | "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end" 333 | [ Errata 334 | (Just "error header message") 335 | [ Block 336 | basicStyle 337 | ("file.ext", 1, 16) 338 | (Just "block header message") 339 | [ Pointer 1 16 18 True (Just "start label") basicPointer 340 | , Pointer 2 6 7 False (Just "unconnected label") basicPointer 341 | , Pointer 3 6 7 True (Just "middle label") basicPointer 342 | , Pointer 8 6 7 True (Just "inner label") basicPointer 343 | , Pointer 8 12 15 True (Just "end label") basicPointer 344 | ] 345 | (Just "block body message") 346 | ] 347 | (Just "error body message") 348 | ] 349 | 350 | golden 351 | "T030" 352 | "abcdefghijk\nlmnopqrstuv\nwxyzfoobar" 353 | [ adhoc 354 | [ Pointer 1 2 4 False (Just "x") (basicPointer { styleHook = "1", styleUnderline = "." }) 355 | , Pointer 1 6 8 False (Just "y") (basicPointer { styleHook = "2", styleConnector = ":", styleUnderline = "~" }) 356 | , Pointer 1 10 12 False (Just "z") (basicPointer { styleUnderline = "^" }) 357 | , Pointer 2 5 8 False (Just "w") (basicPointer { styleUnderline = "'" }) 358 | ] 359 | ] 360 | 361 | golden 362 | "T031" 363 | "abcdefghijk\nlmnopqrstuv\nwxyzfoobar" 364 | [ adhoc 365 | [ Pointer 1 2 4 False (Just "x") (basicPointer { styleEnableHook = False }) 366 | , Pointer 1 6 8 False (Just "y") (basicPointer { styleEnableHook = False }) 367 | , Pointer 1 10 12 False (Just "z") (basicPointer { styleEnableHook = False }) 368 | ] 369 | ] 370 | 371 | golden 372 | "T032" 373 | "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end" 374 | [ Errata 375 | (Just "error header message") 376 | [ Block 377 | (basicStyle { styleExtraLinesAfter = 0, styleExtraLinesBefore = 0 }) 378 | ("file.ext", 1, 16) 379 | (Just "block header message") 380 | [ Pointer 1 16 18 True (Just "start label") basicPointer 381 | , Pointer 2 6 7 False (Just "unconnected label") basicPointer 382 | , Pointer 3 6 7 True (Just "middle label") basicPointer 383 | , Pointer 8 6 7 True (Just "inner label") basicPointer 384 | , Pointer 8 12 15 True (Just "end label") basicPointer 385 | ] 386 | (Just "block body message") 387 | ] 388 | (Just "error body message") 389 | ] 390 | 391 | golden 392 | "T033" 393 | "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end" 394 | [ Errata 395 | (Just "error header message") 396 | [ Block 397 | (basicStyle { styleExtraLinesAfter = 2, styleExtraLinesBefore = 2 }) 398 | ("file.ext", 1, 16) 399 | (Just "block header message") 400 | [ Pointer 1 16 18 True (Just "start label") basicPointer 401 | , Pointer 2 6 7 False (Just "unconnected label") basicPointer 402 | , Pointer 3 6 7 True (Just "middle label") basicPointer 403 | , Pointer 8 6 7 True (Just "inner label") basicPointer 404 | , Pointer 8 12 15 True (Just "end label") basicPointer 405 | ] 406 | (Just "block body message") 407 | ] 408 | (Just "error body message") 409 | ] 410 | 411 | golden 412 | "T034" 413 | "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end" 414 | [ Errata 415 | (Just "error header message") 416 | [ Block 417 | (basicStyle { styleExtraLinesAfter = 1, styleExtraLinesBefore = 2 }) 418 | ("file.ext", 1, 16) 419 | (Just "block header message") 420 | [ Pointer 1 16 18 True (Just "start label") basicPointer 421 | , Pointer 2 6 7 False (Just "unconnected label") basicPointer 422 | , Pointer 3 6 7 True (Just "middle label") basicPointer 423 | , Pointer 8 6 7 True (Just "inner label") basicPointer 424 | , Pointer 8 12 15 True (Just "end label") basicPointer 425 | ] 426 | (Just "block body message") 427 | ] 428 | (Just "error body message") 429 | ] 430 | 431 | golden 432 | "T035" 433 | "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end" 434 | [ Errata 435 | (Just "error header message") 436 | [ Block 437 | (basicStyle { styleExtraLinesAfter = 1, styleExtraLinesBefore = 1 }) 438 | ("file.ext", 1, 16) 439 | (Just "block header message") 440 | [ Pointer 1 16 18 True (Just "start label") basicPointer 441 | , Pointer 2 6 7 False (Just "unconnected label") basicPointer 442 | , Pointer 3 6 7 True (Just "middle label") basicPointer 443 | , Pointer 8 6 7 True (Just "inner label") basicPointer 444 | , Pointer 8 12 15 True (Just "end label") basicPointer 445 | ] 446 | (Just "block body message") 447 | ] 448 | (Just "error body message") 449 | ] 450 | 451 | golden 452 | "T036" 453 | "hello world" 454 | [ Errata 455 | (Just "error") 456 | [ Block 457 | (basicStyle { stylePaddingTop = False }) 458 | ("simple", 1, 1) 459 | Nothing 460 | [Pointer 1 1 6 False Nothing basicPointer] 461 | Nothing 462 | ] 463 | Nothing 464 | ] 465 | 466 | golden 467 | "T037" 468 | "hello world" 469 | [ Errata 470 | (Just "error") 471 | [ Block 472 | (basicStyle { stylePaddingBottom = True }) 473 | ("simple", 1, 1) 474 | Nothing 475 | [Pointer 1 1 6 False Nothing basicPointer] 476 | Nothing 477 | ] 478 | Nothing 479 | ] 480 | 481 | golden 482 | "T038" 483 | "hello world" 484 | [ Errata 485 | (Just "error") 486 | [ Block 487 | (basicStyle { styleEnableDecorations = False, stylePaddingTop = False }) 488 | ("simple", 1, 1) 489 | Nothing 490 | [Pointer 1 1 6 False (Just "ignored") basicPointer] 491 | Nothing 492 | ] 493 | Nothing 494 | ] 495 | 496 | golden 497 | "T039" 498 | "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end" 499 | [ Errata 500 | (Just "error header message") 501 | [ Block 502 | (basicStyle { styleEnableDecorations = False, stylePaddingTop = False }) 503 | ("file.ext", 1, 16) 504 | (Just "block header message") 505 | [ Pointer 1 16 18 True (Just "start label") basicPointer 506 | , Pointer 2 6 7 False (Just "unconnected label") basicPointer 507 | , Pointer 3 6 7 True (Just "middle label") basicPointer 508 | , Pointer 8 6 7 True (Just "inner label") basicPointer 509 | , Pointer 8 12 15 True (Just "end label") basicPointer 510 | ] 511 | (Just "block body message") 512 | ] 513 | (Just "error body message") 514 | ] 515 | 516 | golden 517 | "T040" 518 | "sum xs = fold (+) 0 xs" 519 | [ Errata 520 | (Just "─────── NAME UNKNOWN ───────\n\nThe name fold was not found.\n") 521 | [ Block 522 | (basicStyle { styleEnableDecorations = False, stylePaddingTop = False }) 523 | ("file.hs", 1, 10) 524 | Nothing 525 | [Pointer 1 10 14 False Nothing basicPointer] 526 | Nothing 527 | ] 528 | (Just "\nDid you mean to use one of these?\n\n foldl\n foldr") 529 | ] 530 | 531 | golden 532 | "T041" 533 | "hello world" 534 | [ Errata 535 | (Just "error") 536 | [ Block 537 | (basicStyle { styleEnableLinePrefix = False }) 538 | ("simple", 1, 1) 539 | Nothing 540 | [Pointer 1 1 6 False (Just "ignored") basicPointer] 541 | Nothing 542 | ] 543 | Nothing 544 | ] 545 | 546 | golden 547 | "T042" 548 | "line 1 foo bar do\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8 baz end" 549 | [ Errata 550 | (Just "error header message") 551 | [ Block 552 | (basicStyle { styleEnableLinePrefix = False }) 553 | ("file.ext", 1, 16) 554 | (Just "block header message") 555 | [ Pointer 1 16 18 True (Just "start label") basicPointer 556 | , Pointer 2 6 7 False (Just "unconnected label") basicPointer 557 | , Pointer 3 6 7 True (Just "middle label") basicPointer 558 | , Pointer 8 6 7 True (Just "inner label") basicPointer 559 | , Pointer 8 12 15 True (Just "end label") basicPointer 560 | ] 561 | (Just "block body message") 562 | ] 563 | (Just "error body message") 564 | ] 565 | 566 | golden 567 | "T043" 568 | "sum xs = fold (+) 0 xs" 569 | [ Errata 570 | (Just "─────── NAME UNKNOWN ───────\n\nThe name fold was not found.\n") 571 | [ Block 572 | (basicStyle { styleEnableLinePrefix = False }) 573 | ("file.hs", 1, 10) 574 | Nothing 575 | [Pointer 1 10 14 False Nothing basicPointer] 576 | Nothing 577 | ] 578 | (Just "\nDid you mean to use one of these?\n\n foldl\n foldr") 579 | ] 580 | 581 | -- | Create a golden test by printing a list of 'Errata'. 582 | golden :: String -> T.Text -> [Errata] -> Spec 583 | golden name source es = it name $ Golden 584 | { output = TL.toStrict $ prettyErrors source es 585 | , encodePretty = T.unpack 586 | , writeToFile = T.writeFile 587 | , readFromFile = T.readFile 588 | , goldenFile = "./test/.golden/" <> name <> "/golden" 589 | , actualFile = Just ("./test/.golden/" <> name <> "/actual") 590 | , failFirstTime = False 591 | } 592 | 593 | -- | Usually, the meat of the work is in just printing one block. This makes an 'Errata' out of a bunch of pointers. 594 | adhoc :: [Pointer] -> Errata 595 | adhoc ps = Errata 596 | (Just "an error") 597 | [ Block 598 | basicStyle 599 | ("here", 1, 1) 600 | Nothing 601 | ps 602 | (Just "an error occurred here") 603 | ] 604 | Nothing 605 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | --------------------------------------------------------------------------------