codespan-reporting layout

diagnose-codespan-reporting/README.md

@@ -0,0 +1,5 @@
+# `codespan-reporting` layout for Diagnose
+
+This is an implementation of a custom layout for Diagnose, heavily inspired by [`codespan-reporting`](https://github.com/brendanzab/codespan).
+
+TODO: add example rendering

diagnose-codespan-reporting/design.txt

@@ -0,0 +1,38 @@
+                    ┌ outer gutter
+                    │ ┌ left border
+                    │ │ ┌ inner gutter
+                    │ │ │   ┌─────────────────────────── source ─────────────────────────────┐
+                    │ │ │   │                                                                │
+                 ┌────────────────────────────────────────────────────────────────────────────
+       header ── │ error[0001]: oh noes, a cupcake has occurred!
+snippet start ── │    ┌─ test:9:0
+snippet empty ── │    │
+ snippet line ── │  9 │   ╭ Cupcake ipsum dolor. Sit amet marshmallow topping cheesecake
+ snippet line ── │ 10 │   │ muffin. Halvah croissant candy canes bonbon candy. Apple pie jelly
+                 │    │ ╭─│─────────^
+snippet break ── │    · │ │
+ snippet line ── │ 33 │ │ │ Muffin danish chocolate soufflé pastry icing bonbon oat cake.
+ snippet line ── │ 34 │ │ │ Powder cake jujubes oat cake. Lemon drops tootsie roll marshmallow
+                 │    │ │ ╰─────────────────────────────^ blah blah
+snippet break ── │    · │
+ snippet line ── │ 38 │ │   Brownie lemon drops chocolate jelly-o candy canes. Danish marzipan
+ snippet line ── │ 39 │ │   jujubes soufflé carrot cake marshmallow tiramisu caramels candy canes.
+                 │    │ │           ^^^^^^^^^^^^^^^^^^^ -------------------- blah blah
+                 │    │ │           │
+                 │    │ │           blah blah
+                 │    │ │           note: this is a note
+ snippet line ── │ 40 │ │   Fruitcake jelly-o danish toffee. Tootsie roll pastry cheesecake
+ snippet line ── │ 41 │ │   soufflé marzipan. Chocolate bar oat cake jujubes lollipop pastry
+ snippet line ── │ 42 │ │   cupcake. Candy canes cupcake toffee gingerbread candy canes muffin
+                 │    │ │                                ^^^^^^^^^^^^^^^^^^ blah blah
+                 │    │ ╰──────────^ blah blah
+snippet break ── │    ·
+ snippet line ── │ 82 │     gingerbread toffee chupa chups chupa chups jelly-o cotton candy.
+                 │    │                 ^^^^^^                         ------- blah blah
+snippet empty ── │    │
+ snippet note ── │    = blah blah
+ snippet note ── │    = blah blah blah
+                 │      blah blah
+ snippet note ── │    = blah blah blah
+                 │      blah blah
+        empty ── │

diagnose-codespan-reporting/diagnose-codespan-reporting.cabal

@@ -0,0 +1,52 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.34.4.
+--
+-- see: https://github.com/sol/hpack
+
+name:           diagnose-codespan-reporting
+version:        1.0.0
+synopsis:       codespan-reporting-like rendering for Diagnose.
+description:    This package simply provides an codespan-reporting-like layout for diagnostic rendering.
+category:       Error Reporting
+homepage:       https://github.com/mesabloo/diagnose#readme
+bug-reports:    https://github.com/mesabloo/diagnose/issues
+author:         Ghilain Bergeron
+maintainer:     Ghilain Bergeron
+copyright:      2021-2022 Ghilain Bergeron
+license:        BSD3
+build-type:     Simple
+extra-source-files:
+    README.md
+
+source-repository head
+  type: git
+  location: https://github.com/mesabloo/diagnose
+
+library
+  exposed-modules:
+      Error.Diagnose.Layout.CodeSpanReporting
+  other-modules:
+      Data.List.Safe
+      Error.Diagnose.Layout.CodeSpanReporting.Config
+      Error.Diagnose.Layout.CodeSpanReporting.Render
+      Paths_diagnose_codespan_reporting
+  hs-source-dirs:
+      src
+  default-extensions:
+      OverloadedStrings
+      LambdaCase
+      BlockArguments
+  ghc-options: -Wall -Wextra
+  build-depends:
+      array ==0.5.*
+    , base >=4.7 && <5
+    , data-default >=0.7 && <1
+    , diagnose >=3.0.0
+    , hashable >=1.3 && <2
+    , prettyprinter >=1.7.0 && <2
+    , prettyprinter-ansi-terminal >=1.1.0 && <2
+    , text >=1.0.0.0 && <=2.0
+    , unordered-containers ==0.2.*
+    , wcwidth >=0.0.1 && <1
+  default-language: Haskell2010

diagnose-codespan-reporting/package.yaml

@@ -0,0 +1,46 @@
+name: diagnose-codespan-reporting
+version: 1.0.0
+github: "mesabloo/diagnose"
+license: BSD3
+author: "Ghilain Bergeron"
+copyright: "2021-2022 Ghilain Bergeron"
+category: "Error Reporting"
+
+dependencies:
+- base >= 4.7 && < 5
+- diagnose >=3.0.0
+- array >= 0.5 && < 0.6
+- data-default >= 0.7 && < 1
+- hashable >= 1.3 && < 2
+- prettyprinter >= 1.7.0 && < 2
+- prettyprinter-ansi-terminal >= 1.1.0 && < 2
+- unordered-containers >= 0.2 && < 0.3
+- wcwidth >= 0.0.1 && <1
+- text >= 1.0.0.0 && <= 2.0
+# ^^^ This is unfortunately required, but as 'prettyprinter' already depends on it, it will already have been fetched
+# into the local cache anyway.
+
+default-extensions:
+- OverloadedStrings
+- LambdaCase
+- BlockArguments
+
+library:
+  source-dirs: src
+  exposed-modules:
+  - Error.Diagnose.Layout.CodeSpanReporting
+
+ghc-options:
+- -Wall
+- -Wextra
+# - -Wmissing-local-signatures
+# - -Wmonomorphism-restriction
+
+extra-source-files:
+- README.md
+
+# This is put at the end for convenience.
+synopsis: codespan-reporting-like rendering for Diagnose.
+
+description: |
+  This package simply provides an codespan-reporting-like layout for diagnostic rendering.

diagnose-codespan-reporting/src/Data/List/Safe.hs

@@ -0,0 +1,35 @@
+module Data.List.Safe where
+
+import Data.Bifunctor (first)
+
+
+-- | Analogous to 'Data.List.last', but returns 'Nothing' on an empty list, instead of throwing an error.
+safeLast :: [a] -> Maybe a
+safeLast [] = Nothing
+safeLast l  = Just $ last l
+
+-- | Analogous to `Data.List.head`, but returns 'Nothing' in case of an empty list.
+safeHead :: [a] -> Maybe a
+safeHead []      = Nothing
+safeHead (x : _) = Just x
+
+-- | Analogous tu 'Data.List.!!', but does not throw an error on missing index.
+safeIndex :: Int -> [a] -> Maybe a
+safeIndex _ []       = Nothing
+safeIndex 0 (x : _)  = Just x
+safeIndex n (_ : xs)
+  | n < 0            = Nothing
+  | otherwise        = safeIndex (n - 1) xs
+
+-- | Safely deconstructs a list from the end.
+--
+--   More efficient than @(init x, last x)@
+safeUnsnoc :: [a] -> Maybe ([a], a)
+safeUnsnoc []       = Nothing
+safeUnsnoc [x]      = Just ([], x)
+safeUnsnoc (x : xs) = first (x :) <$> safeUnsnoc xs
+
+-- | Safely deconstructs a list from the beginning, returning 'Nothing' if the list is empty.
+safeUncons :: [a] -> Maybe (a, [a])
+safeUncons []       = Nothing
+safeUncons (x : xs) = Just (x, xs)

diagnose-codespan-reporting/src/Error/Diagnose/Layout/CodeSpanReporting.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE FlexibleContexts #-}
+module Error.Diagnose.Layout.CodeSpanReporting
+  ( codespanReportingLayout
+  , codespanReportingStyle
+  ) where
+
+import Error.Diagnose.Diagnostic (Diagnostic, filesOf, reportsOf)
+
+import Error.Diagnose (AnsiStyle, IsAnnotation (mkColor))
+import qualified Error.Diagnose.Layout.CodeSpanReporting.Config as R
+import qualified Error.Diagnose.Layout.CodeSpanReporting.Render as R
+import Prettyprinter (Doc, Pretty, reAnnotate)
+
+-- | Pretty prints a 'Diagnostic' into a 'Doc'ument that can be output using 'hPutDoc'.
+--
+--   Colors are put by default.
+--   If you do not want these, just 'unAnnotate' the resulting document like so:
+--
+--   >>> let doc = unAnnotate (prettyDiagnostic withUnicode tabSize diagnostic)
+--
+--   Changing the style is also rather easy:
+--
+--   >>> let myCustomStyle :: Style = _
+--   >>> let doc = myCustomStyle (prettyDiagnostic withUnicode tabSize diagnostic)
+codespanReportingLayout :: Pretty msg => Bool -> Int -> Diagnostic msg -> Doc R.Annotation
+codespanReportingLayout withUnicode tabSize diag
+  = foldMap (R.report (filesOf diag) chars tabSize) (reportsOf diag)
+  where chars = if withUnicode then R.unicodeChars else R.asciiChars
+{-# INLINE codespanReportingLayout #-}
+
+codespanReportingStyle :: Doc R.Annotation -> Doc AnsiStyle
+codespanReportingStyle = reAnnotate mkColor

diagnose-codespan-reporting/src/Error/Diagnose/Layout/CodeSpanReporting/Config.hs

@@ -0,0 +1,112 @@
+module Error.Diagnose.Layout.CodeSpanReporting.Config where
+
+data Chars = Chars
+  -- | The characters to use for the top-left border of the snippet.
+  --   Defaults to: @┌─@ or @-->@ with asciiChars.
+  { cSnippetStart             :: String
+  -- | The character to use for the left border of the source.
+  --   Defaults to: @│@ or @|@ with asciiChars.
+  , cSourceBorderLeft         :: Char
+  -- | The character to use for the left border break of the source.
+  --   Defaults to: @·@ or @.@ with asciiChars.
+  , cSourceBorderLeftBreak    :: Char
+  -- | The character to use for the note bullet.
+  --   Defaults to: @=@.
+  , cNoteBullet               :: Char
+  -- | The character to use for marking a single-line primary label.
+  --   Defaults to: @^@.
+  , cSinglePrimaryCaret       :: Char
+  -- | The character to use for marking a single-line secondary label.
+  --   Defaults to: @-@.
+  , cSingleSecondaryCaret     :: Char
+  -- | The character to use for marking a single-line add label.
+  --   Defaults to: @^@.
+  , cSingleAddCaret           :: Char
+  -- | The character to use for marking a single-line remove label.
+  --   Defaults to: @-@.
+  , cSingleRemoveCaret        :: Char
+  -- | The character to use for marking the start of a multi-line primary label.
+  --   Defaults to: @^@.
+  , cMultiPrimaryCaretStart   :: Char
+  -- | The character to use for marking the end of a multi-line primary label.
+  --   Defaults to: @^@.
+  , cMultiPrimaryCaretEnd     :: Char
+  -- | The character to use for marking the start of a multi-line secondary label.
+  --   Defaults to: @\'@.
+  , cMultiSecondaryCaretStart :: Char
+  -- | The character to use for marking the end of a multi-line secondary label.
+  --   Defaults to: @\'@.
+  , cMultiSecondaryCaretEnd   :: Char
+  -- | The character to use for marking the start of a multi-line remove label.
+  --   Defaults to: @~@.
+  , cMultiRemoveCaretStart    :: Char
+  -- | The character to use for marking the end of a multi-line remove label.
+  --   Defaults to: @~@.
+  , cMultiRemoveCaretEnd      :: Char
+  -- | The character to use for the top-left corner of a multi-line label.
+  --   Defaults to: @╭@ or @/@ with asciiChars.
+  , cMultiTopLeft             :: Char
+  -- | The character to use for the top of a multi-line label.
+  --   Defaults to: @─@ or @-@ with asciiChars.
+  , cMultiTop                 :: Char
+  -- | The character to use for the bottom-left corner of a multi-line label.
+  --   Defaults to: @╰@ or @\\@ with asciiChars.
+  , cMultiBottomLeft          :: Char
+  -- | The character to use when marking the bottom of a multi-line label.
+  --   Defaults to: @─@ or @-@ with asciiChars.
+  , cMultiBottom              :: Char
+  -- | The character to use for the left of a multi-line label.
+  --   Defaults to: @│@ or @|@ with asciiChars.
+  , cMultiLeft                :: Char
+  -- | The character to use for the left of a pointer underneath a caret.
+  --   Defaults to: @│@ or @|@ with asciiChars.
+  , cPointerLeft              :: Char
+  } deriving (Show)
+
+unicodeChars :: Chars
+unicodeChars = Chars
+  { cSnippetStart = "┌─"
+  , cSourceBorderLeft = '│'
+  , cSourceBorderLeftBreak = '·'
+  , cNoteBullet = '='
+  , cSinglePrimaryCaret = '^'
+  , cSingleSecondaryCaret = '-'
+  , cSingleAddCaret = '+'
+  , cSingleRemoveCaret = '~'
+  , cMultiPrimaryCaretStart = '^'
+  , cMultiPrimaryCaretEnd = '^'
+  , cMultiSecondaryCaretStart = '\''
+  , cMultiSecondaryCaretEnd = '\''
+  , cMultiRemoveCaretStart = '~'
+  , cMultiRemoveCaretEnd = '~'
+  , cMultiTopLeft = '╭'
+  , cMultiTop = '─'
+  , cMultiBottomLeft = '╰'
+  , cMultiBottom = '─'
+  , cMultiLeft = '│'
+  , cPointerLeft = '│'
+  }
+
+asciiChars :: Chars
+asciiChars = Chars
+  { cSnippetStart = "-->"
+  , cSourceBorderLeft = '|'
+  , cSourceBorderLeftBreak = '.'
+  , cNoteBullet = '='
+  , cSinglePrimaryCaret = '^'
+  , cSingleSecondaryCaret = '-'
+  , cSingleAddCaret = '+'
+  , cSingleRemoveCaret = '~'
+  , cMultiPrimaryCaretStart = '^'
+  , cMultiPrimaryCaretEnd = '^'
+  , cMultiSecondaryCaretStart = '\''
+  , cMultiSecondaryCaretEnd = '\''
+  , cMultiRemoveCaretStart = '~'
+  , cMultiRemoveCaretEnd = '~'
+  , cMultiTopLeft = ' '
+  , cMultiTop = '_'
+  , cMultiBottomLeft = '|'
+  , cMultiBottom = '_'
+  , cMultiLeft = '|'
+  , cPointerLeft = '|'
+  }