{-# LANGUAGE OverloadedStrings #-}
module Errata
(
Errata (..)
, errataSimple
, Block (..)
, blockSimple
, blockSimple'
, blockConnected
, blockConnected'
, blockMerged
, blockMerged'
, Pointer (..)
, Style (..)
, basicStyle
, fancyStyle
, fancyRedStyle
, fancyYellowStyle
, prettyErrors
) where
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Errata.Internal.Render
import Errata.Source
import Errata.Types
errataSimple
:: Maybe Header
-> Block
-> Maybe Body
-> Errata
errataSimple :: Maybe Header -> Block -> Maybe Header -> Errata
errataSimple Maybe Header
header Block
block Maybe Header
body = Errata :: Maybe Header -> [Block] -> Maybe Header -> Errata
Errata
{ errataHeader :: Maybe Header
errataHeader = Maybe Header
header
, errataBlocks :: [Block]
errataBlocks = [Block
block]
, 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 FilePath
fp Maybe Header
hm (Line
l, Line
cs, Line
ce, Maybe Header
lbl) 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 FilePath
fp Maybe Header
hm (Line
l, Line
c, Maybe Header
lbl) Maybe Header
bm =
Style
-> FilePath
-> Maybe Header
-> (Line, Line, Line, Maybe Header)
-> Maybe Header
-> Block
blockSimple Style
style FilePath
fp Maybe Header
hm (Line
l, Line
c, Line
c Line -> Line -> Line
forall a. Num a => a -> a -> a
+ Line
1, Maybe Header
lbl) 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 FilePath
fp Maybe Header
hm (Line
l1, Line
cs1, Line
ce1, Maybe Header
lbl1) (Line
l2, Line
cs2, Line
ce2, Maybe Header
lbl2) 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 FilePath
fp Maybe Header
hm (Line
l1, Line
c1, Maybe Header
lbl1) (Line
l2, Line
c2, Maybe Header
lbl2) Maybe Header
bm =
Style
-> FilePath
-> Maybe Header
-> (Line, Line, Line, Maybe Header)
-> (Line, Line, Line, Maybe Header)
-> Maybe Header
-> Block
blockConnected Style
style FilePath
fp Maybe Header
hm (Line
l1, Line
c1, Line
c1 Line -> Line -> Line
forall a. Num a => a -> a -> a
+ Line
1, Maybe Header
lbl1) (Line
l2, Line
c2, Line
c2 Line -> Line -> Line
forall a. Num a => a -> a -> a
+ Line
1, Maybe Header
lbl2) 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 FilePath
fp Maybe Header
hm (Line
l1, Line
cs1, Line
ce1, Maybe Header
lbl1) (Line
l2, Line
cs2, Line
ce2, Maybe Header
lbl2) Maybe Header
lbl 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 FilePath
fp Maybe Header
hm (Line
l1, Line
c1, Maybe Header
lbl1) (Line
l2, Line
c2, Maybe Header
lbl2) Maybe Header
lbl Maybe Header
bm =
Style
-> FilePath
-> Maybe Header
-> (Line, Line, Line, Maybe Header)
-> (Line, Line, Line, Maybe Header)
-> Maybe Header
-> Maybe Header
-> Block
blockMerged Style
style FilePath
fp Maybe Header
hm (Line
l1, Line
c1, Line
c1 Line -> Line -> Line
forall a. Num a => a -> a -> a
+ Line
1, Maybe Header
lbl1) (Line
l2, Line
c2, Line
c2 Line -> Line -> Line
forall a. Num a => a -> a -> a
+ Line
1, Maybe Header
lbl2) Maybe Header
lbl 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 = \(FilePath
fp, Line
l, Line
c) -> [Header] -> Header
T.concat [Header
"--> ", FilePath -> Header
T.pack FilePath
fp, Header
":", 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, Header
":", 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 = Header
"."
, styleLinePrefix :: Header
styleLinePrefix = Header
"|"
, styleUnderline :: Header
styleUnderline = Header
"^"
, styleVertical :: Header
styleVertical = Header
"|"
, styleHorizontal :: Header
styleHorizontal = Header
"_"
, styleDownRight :: Header
styleDownRight = Header
" "
, styleUpRight :: Header
styleUpRight = Header
"|"
, styleUpDownRight :: Header
styleUpDownRight = Header
"|"
}
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 = \(FilePath
fp, Line
l, Line
c) -> [Header] -> Header
T.concat
[ Header
"→ ", FilePath -> Header
T.pack FilePath
fp, Header
":", 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, Header
":", 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 = Header
"."
, styleLinePrefix :: Header
styleLinePrefix = Header
"│"
, styleUnderline :: Header
styleUnderline = Header
"^"
, styleHorizontal :: Header
styleHorizontal = Header
"─"
, styleVertical :: Header
styleVertical = Header
"│"
, styleDownRight :: Header
styleDownRight = Header
"┌"
, styleUpDownRight :: Header
styleUpDownRight = Header
"├"
, styleUpRight :: Header
styleUpRight = Header
"└"
}
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 = \(FilePath
fp, Line
l, Line
c) -> [Header] -> Header
T.concat
[ Header
"\x1b[34m→\x1b[0m ", FilePath -> Header
T.pack FilePath
fp, Header
":", 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, Header
":", 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 Header
"\x1b[31m" Header
"\x1b[0m"
, styleEllipsis :: Header
styleEllipsis = Header
"."
, styleLinePrefix :: Header
styleLinePrefix = Header
"\x1b[34m│\x1b[0m"
, styleUnderline :: Header
styleUnderline = Header
"\x1b[31m^\x1b[0m"
, styleHorizontal :: Header
styleHorizontal = Header
"\x1b[31m─\x1b[0m"
, styleVertical :: Header
styleVertical = Header
"\x1b[31m│\x1b[0m"
, styleDownRight :: Header
styleDownRight = Header
"\x1b[31m┌\x1b[0m"
, styleUpDownRight :: Header
styleUpDownRight = Header
"\x1b[31m├\x1b[0m"
, styleUpRight :: Header
styleUpRight = Header
"\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 = \(FilePath
fp, Line
l, Line
c) -> [Header] -> Header
T.concat
[ Header
"\x1b[34m→\x1b[0m ", FilePath -> Header
T.pack FilePath
fp, Header
":", 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, Header
":", 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 Header
"\x1b[33m" Header
"\x1b[0m"
, styleEllipsis :: Header
styleEllipsis = Header
"."
, styleLinePrefix :: Header
styleLinePrefix = Header
"\x1b[34m│\x1b[0m"
, styleUnderline :: Header
styleUnderline = Header
"\x1b[33m^\x1b[0m"
, styleHorizontal :: Header
styleHorizontal = Header
"\x1b[33m─\x1b[0m"
, styleVertical :: Header
styleVertical = Header
"\x1b[33m│\x1b[0m"
, styleDownRight :: Header
styleDownRight = Header
"\x1b[33m┌\x1b[0m"
, styleUpRight :: Header
styleUpRight = Header
"\x1b[33m└\x1b[0m"
, styleUpDownRight :: Header
styleUpDownRight = Header
"\x1b[33m├\x1b[0m"
}
prettyErrors :: Source source => source -> [Errata] -> TL.Text
prettyErrors :: source -> [Errata] -> Text
prettyErrors source
source [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