{-# LANGUAGE OverloadedStrings #-}
module Errata
(
Errata(..)
, errataSimple
, Block(..)
, blockSimple
, blockSimple'
, blockConnected
, blockConnected'
, blockMerged
, blockMerged'
, Pointer(..)
, Style(..)
, basicStyle
, fancyStyle
, fancyRedStyle
, fancyYellowStyle
, prettyErrors
, prettyErrorsNE
) where
import qualified Data.List.NonEmpty as N
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Errata.Internal.Render
import Errata.Source
import Errata.Types
errataSimple
:: Maybe Header
-> Block
-> Maybe Body
-> Errata
errataSimple :: Maybe Header -> Block -> Maybe Header -> Errata
errataSimple header :: Maybe Header
header block :: Block
block body :: Maybe Header
body = Errata :: Maybe Header -> Block -> [Block] -> Maybe Header -> Errata
Errata
{ errataHeader :: Maybe Header
errataHeader = Maybe Header
header
, errataBlock :: Block
errataBlock = Block
block
, errataBlocks :: [Block]
errataBlocks = []
, errataBody :: Maybe Header
errataBody = Maybe Header
body
}
blockSimple
:: Style
-> FilePath
-> Maybe Header
-> (Line, Column, Column, Maybe Label)
-> Maybe Body
-> Block
blockSimple :: Style
-> FilePath
-> Maybe Header
-> (Line, Line, Line, Maybe Header)
-> Maybe Header
-> Block
blockSimple style :: Style
style fp :: FilePath
fp hm :: Maybe Header
hm (l :: Line
l, cs :: Line
cs, ce :: Line
ce, lbl :: Maybe Header
lbl) bm :: Maybe Header
bm = Block :: Style
-> (FilePath, Line, Line)
-> Maybe Header
-> [Pointer]
-> Maybe Header
-> Block
Block
{ blockStyle :: Style
blockStyle = Style
style
, blockLocation :: (FilePath, Line, Line)
blockLocation = (FilePath
fp, Line
l, Line
cs)
, blockHeader :: Maybe Header
blockHeader = Maybe Header
hm
, blockPointers :: [Pointer]
blockPointers = [Line -> Line -> Line -> Bool -> Maybe Header -> Pointer
Pointer Line
l Line
cs Line
ce Bool
False Maybe Header
lbl]
, blockBody :: Maybe Header
blockBody = Maybe Header
bm
}
blockSimple'
:: Style
-> FilePath
-> Maybe Header
-> (Line, Column, Maybe Label)
-> Maybe Body
-> Block
blockSimple' :: Style
-> FilePath
-> Maybe Header
-> (Line, Line, Maybe Header)
-> Maybe Header
-> Block
blockSimple' style :: Style
style fp :: FilePath
fp hm :: Maybe Header
hm (l :: Line
l, c :: Line
c, lbl :: Maybe Header
lbl) bm :: Maybe Header
bm = Block :: Style
-> (FilePath, Line, Line)
-> Maybe Header
-> [Pointer]
-> Maybe Header
-> Block
Block
{ blockStyle :: Style
blockStyle = Style
style
, blockLocation :: (FilePath, Line, Line)
blockLocation = (FilePath
fp, Line
l, Line
c)
, blockHeader :: Maybe Header
blockHeader = Maybe Header
hm
, blockPointers :: [Pointer]
blockPointers = [Line -> Line -> Line -> Bool -> Maybe Header -> Pointer
Pointer Line
l Line
c (Line
c Line -> Line -> Line
forall a. Num a => a -> a -> a
+ 1) Bool
False Maybe Header
lbl]
, blockBody :: Maybe Header
blockBody = Maybe Header
bm
}
blockConnected
:: Style
-> FilePath
-> Maybe Header
-> (Line, Column, Column, Maybe Label)
-> (Line, Column, Column, Maybe Label)
-> Maybe Body
-> Block
blockConnected :: Style
-> FilePath
-> Maybe Header
-> (Line, Line, Line, Maybe Header)
-> (Line, Line, Line, Maybe Header)
-> Maybe Header
-> Block
blockConnected style :: Style
style fp :: FilePath
fp hm :: Maybe Header
hm (l1 :: Line
l1, cs1 :: Line
cs1, ce1 :: Line
ce1, lbl1 :: Maybe Header
lbl1) (l2 :: Line
l2, cs2 :: Line
cs2, ce2 :: Line
ce2, lbl2 :: Maybe Header
lbl2) bm :: Maybe Header
bm = Block :: Style
-> (FilePath, Line, Line)
-> Maybe Header
-> [Pointer]
-> Maybe Header
-> Block
Block
{ blockStyle :: Style
blockStyle = Style
style
, blockLocation :: (FilePath, Line, Line)
blockLocation = (FilePath
fp, Line
l1, Line
cs1)
, blockHeader :: Maybe Header
blockHeader = Maybe Header
hm
, blockPointers :: [Pointer]
blockPointers = [Line -> Line -> Line -> Bool -> Maybe Header -> Pointer
Pointer Line
l1 Line
cs1 Line
ce1 Bool
True Maybe Header
lbl1, Line -> Line -> Line -> Bool -> Maybe Header -> Pointer
Pointer Line
l2 Line
cs2 Line
ce2 Bool
True Maybe Header
lbl2]
, blockBody :: Maybe Header
blockBody = Maybe Header
bm
}
blockConnected'
:: Style
-> FilePath
-> Maybe Header
-> (Line, Column, Maybe Label)
-> (Line, Column, Maybe Label)
-> Maybe Body
-> Block
blockConnected' :: Style
-> FilePath
-> Maybe Header
-> (Line, Line, Maybe Header)
-> (Line, Line, Maybe Header)
-> Maybe Header
-> Block
blockConnected' style :: Style
style fp :: FilePath
fp hm :: Maybe Header
hm (l1 :: Line
l1, c1 :: Line
c1, lbl1 :: Maybe Header
lbl1) (l2 :: Line
l2, c2 :: Line
c2, lbl2 :: Maybe Header
lbl2) bm :: Maybe Header
bm = Block :: Style
-> (FilePath, Line, Line)
-> Maybe Header
-> [Pointer]
-> Maybe Header
-> Block
Block
{ blockStyle :: Style
blockStyle = Style
style
, blockLocation :: (FilePath, Line, Line)
blockLocation = (FilePath
fp, Line
l1, Line
c1)
, blockHeader :: Maybe Header
blockHeader = Maybe Header
hm
, blockPointers :: [Pointer]
blockPointers = [Line -> Line -> Line -> Bool -> Maybe Header -> Pointer
Pointer Line
l1 Line
c1 (Line
c1 Line -> Line -> Line
forall a. Num a => a -> a -> a
+ 1) Bool
True Maybe Header
lbl1, Line -> Line -> Line -> Bool -> Maybe Header -> Pointer
Pointer Line
l2 Line
c2 (Line
c2 Line -> Line -> Line
forall a. Num a => a -> a -> a
+ 1) Bool
True Maybe Header
lbl2]
, blockBody :: Maybe Header
blockBody = Maybe Header
bm
}
blockMerged
:: Style
-> FilePath
-> Maybe Header
-> (Line, Column, Column, Maybe Label)
-> (Line, Column, Column, Maybe Label)
-> Maybe Label
-> Maybe Body
-> Block
blockMerged :: Style
-> FilePath
-> Maybe Header
-> (Line, Line, Line, Maybe Header)
-> (Line, Line, Line, Maybe Header)
-> Maybe Header
-> Maybe Header
-> Block
blockMerged style :: Style
style fp :: FilePath
fp hm :: Maybe Header
hm (l1 :: Line
l1, cs1 :: Line
cs1, ce1 :: Line
ce1, lbl1 :: Maybe Header
lbl1) (l2 :: Line
l2, cs2 :: Line
cs2, ce2 :: Line
ce2, lbl2 :: Maybe Header
lbl2) lbl :: Maybe Header
lbl bm :: Maybe Header
bm = Block :: Style
-> (FilePath, Line, Line)
-> Maybe Header
-> [Pointer]
-> Maybe Header
-> Block
Block
{ blockStyle :: Style
blockStyle = Style
style
, blockLocation :: (FilePath, Line, Line)
blockLocation = (FilePath
fp, Line
l1, Line
cs1)
, blockHeader :: Maybe Header
blockHeader = Maybe Header
hm
, blockPointers :: [Pointer]
blockPointers = if Line
l1 Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
== Line
l2
then [Line -> Line -> Line -> Bool -> Maybe Header -> Pointer
Pointer Line
l1 Line
cs1 Line
ce2 Bool
False Maybe Header
lbl]
else [Line -> Line -> Line -> Bool -> Maybe Header -> Pointer
Pointer Line
l1 Line
cs1 Line
ce1 Bool
True Maybe Header
lbl1, Line -> Line -> Line -> Bool -> Maybe Header -> Pointer
Pointer Line
l2 Line
cs2 Line
ce2 Bool
True Maybe Header
lbl2]
, blockBody :: Maybe Header
blockBody = Maybe Header
bm
}
blockMerged'
:: Style
-> FilePath
-> Maybe Header
-> (Line, Column, Maybe Label)
-> (Line, Column, Maybe Label)
-> Maybe Label
-> Maybe Body
-> Block
blockMerged' :: Style
-> FilePath
-> Maybe Header
-> (Line, Line, Maybe Header)
-> (Line, Line, Maybe Header)
-> Maybe Header
-> Maybe Header
-> Block
blockMerged' style :: Style
style fp :: FilePath
fp hm :: Maybe Header
hm (l1 :: Line
l1, c1 :: Line
c1, lbl1 :: Maybe Header
lbl1) (l2 :: Line
l2, c2 :: Line
c2, lbl2 :: Maybe Header
lbl2) lbl :: Maybe Header
lbl bm :: Maybe Header
bm = Block :: Style
-> (FilePath, Line, Line)
-> Maybe Header
-> [Pointer]
-> Maybe Header
-> Block
Block
{ blockStyle :: Style
blockStyle = Style
style
, blockLocation :: (FilePath, Line, Line)
blockLocation = (FilePath
fp, Line
l1, Line
c1)
, blockHeader :: Maybe Header
blockHeader = Maybe Header
hm
, blockPointers :: [Pointer]
blockPointers = if Line
l1 Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
== Line
l2
then [Line -> Line -> Line -> Bool -> Maybe Header -> Pointer
Pointer Line
l1 Line
c1 (Line
c2 Line -> Line -> Line
forall a. Num a => a -> a -> a
+ 1) Bool
False Maybe Header
lbl]
else [Line -> Line -> Line -> Bool -> Maybe Header -> Pointer
Pointer Line
l1 Line
c1 (Line
c1 Line -> Line -> Line
forall a. Num a => a -> a -> a
+ 1) Bool
True Maybe Header
lbl1, Line -> Line -> Line -> Bool -> Maybe Header -> Pointer
Pointer Line
l2 Line
c2 (Line
c2 Line -> Line -> Line
forall a. Num a => a -> a -> a
+ 1) Bool
True Maybe Header
lbl2]
, blockBody :: Maybe Header
blockBody = Maybe Header
bm
}
basicStyle :: Style
basicStyle :: Style
basicStyle = Style :: ((FilePath, Line, Line) -> Header)
-> (Line -> Header)
-> ([(Line, Line)] -> Header -> Header)
-> Header
-> Header
-> Header
-> Header
-> Header
-> Header
-> Header
-> Header
-> Style
Style
{ styleLocation :: (FilePath, Line, Line) -> Header
styleLocation = \(fp :: FilePath
fp, l :: Line
l, c :: Line
c) -> [Header] -> Header
T.concat ["--> ", FilePath -> Header
T.pack FilePath
fp, ":", FilePath -> Header
T.pack (FilePath -> Header) -> FilePath -> Header
forall a b. (a -> b) -> a -> b
$ Line -> FilePath
forall a. Show a => a -> FilePath
show Line
l, ":", FilePath -> Header
T.pack (FilePath -> Header) -> FilePath -> Header
forall a b. (a -> b) -> a -> b
$ Line -> FilePath
forall a. Show a => a -> FilePath
show Line
c]
, styleNumber :: Line -> Header
styleNumber = FilePath -> Header
T.pack (FilePath -> Header) -> (Line -> FilePath) -> Line -> Header
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> FilePath
forall a. Show a => a -> FilePath
show
, styleLine :: [(Line, Line)] -> Header -> Header
styleLine = (Header -> Header) -> [(Line, Line)] -> Header -> Header
forall a b. a -> b -> a
const Header -> Header
forall a. a -> a
id
, styleEllipsis :: Header
styleEllipsis = "."
, styleLinePrefix :: Header
styleLinePrefix = "|"
, styleUnderline :: Header
styleUnderline = "^"
, styleVertical :: Header
styleVertical = "|"
, styleHorizontal :: Header
styleHorizontal = "_"
, styleDownRight :: Header
styleDownRight = " "
, styleUpRight :: Header
styleUpRight = "|"
, styleUpDownRight :: Header
styleUpDownRight = "|"
}
fancyStyle :: Style
fancyStyle :: Style
fancyStyle = Style :: ((FilePath, Line, Line) -> Header)
-> (Line -> Header)
-> ([(Line, Line)] -> Header -> Header)
-> Header
-> Header
-> Header
-> Header
-> Header
-> Header
-> Header
-> Header
-> Style
Style
{ styleLocation :: (FilePath, Line, Line) -> Header
styleLocation = \(fp :: FilePath
fp, l :: Line
l, c :: Line
c) -> [Header] -> Header
T.concat
[ "→ ", FilePath -> Header
T.pack FilePath
fp, ":", FilePath -> Header
T.pack (FilePath -> Header) -> FilePath -> Header
forall a b. (a -> b) -> a -> b
$ Line -> FilePath
forall a. Show a => a -> FilePath
show Line
l, ":", FilePath -> Header
T.pack (FilePath -> Header) -> FilePath -> Header
forall a b. (a -> b) -> a -> b
$ Line -> FilePath
forall a. Show a => a -> FilePath
show Line
c
]
, styleNumber :: Line -> Header
styleNumber = FilePath -> Header
T.pack (FilePath -> Header) -> (Line -> FilePath) -> Line -> Header
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> FilePath
forall a. Show a => a -> FilePath
show
, styleLine :: [(Line, Line)] -> Header -> Header
styleLine = (Header -> Header) -> [(Line, Line)] -> Header -> Header
forall a b. a -> b -> a
const Header -> Header
forall a. a -> a
id
, styleEllipsis :: Header
styleEllipsis = "."
, styleLinePrefix :: Header
styleLinePrefix = "│"
, styleUnderline :: Header
styleUnderline = "^"
, styleHorizontal :: Header
styleHorizontal = "─"
, styleVertical :: Header
styleVertical = "│"
, styleDownRight :: Header
styleDownRight = "┌"
, styleUpDownRight :: Header
styleUpDownRight = "├"
, styleUpRight :: Header
styleUpRight = "└"
}
fancyRedStyle :: Style
fancyRedStyle :: Style
fancyRedStyle = Style :: ((FilePath, Line, Line) -> Header)
-> (Line -> Header)
-> ([(Line, Line)] -> Header -> Header)
-> Header
-> Header
-> Header
-> Header
-> Header
-> Header
-> Header
-> Header
-> Style
Style
{ styleLocation :: (FilePath, Line, Line) -> Header
styleLocation = \(fp :: FilePath
fp, l :: Line
l, c :: Line
c) -> [Header] -> Header
T.concat
[ "\x1b[34m→\x1b[0m ", FilePath -> Header
T.pack FilePath
fp, ":", FilePath -> Header
T.pack (FilePath -> Header) -> FilePath -> Header
forall a b. (a -> b) -> a -> b
$ Line -> FilePath
forall a. Show a => a -> FilePath
show Line
l, ":", FilePath -> Header
T.pack (FilePath -> Header) -> FilePath -> Header
forall a b. (a -> b) -> a -> b
$ Line -> FilePath
forall a. Show a => a -> FilePath
show Line
c
]
, styleNumber :: Line -> Header
styleNumber = FilePath -> Header
T.pack (FilePath -> Header) -> (Line -> FilePath) -> Line -> Header
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> FilePath
forall a. Show a => a -> FilePath
show
, styleLine :: [(Line, Line)] -> Header -> Header
styleLine = Header -> Header -> [(Line, Line)] -> Header -> Header
highlight "\x1b[31m" "\x1b[0m"
, styleEllipsis :: Header
styleEllipsis = "."
, styleLinePrefix :: Header
styleLinePrefix = "\x1b[34m│\x1b[0m"
, styleUnderline :: Header
styleUnderline = "\x1b[31m^\x1b[0m"
, styleHorizontal :: Header
styleHorizontal = "\x1b[31m─\x1b[0m"
, styleVertical :: Header
styleVertical = "\x1b[31m│\x1b[0m"
, styleDownRight :: Header
styleDownRight = "\x1b[31m┌\x1b[0m"
, styleUpDownRight :: Header
styleUpDownRight = "\x1b[31m├\x1b[0m"
, styleUpRight :: Header
styleUpRight = "\x1b[31m└\x1b[0m"
}
fancyYellowStyle :: Style
fancyYellowStyle :: Style
fancyYellowStyle = Style :: ((FilePath, Line, Line) -> Header)
-> (Line -> Header)
-> ([(Line, Line)] -> Header -> Header)
-> Header
-> Header
-> Header
-> Header
-> Header
-> Header
-> Header
-> Header
-> Style
Style
{ styleLocation :: (FilePath, Line, Line) -> Header
styleLocation = \(fp :: FilePath
fp, l :: Line
l, c :: Line
c) -> [Header] -> Header
T.concat
[ "\x1b[34m→\x1b[0m ", FilePath -> Header
T.pack FilePath
fp, ":", FilePath -> Header
T.pack (FilePath -> Header) -> FilePath -> Header
forall a b. (a -> b) -> a -> b
$ Line -> FilePath
forall a. Show a => a -> FilePath
show Line
l, ":", FilePath -> Header
T.pack (FilePath -> Header) -> FilePath -> Header
forall a b. (a -> b) -> a -> b
$ Line -> FilePath
forall a. Show a => a -> FilePath
show Line
c
]
, styleNumber :: Line -> Header
styleNumber = FilePath -> Header
T.pack (FilePath -> Header) -> (Line -> FilePath) -> Line -> Header
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> FilePath
forall a. Show a => a -> FilePath
show
, styleLine :: [(Line, Line)] -> Header -> Header
styleLine = Header -> Header -> [(Line, Line)] -> Header -> Header
highlight "\x1b[33m" "\x1b[0m"
, styleEllipsis :: Header
styleEllipsis = "."
, styleLinePrefix :: Header
styleLinePrefix = "\x1b[34m│\x1b[0m"
, styleUnderline :: Header
styleUnderline = "\x1b[33m^\x1b[0m"
, styleHorizontal :: Header
styleHorizontal = "\x1b[33m─\x1b[0m"
, styleVertical :: Header
styleVertical = "\x1b[33m│\x1b[0m"
, styleDownRight :: Header
styleDownRight = "\x1b[33m┌\x1b[0m"
, styleUpRight :: Header
styleUpRight = "\x1b[33m└\x1b[0m"
, styleUpDownRight :: Header
styleUpDownRight = "\x1b[33m├\x1b[0m"
}
prettyErrors :: Source source => source -> [Errata] -> TL.Text
prettyErrors :: source -> [Errata] -> Text
prettyErrors source :: source
source errs :: [Errata]
errs = Builder -> Text
TB.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ source -> [Errata] -> Builder
forall source. Source source => source -> [Errata] -> Builder
renderErrors source
source [Errata]
errs
prettyErrorsNE :: Source source => source -> N.NonEmpty Errata -> TL.Text
prettyErrorsNE :: source -> NonEmpty Errata -> Text
prettyErrorsNE source :: source
source errs :: NonEmpty Errata
errs = source -> [Errata] -> Text
forall source. Source source => source -> [Errata] -> Text
prettyErrors source
source (NonEmpty Errata -> [Errata]
forall a. NonEmpty a -> [a]
N.toList NonEmpty Errata
errs)