{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Errata.Internal.Render
( renderErrors
, renderErrata
, renderBlock
, renderSourceLines
) where
import qualified GHC.Arr as A
import Data.List
import qualified Data.List.NonEmpty as N
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as TB
import Errata.Source
import Errata.Types
renderErrors :: Source source => source -> [Errata] -> TB.Builder
renderErrors :: source -> [Errata] -> Builder
renderErrors source :: source
source errs :: [Errata]
errs = Builder -> [Builder] -> Builder
unsplit "\n\n" [Builder]
prettified
where
sortedErrata :: [Errata]
sortedErrata = (Errata -> (FilePath, Line, Line)) -> [Errata] -> [Errata]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Block -> (FilePath, Line, Line)
blockLocation (Block -> (FilePath, Line, Line))
-> (Errata -> Block) -> Errata -> (FilePath, Line, Line)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Errata -> Block
errataBlock) [Errata]
errs
slines :: Array Line source
slines = let xs :: [source]
xs = source -> [source]
forall s. Source s => s -> [s]
sourceToLines source
source in (Line, Line) -> [source] -> Array Line source
forall i e. Ix i => (i, i) -> [e] -> Array i e
A.listArray (0, [source] -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
length [source]
xs Line -> Line -> Line
forall a. Num a => a -> a -> a
- 1) [source]
xs
prettified :: [Builder]
prettified = (Errata -> Builder) -> [Errata] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Array Line source -> Errata -> Builder
forall source.
Source source =>
Array Line source -> Errata -> Builder
renderErrata Array Line source
slines) [Errata]
sortedErrata
renderErrata :: Source source => A.Array Int source -> Errata -> TB.Builder
renderErrata :: Array Line source -> Errata -> Builder
renderErrata slines :: Array Line source
slines (Errata {..}) = Builder
errorMessage
where
errorMessage :: Builder
errorMessage = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Body -> Builder
TB.fromText (Body -> Builder) -> Body -> Builder
forall a b. (a -> b) -> a -> b
$ Body -> (Body -> Body) -> Maybe Body -> Body
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (Body -> Body -> Body
forall a. Semigroup a => a -> a -> a
<> "\n") Maybe Body
errataHeader
, Builder -> [Builder] -> Builder
unsplit "\n\n" ((Block -> Builder) -> [Block] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Array Line source -> Block -> Builder
forall source.
Source source =>
Array Line source -> Block -> Builder
renderBlock Array Line source
slines) (Block
errataBlock Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
errataBlocks))
, Body -> Builder
TB.fromText (Body -> Builder) -> Body -> Builder
forall a b. (a -> b) -> a -> b
$ Body -> (Body -> Body) -> Maybe Body -> Body
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ("\n\n" Body -> Body -> Body
forall a. Semigroup a => a -> a -> a
<>) Maybe Body
errataBody
]
renderBlock :: Source source => A.Array Int source -> Block -> TB.Builder
renderBlock :: Array Line source -> Block -> Builder
renderBlock slines :: Array Line source
slines block :: Block
block@(Block {..}) = Builder
blockMessage
where
blockMessage :: Builder
blockMessage = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Body -> Builder
TB.fromText (Body -> Builder) -> Body -> Builder
forall a b. (a -> b) -> a -> b
$ Style -> (FilePath, Line, Line) -> Body
styleLocation Style
blockStyle (FilePath, Line, Line)
blockLocation
, Body -> Builder
TB.fromText (Body -> Builder) -> Body -> Builder
forall a b. (a -> b) -> a -> b
$ Body -> (Body -> Body) -> Maybe Body -> Body
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ("\n" Body -> Body -> Body
forall a. Semigroup a => a -> a -> a
<>) Maybe Body
blockHeader
, Builder -> (Builder -> Builder) -> Maybe Builder -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ("\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Array Line source -> Block -> NonEmpty Pointer -> Builder
forall source.
Source source =>
Array Line source -> Block -> NonEmpty Pointer -> Builder
renderSourceLines Array Line source
slines Block
block (NonEmpty Pointer -> Builder)
-> Maybe (NonEmpty Pointer) -> Maybe Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pointer] -> Maybe (NonEmpty Pointer)
forall a. [a] -> Maybe (NonEmpty a)
N.nonEmpty [Pointer]
blockPointers)
, Body -> Builder
TB.fromText (Body -> Builder) -> Body -> Builder
forall a b. (a -> b) -> a -> b
$ Body -> (Body -> Body) -> Maybe Body -> Body
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ("\n" Body -> Body -> Body
forall a. Semigroup a => a -> a -> a
<>) Maybe Body
blockBody
]
renderSourceLines
:: Source source
=> A.Array Int source
-> Block
-> N.NonEmpty Pointer
-> TB.Builder
renderSourceLines :: Array Line source -> Block -> NonEmpty Pointer -> Builder
renderSourceLines slines :: Array Line source
slines (Block {..}) lspans :: NonEmpty Pointer
lspans = Builder -> [Builder] -> Builder
unsplit "\n" [Builder]
sourceLines
where
Style {..} = Style
blockStyle
minLine :: Line
minLine = (Line, NonEmpty Pointer) -> Line
forall a b. (a, b) -> a
fst (Map Line (NonEmpty Pointer) -> (Line, NonEmpty Pointer)
forall k a. Map k a -> (k, a)
M.findMin Map Line (NonEmpty Pointer)
pointersGrouped)
maxLine :: Line
maxLine = (Line, NonEmpty Pointer) -> Line
forall a b. (a, b) -> a
fst (Map Line (NonEmpty Pointer) -> (Line, NonEmpty Pointer)
forall k a. Map k a -> (k, a)
M.findMax Map Line (NonEmpty Pointer)
pointersGrouped)
padding :: Line
padding = FilePath -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
length (Line -> FilePath
forall a. Show a => a -> FilePath
show Line
maxLine)
showLine :: [(Column, Column)] -> Line -> TB.Builder
showLine :: [(Line, Line)] -> Line -> Builder
showLine hs :: [(Line, Line)]
hs n :: Line
n = Body -> Builder
TB.fromText (Body -> Builder)
-> (Maybe source -> Body) -> Maybe source -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Body -> (Body -> Body) -> Maybe Body -> Body
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" Body -> Body
forall a. a -> a
id (Maybe Body -> Body)
-> (Maybe source -> Maybe Body) -> Maybe source -> Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (source -> Body) -> Maybe source -> Maybe Body
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Line, Line)] -> Body -> Body
styleLine [(Line, Line)]
hs (Body -> Body) -> (source -> Body) -> source -> Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. source -> Body
forall s. Source s => s -> Body
sourceToText) (Maybe source -> Builder) -> Maybe source -> Builder
forall a b. (a -> b) -> a -> b
$ Array Line source -> Line -> Maybe source
forall s. Array Line s -> Line -> Maybe s
indexLines Array Line source
slines (Line
n Line -> Line -> Line
forall a. Num a => a -> a -> a
- 1)
prefix :: Builder
prefix = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Line -> Body -> Builder
replicateB Line
padding " ", " ", Body -> Builder
TB.fromText Body
styleLinePrefix, " "
]
omitPrefix :: Builder
omitPrefix = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Body -> Builder
TB.fromText Body
styleEllipsis, Line -> Body -> Builder
replicateB (Line
padding Line -> Line -> Line
forall a. Num a => a -> a -> a
- 1) " ", " ", Body -> Builder
TB.fromText Body
styleLinePrefix, " "
]
linePrefix :: Line -> TB.Builder
linePrefix :: Line -> Builder
linePrefix n :: Line
n = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Body -> Builder
TB.fromText (Line -> Body
styleNumber Line
n), Line -> Body -> Builder
replicateB (Line
padding Line -> Line -> Line
forall a. Num a => a -> a -> a
- FilePath -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
length (Line -> FilePath
forall a. Show a => a -> FilePath
show Line
n)) " ", " "
, Body -> Builder
TB.fromText Body
styleLinePrefix, " "
]
pointersGrouped :: Map Line (NonEmpty Pointer)
pointersGrouped = (NonEmpty Pointer -> NonEmpty Pointer -> NonEmpty Pointer)
-> [(Line, NonEmpty Pointer)] -> Map Line (NonEmpty Pointer)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith NonEmpty Pointer -> NonEmpty Pointer -> NonEmpty Pointer
forall a. Semigroup a => a -> a -> a
(<>) ([(Line, NonEmpty Pointer)] -> Map Line (NonEmpty Pointer))
-> [(Line, NonEmpty Pointer)] -> Map Line (NonEmpty Pointer)
forall a b. (a -> b) -> a -> b
$ (Pointer -> (Line, NonEmpty Pointer))
-> [Pointer] -> [(Line, NonEmpty Pointer)]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Pointer
x -> (Pointer -> Line
pointerLine Pointer
x, Pointer -> NonEmpty Pointer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pointer
x)) (NonEmpty Pointer -> [Pointer]
forall a. NonEmpty a -> [a]
N.toList NonEmpty Pointer
lspans)
sourceLines :: [Builder]
sourceLines = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Line -> Body -> Builder
replicateB Line
padding " ", " ", Body -> Builder
TB.fromText Body
styleLinePrefix]
Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Line -> [Line] -> [Builder]
makeSourceLines 0 [Line
minLine .. Line
maxLine]
hasConnMulti :: Bool
hasConnMulti = Map Line (NonEmpty Pointer) -> Line
forall k a. Map k a -> Line
M.size ((NonEmpty Pointer -> Bool)
-> Map Line (NonEmpty Pointer) -> Map Line (NonEmpty Pointer)
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter ((Pointer -> Bool) -> NonEmpty Pointer -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Pointer -> Bool
pointerConnect) Map Line (NonEmpty Pointer)
pointersGrouped) Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
> 1
hasConn :: Line -> Bool
hasConn :: Line -> Bool
hasConn n :: Line
n = Bool
-> (NonEmpty Pointer -> Bool) -> Maybe (NonEmpty Pointer) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Pointer -> Bool) -> NonEmpty Pointer -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Pointer -> Bool
pointerConnect) (Maybe (NonEmpty Pointer) -> Bool)
-> Maybe (NonEmpty Pointer) -> Bool
forall a b. (a -> b) -> a -> b
$ Line -> Map Line (NonEmpty Pointer) -> Maybe (NonEmpty Pointer)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Line
n Map Line (NonEmpty Pointer)
pointersGrouped
connAround :: Line -> (Bool, Bool)
connAround :: Line -> (Bool, Bool)
connAround n :: Line
n =
let (a :: Map Line (NonEmpty Pointer)
a, b :: Map Line (NonEmpty Pointer)
b) = Line
-> Map Line (NonEmpty Pointer)
-> (Map Line (NonEmpty Pointer), Map Line (NonEmpty Pointer))
forall k a. Ord k => k -> Map k a -> (Map k a, Map k a)
M.split Line
n Map Line (NonEmpty Pointer)
pointersGrouped
in (((NonEmpty Pointer -> Bool) -> Map Line (NonEmpty Pointer) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((NonEmpty Pointer -> Bool) -> Map Line (NonEmpty Pointer) -> Bool)
-> ((Pointer -> Bool) -> NonEmpty Pointer -> Bool)
-> (Pointer -> Bool)
-> Map Line (NonEmpty Pointer)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pointer -> Bool) -> NonEmpty Pointer -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any) Pointer -> Bool
pointerConnect Map Line (NonEmpty Pointer)
a, ((NonEmpty Pointer -> Bool) -> Map Line (NonEmpty Pointer) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((NonEmpty Pointer -> Bool) -> Map Line (NonEmpty Pointer) -> Bool)
-> ((Pointer -> Bool) -> NonEmpty Pointer -> Bool)
-> (Pointer -> Bool)
-> Map Line (NonEmpty Pointer)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pointer -> Bool) -> NonEmpty Pointer -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any) Pointer -> Bool
pointerConnect Map Line (NonEmpty Pointer)
b)
makeSourceLines :: Line -> [Line] -> [TB.Builder]
makeSourceLines :: Line -> [Line] -> [Builder]
makeSourceLines _ [] = []
makeSourceLines _ (n :: Line
n:ns :: [Line]
ns)
| Just p :: NonEmpty Pointer
p <- Line -> Map Line (NonEmpty Pointer) -> Maybe (NonEmpty Pointer)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Line
n Map Line (NonEmpty Pointer)
pointersGrouped = NonEmpty Pointer -> [Builder]
makeDecoratedLines NonEmpty Pointer
p [Builder] -> [Builder] -> [Builder]
forall a. Semigroup a => a -> a -> a
<> Line -> [Line] -> [Builder]
makeSourceLines 0 [Line]
ns
makeSourceLines extra :: Line
extra (n :: Line
n:ns :: [Line]
ns)
| Line
extra Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
< 2 =
let mid :: Builder
mid = if
| (Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd (Line -> (Bool, Bool)
connAround Line
n) -> Body -> Builder
TB.fromText Body
styleVertical Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> " "
| Bool
hasConnMulti -> " "
| Bool
otherwise -> ""
in (Line -> Builder
linePrefix Line
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
mid Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [(Line, Line)] -> Line -> Builder
showLine [] Line
n) Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Line -> [Line] -> [Builder]
makeSourceLines (Line
extra Line -> Line -> Line
forall a. Num a => a -> a -> a
+ 1) [Line]
ns
makeSourceLines _ ns :: [Line]
ns =
let (es :: [Line]
es, ns' :: [Line]
ns') = (Line -> Bool) -> [Line] -> ([Line], [Line])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Line -> Map Line (NonEmpty Pointer) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map Line (NonEmpty Pointer)
pointersGrouped) [Line]
ns
in case ([Line]
es, [Line]
ns') of
(_, []) -> []
([], _) -> Line -> [Line] -> [Builder]
makeSourceLines 0 [Line]
ns'
([n :: Line
n], _) ->
let mid :: Builder
mid = if
| (Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd (Line -> (Bool, Bool)
connAround Line
n) -> Body -> Builder
TB.fromText Body
styleVertical Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> " "
| Bool
hasConnMulti -> " "
| Bool
otherwise -> ""
in (Line -> Builder
linePrefix Line
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
mid Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [(Line, Line)] -> Line -> Builder
showLine [] Line
n) Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Line -> [Line] -> [Builder]
makeSourceLines 0 [Line]
ns'
(_, _) ->
let n :: Line
n = [Line] -> Line
forall a. [a] -> a
last [Line]
es
mid :: Builder
mid = if
| (Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd (Line -> (Bool, Bool)
connAround Line
n) -> Body -> Builder
TB.fromText Body
styleVertical Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> " "
| Bool
hasConnMulti -> " "
| Bool
otherwise -> ""
in (Builder
omitPrefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
mid) Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: (Line -> Builder
linePrefix Line
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
mid Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [(Line, Line)] -> Line -> Builder
showLine [] Line
n) Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Line -> [Line] -> [Builder]
makeSourceLines 0 [Line]
ns'
makeDecoratedLines :: N.NonEmpty Pointer -> [TB.Builder]
makeDecoratedLines :: NonEmpty Pointer -> [Builder]
makeDecoratedLines pointers :: NonEmpty Pointer
pointers = (Line -> Builder
linePrefix Line
line Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Body -> Builder
TB.fromText Body
lineConnector Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
sline) Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
decorationLines
where
lineConnector :: Body
lineConnector = if
| Bool
hasConnBefore Bool -> Bool -> Bool
&& Bool
hasConnUnder -> Body
styleVertical Body -> Body -> Body
forall a. Semigroup a => a -> a -> a
<> " "
| Bool
hasConnMulti -> " "
| Bool
otherwise -> ""
hasConnHere :: Bool
hasConnHere = Line -> Bool
hasConn Line
line
(hasConnBefore :: Bool
hasConnBefore, hasConnAfter :: Bool
hasConnAfter) = Line -> (Bool, Bool)
connAround Line
line
hasConnAround :: Bool
hasConnAround = Bool
hasConnBefore Bool -> Bool -> Bool
|| Bool
hasConnAfter
hasConnOver :: Bool
hasConnOver = Bool
hasConnHere Bool -> Bool -> Bool
|| Bool
hasConnBefore
hasConnUnder :: Bool
hasConnUnder = Bool
hasConnHere Bool -> Bool -> Bool
|| Bool
hasConnAfter
pointersSorted :: NonEmpty Pointer
pointersSorted = [Pointer] -> NonEmpty Pointer
forall a. [a] -> NonEmpty a
N.fromList ([Pointer] -> NonEmpty Pointer)
-> ([Pointer] -> [Pointer]) -> [Pointer] -> NonEmpty Pointer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pointer -> (Line, Line)) -> [Pointer] -> [Pointer]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Pointer -> (Line, Line)
pointerColumns ([Pointer] -> NonEmpty Pointer) -> [Pointer] -> NonEmpty Pointer
forall a b. (a -> b) -> a -> b
$ NonEmpty Pointer -> [Pointer]
forall a. NonEmpty a -> [a]
N.toList NonEmpty Pointer
pointers
pointersSorted' :: NonEmpty Pointer
pointersSorted' = NonEmpty Pointer -> NonEmpty Pointer
forall a. NonEmpty a -> NonEmpty a
N.reverse NonEmpty Pointer
pointersSorted
line :: Line
line = Pointer -> Line
pointerLine (Pointer -> Line) -> Pointer -> Line
forall a b. (a -> b) -> a -> b
$ NonEmpty Pointer -> Pointer
forall a. NonEmpty a -> a
N.head NonEmpty Pointer
pointers
sline :: Builder
sline = [(Line, Line)] -> Line -> Builder
showLine ((Pointer -> (Line, Line)) -> [Pointer] -> [(Line, Line)]
forall a b. (a -> b) -> [a] -> [b]
map Pointer -> (Line, Line)
pointerColumns (NonEmpty Pointer -> [Pointer]
forall a. NonEmpty a -> [a]
N.toList NonEmpty Pointer
pointersSorted)) Line
line
decorationLines :: [Builder]
decorationLines = if
| NonEmpty Pointer -> Line
forall a. NonEmpty a -> Line
N.length NonEmpty Pointer
pointersSorted' Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> [NonEmpty Pointer -> Builder
underline NonEmpty Pointer
pointersSorted']
| (Pointer -> Bool) -> [Pointer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe Body -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Body -> Bool) -> (Pointer -> Maybe Body) -> Pointer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pointer -> Maybe Body
pointerLabel) (NonEmpty Pointer -> [Pointer]
forall a. NonEmpty a -> [a]
N.tail NonEmpty Pointer
pointersSorted') -> [NonEmpty Pointer -> Builder
underline NonEmpty Pointer
pointersSorted']
| Bool
otherwise ->
let hasLabels :: [Pointer]
hasLabels = (Pointer -> Bool) -> [Pointer] -> [Pointer]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Body -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Body -> Bool) -> (Pointer -> Maybe Body) -> Pointer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pointer -> Maybe Body
pointerLabel) ([Pointer] -> [Pointer]) -> [Pointer] -> [Pointer]
forall a b. (a -> b) -> a -> b
$ NonEmpty Pointer -> [Pointer]
forall a. NonEmpty a -> [a]
N.tail NonEmpty Pointer
pointersSorted'
in NonEmpty Pointer -> Builder
underline NonEmpty Pointer
pointersSorted'
Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Pointer] -> Builder
connectors [Pointer]
hasLabels
Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: (Pointer -> ([Pointer], [Builder]) -> [Builder])
-> [Builder] -> [Pointer] -> [Builder]
forall a b. (a -> ([a], b) -> b) -> b -> [a] -> b
parar (\a :: Pointer
a (rest :: [Pointer]
rest, xs :: [Builder]
xs) -> [Pointer] -> Pointer -> Builder
connectorAndLabel [Pointer]
rest Pointer
a Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
xs) [] [Pointer]
hasLabels
underline :: N.NonEmpty Pointer -> TB.Builder
underline :: NonEmpty Pointer -> Builder
underline ps :: NonEmpty Pointer
ps =
let (decor :: Builder
decor, _) = (Line -> Bool -> [Pointer] -> Builder)
-> Builder -> (Line -> Builder) -> [Pointer] -> (Builder, Line)
foldDecorations
(\n :: Line
n isFirst :: Bool
isFirst rest :: [Pointer]
rest -> if
| Bool
isFirst Bool -> Bool -> Bool
&& (Pointer -> Bool) -> [Pointer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Pointer -> Bool
pointerConnect [Pointer]
rest Bool -> Bool -> Bool
&& Bool
hasConnAround -> Line -> Body -> Builder
replicateB Line
n Body
styleHorizontal
| Bool
isFirst -> Line -> Body -> Builder
replicateB Line
n " "
| (Pointer -> Bool) -> [Pointer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Pointer -> Bool
pointerConnect [Pointer]
rest -> Line -> Body -> Builder
replicateB Line
n Body
styleHorizontal
| Bool
otherwise -> Line -> Body -> Builder
replicateB Line
n " "
)
""
(\n :: Line
n -> Line -> Body -> Builder
replicateB Line
n Body
styleUnderline)
(NonEmpty Pointer -> [Pointer]
forall a. NonEmpty a -> [a]
N.toList NonEmpty Pointer
ps)
lbl :: Body
lbl = Body -> (Body -> Body) -> Maybe Body -> Body
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (" " Body -> Body -> Body
forall a. Semigroup a => a -> a -> a
<>) (Maybe Body -> Body) -> (Pointer -> Maybe Body) -> Pointer -> Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pointer -> Maybe Body
pointerLabel (Pointer -> Body) -> Pointer -> Body
forall a b. (a -> b) -> a -> b
$ NonEmpty Pointer -> Pointer
forall a. NonEmpty a -> a
N.head NonEmpty Pointer
ps
mid :: Body
mid = if
| Bool
hasConnHere Bool -> Bool -> Bool
&& Bool
hasConnBefore Bool -> Bool -> Bool
&& Bool
hasConnAfter -> Body
styleUpDownRight Body -> Body -> Body
forall a. Semigroup a => a -> a -> a
<> Body
styleHorizontal
| Bool
hasConnHere Bool -> Bool -> Bool
&& Bool
hasConnBefore -> Body
styleUpRight Body -> Body -> Body
forall a. Semigroup a => a -> a -> a
<> Body
styleHorizontal
| Bool
hasConnHere Bool -> Bool -> Bool
&& Bool
hasConnAfter -> Body
styleDownRight Body -> Body -> Body
forall a. Semigroup a => a -> a -> a
<> Body
styleHorizontal
| Bool
hasConnBefore Bool -> Bool -> Bool
&& Bool
hasConnAfter -> Body
styleVertical Body -> Body -> Body
forall a. Semigroup a => a -> a -> a
<> " "
| Bool
hasConnMulti -> " "
| Bool
otherwise -> ""
in Builder
prefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Body -> Builder
TB.fromText Body
mid Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
decor Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Body -> Builder
TB.fromText Body
lbl
connectors :: [Pointer] -> TB.Builder
connectors :: [Pointer] -> Builder
connectors ps :: [Pointer]
ps =
let (decor :: Builder
decor, _) = (Line -> Bool -> [Pointer] -> Builder)
-> Builder -> (Line -> Builder) -> [Pointer] -> (Builder, Line)
foldDecorations
(\n :: Line
n _ _ -> Line -> Body -> Builder
replicateB Line
n " ")
(Body -> Builder
TB.fromText Body
styleVertical)
(\n :: Line
n -> Line -> Body -> Builder
replicateB (Line
n Line -> Line -> Line
forall a. Num a => a -> a -> a
- 1) " ")
[Pointer]
ps
mid :: Body
mid = if
| Bool
hasConnOver Bool -> Bool -> Bool
&& Bool
hasConnAfter -> Body
styleVertical Body -> Body -> Body
forall a. Semigroup a => a -> a -> a
<> " "
| Bool
hasConnMulti -> " "
| Bool
otherwise -> ""
in Builder
prefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Body -> Builder
TB.fromText Body
mid Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
decor
connectorAndLabel :: [Pointer] -> Pointer -> TB.Builder
connectorAndLabel :: [Pointer] -> Pointer -> Builder
connectorAndLabel ps :: [Pointer]
ps p :: Pointer
p =
let (decor :: Builder
decor, finalCol :: Line
finalCol) = (Line -> Bool -> [Pointer] -> Builder)
-> Builder -> (Line -> Builder) -> [Pointer] -> (Builder, Line)
foldDecorations
(\n :: Line
n _ _ -> Line -> Body -> Builder
replicateB Line
n " ")
(Body -> Builder
TB.fromText Body
styleVertical)
(\n :: Line
n -> Line -> Body -> Builder
replicateB (Line
n Line -> Line -> Line
forall a. Num a => a -> a -> a
- 1) " ")
[Pointer]
ps
lbl :: Builder
lbl = Builder -> (Body -> Builder) -> Maybe Body -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ""
(\x :: Body
x -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Line -> Body -> Builder
replicateB (Pointer -> Line
pointerColStart Pointer
p Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
finalCol) " "
, Body -> Builder
TB.fromText Body
styleUpRight
, " "
, Body -> Builder
TB.fromText Body
x
]
)
(Pointer -> Maybe Body
pointerLabel Pointer
p)
mid :: Body
mid = if
| Bool
hasConnOver Bool -> Bool -> Bool
&& Bool
hasConnAfter -> Body
styleVertical Body -> Body -> Body
forall a. Semigroup a => a -> a -> a
<> " "
| Bool
hasConnMulti -> " "
| Bool
otherwise -> ""
in Builder
prefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Body -> Builder
TB.fromText Body
mid Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
decor Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
lbl
foldDecorations
:: (Column -> Bool -> [Pointer] -> TB.Builder)
-> TB.Builder
-> (Column -> TB.Builder)
-> [Pointer]
-> (TB.Builder, Column)
foldDecorations :: (Line -> Bool -> [Pointer] -> Builder)
-> Builder -> (Line -> Builder) -> [Pointer] -> (Builder, Line)
foldDecorations catchUp :: Line -> Bool -> [Pointer] -> Builder
catchUp something :: Builder
something reachAfter :: Line -> Builder
reachAfter ps :: [Pointer]
ps =
let (decor :: Builder
decor, finalCol :: Line
finalCol, _, _) = (Pointer
-> (Builder, Line, [Pointer], Bool)
-> (Builder, Line, [Pointer], Bool))
-> (Builder, Line, [Pointer], Bool)
-> [Pointer]
-> (Builder, Line, [Pointer], Bool)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\(Pointer {..}) (xs :: Builder
xs, c :: Line
c, rest :: [Pointer]
rest, isFirst :: Bool
isFirst) ->
( [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Builder
xs
, Line -> Bool -> [Pointer] -> Builder
catchUp (Line
pointerColStart Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
c) Bool
isFirst [Pointer]
rest
, Builder
something
, Line -> Builder
reachAfter (Line
pointerColEnd Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
pointerColStart)
]
, Line
pointerColEnd
, [Pointer] -> [Pointer]
forall a. [a] -> [a]
tail [Pointer]
rest
, Bool
False
)
)
("", 1, [Pointer] -> [Pointer]
forall a. [a] -> [a]
reverse [Pointer]
ps, Bool
True)
[Pointer]
ps
in (Builder
decor, Line
finalCol)
parar :: (a -> ([a], b) -> b) -> b -> [a] -> b
parar :: (a -> ([a], b) -> b) -> b -> [a] -> b
parar _ b :: b
b [] = b
b
parar f :: a -> ([a], b) -> b
f b :: b
b (a :: a
a:as :: [a]
as) = a -> ([a], b) -> b
f a
a ([a]
as, (a -> ([a], b) -> b) -> b -> [a] -> b
forall a b. (a -> ([a], b) -> b) -> b -> [a] -> b
parar a -> ([a], b) -> b
f b
b [a]
as)
unsplit :: TB.Builder -> [TB.Builder] -> TB.Builder
unsplit :: Builder -> [Builder] -> Builder
unsplit _ [] = ""
unsplit a :: Builder
a (x :: Builder
x:xs :: [Builder]
xs) = (Builder -> Builder -> Builder) -> Builder -> [Builder] -> Builder
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\acc :: Builder
acc y :: Builder
y -> Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
y) Builder
x [Builder]
xs
{-# INLINE unsplit #-}
replicateB :: Int -> T.Text -> TB.Builder
replicateB :: Line -> Body -> Builder
replicateB n :: Line
n xs :: Body
xs = Body -> Builder
TB.fromText (Line -> Body -> Body
T.replicate Line
n Body
xs)
{-# INLINE replicateB #-}
indexLines :: A.Array Int s -> Int -> Maybe s
indexLines :: Array Line s -> Line -> Maybe s
indexLines slines :: Array Line s
slines i :: Line
i = if (Line, Line) -> Line -> Bool
forall a. Ix a => (a, a) -> a -> Bool
A.inRange (Array Line s -> (Line, Line)
forall i e. Array i e -> (i, i)
A.bounds Array Line s
slines) Line
i
then s -> Maybe s
forall a. a -> Maybe a
Just (Array Line s -> Line -> s
forall i e. Array i e -> Line -> e
A.unsafeAt Array Line s
slines Line
i)
else Maybe s
forall a. Maybe a
Nothing
{-# INLINE indexLines #-}