{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns        #-}

{- |
Module      : Errata.Internal.Render
Copyright   : (c) 2020 comp
License     : MIT
Maintainer  : onecomputer00@gmail.com
Stability   : stable
Portability : portable

Functions for rendering the errors. You should not need to import this, as these functions are lower-level.

This module is internal, and may break across non-breaking versions.
-}
module Errata.Internal.Render
    ( renderErrors
    , renderErrata
    , renderBlock
    , renderSourceLines
    , groupBlockPointers
    , slices
    , makeSourceTable
    ) where

import           Control.Applicative (ZipList(..))
import qualified Data.IntMap as I
import           Data.List (foldl', inits, sortOn)
import           Data.Maybe (isJust)
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as TB
import           Errata.Source
import           Errata.Types

-- | Renders a collection of 'Errata'.
renderErrors :: Source source => source -> [Errata] -> TB.Builder
renderErrors :: source -> [Errata] -> Builder
renderErrors source
source [Errata]
errs = Builder
errorMessage
    where
        -- The pointers grouped by line, for each Errata.
        blockPointersGrouped :: [[IntMap [Pointer]]]
blockPointersGrouped = (Errata -> [IntMap [Pointer]]) -> [Errata] -> [[IntMap [Pointer]]]
forall a b. (a -> b) -> [a] -> [b]
map ((Block -> IntMap [Pointer]) -> [Block] -> [IntMap [Pointer]]
forall a b. (a -> b) -> [a] -> [b]
map Block -> IntMap [Pointer]
groupBlockPointers ([Block] -> [IntMap [Pointer]])
-> (Errata -> [Block]) -> Errata -> [IntMap [Pointer]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Errata -> [Block]
errataBlocks) [Errata]
errs

        -- Min and max line numbers as defined by the pointers of each block, for each Errata.
        minPointers :: [[Key]]
minPointers = (([IntMap [Pointer]] -> [Key]) -> [[IntMap [Pointer]]] -> [[Key]]
forall a b. (a -> b) -> [a] -> [b]
map (([IntMap [Pointer]] -> [Key]) -> [[IntMap [Pointer]]] -> [[Key]])
-> ((IntMap [Pointer] -> Key) -> [IntMap [Pointer]] -> [Key])
-> (IntMap [Pointer] -> Key)
-> [[IntMap [Pointer]]]
-> [[Key]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap [Pointer] -> Key) -> [IntMap [Pointer]] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map) (Key -> (Key -> Key) -> Maybe Key -> Key
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Key
1 Key -> Key
forall a. a -> a
id (Maybe Key -> Key)
-> (IntMap [Pointer] -> Maybe Key) -> IntMap [Pointer] -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, [Pointer]) -> Key) -> Maybe (Key, [Pointer]) -> Maybe Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key, [Pointer]) -> Key
forall a b. (a, b) -> a
fst (Maybe (Key, [Pointer]) -> Maybe Key)
-> (IntMap [Pointer] -> Maybe (Key, [Pointer]))
-> IntMap [Pointer]
-> Maybe Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap [Pointer] -> Maybe (Key, [Pointer])
forall a. IntMap a -> Maybe (Key, a)
I.lookupMin) [[IntMap [Pointer]]]
blockPointersGrouped
        maxPointers :: [[Key]]
maxPointers = (([IntMap [Pointer]] -> [Key]) -> [[IntMap [Pointer]]] -> [[Key]]
forall a b. (a -> b) -> [a] -> [b]
map (([IntMap [Pointer]] -> [Key]) -> [[IntMap [Pointer]]] -> [[Key]])
-> ((IntMap [Pointer] -> Key) -> [IntMap [Pointer]] -> [Key])
-> (IntMap [Pointer] -> Key)
-> [[IntMap [Pointer]]]
-> [[Key]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap [Pointer] -> Key) -> [IntMap [Pointer]] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map) (Key -> (Key -> Key) -> Maybe Key -> Key
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Key
0 Key -> Key
forall a. a -> a
id (Maybe Key -> Key)
-> (IntMap [Pointer] -> Maybe Key) -> IntMap [Pointer] -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, [Pointer]) -> Key) -> Maybe (Key, [Pointer]) -> Maybe Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key, [Pointer]) -> Key
forall a b. (a, b) -> a
fst (Maybe (Key, [Pointer]) -> Maybe Key)
-> (IntMap [Pointer] -> Maybe (Key, [Pointer]))
-> IntMap [Pointer]
-> Maybe Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap [Pointer] -> Maybe (Key, [Pointer])
forall a. IntMap a -> Maybe (Key, a)
I.lookupMax) [[IntMap [Pointer]]]
blockPointersGrouped

        minLine :: Key
minLine = [Key] -> Key
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([[Key]] -> [Key]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Key]]
minPointers)
        maxLine :: Key
maxLine = [Key] -> Key
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([[Key]] -> [Key]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Key]]
maxPointers)

        {- Optimization: we use a Patricia tree (IntMap) indexed by start line
        into respective tail slices of the list of source lines @slines@.

        If we were to use the list @slines@ as-is:
            O(n) seeking per source block, O(n) traversal
        Since, we would be linearly traversing to the start of each source block every
        time with no caching for future source blocks at (or close to) the same starting
        line as previous source blocks.

        If we were to use an IntMap of source lines by itself:
            Seeking becomes free, at the expense of O(n log n) traversal per source block
        Since, we are performing an O(log n) average case Patricia lookup per line.

        Whereas if we use a hybrid IntMap + association list approach:
            O(n + log n) worst case, O(log n) average case, seeking per source block, O(n) traversal
        Worse case is unevaluated slices, as this would force @slices@ evaluation, which is
        an O(n) list traversal, on top of an O(log n) Patricia lookup. Partially-evaluated leafs will
        have slightly better asymptotics, and fully-evaluated leafs will be O(log n) average case,
        which is just the cost of a Patricia lookup.

        For sufficiently large block counts with scattered pointers per block, which we assume
        holds for real-world use cases, the traversal savings on repeat lookups will quickly favor
        hybrid association list + IntMap asymptotics.
        -}
        srcTable :: IntMap [source]
srcTable = Key -> Key -> [source] -> IntMap [source]
forall a. Monoid a => Key -> Key -> [a] -> IntMap [a]
makeSourceTable Key
minLine Key
maxLine (source -> [source]
forall s. Source s => s -> [s]
sourceToLines source
source)

        errataMessages :: [Builder]
errataMessages = ZipList Builder -> [Builder]
forall a. ZipList a -> [a]
getZipList (ZipList Builder -> [Builder]) -> ZipList Builder -> [Builder]
forall a b. (a -> b) -> a -> b
$ IntMap [source]
-> Errata -> [IntMap [Pointer]] -> [Key] -> [Key] -> Builder
forall source.
Source source =>
IntMap [source]
-> Errata -> [IntMap [Pointer]] -> [Key] -> [Key] -> Builder
renderErrata IntMap [source]
srcTable
            (Errata -> [IntMap [Pointer]] -> [Key] -> [Key] -> Builder)
-> ZipList Errata
-> ZipList ([IntMap [Pointer]] -> [Key] -> [Key] -> Builder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Errata] -> ZipList Errata
forall a. [a] -> ZipList a
ZipList [Errata]
errs
            ZipList ([IntMap [Pointer]] -> [Key] -> [Key] -> Builder)
-> ZipList [IntMap [Pointer]]
-> ZipList ([Key] -> [Key] -> Builder)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [[IntMap [Pointer]]] -> ZipList [IntMap [Pointer]]
forall a. [a] -> ZipList a
ZipList [[IntMap [Pointer]]]
blockPointersGrouped
            ZipList ([Key] -> [Key] -> Builder)
-> ZipList [Key] -> ZipList ([Key] -> Builder)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [[Key]] -> ZipList [Key]
forall a. [a] -> ZipList a
ZipList [[Key]]
minPointers
            ZipList ([Key] -> Builder) -> ZipList [Key] -> ZipList Builder
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [[Key]] -> ZipList [Key]
forall a. [a] -> ZipList a
ZipList [[Key]]
maxPointers

        errorMessage :: Builder
errorMessage = Builder -> [Builder] -> Builder
unsplit Builder
"\n\n" [Builder]
errataMessages

-- | Group the pointers of a block by the line they appear on.
groupBlockPointers :: Block -> I.IntMap [Pointer]
groupBlockPointers :: Block -> IntMap [Pointer]
groupBlockPointers = ([Pointer] -> [Pointer] -> [Pointer])
-> [(Key, [Pointer])] -> IntMap [Pointer]
forall a. (a -> a -> a) -> [(Key, a)] -> IntMap a
I.fromListWith [Pointer] -> [Pointer] -> [Pointer]
forall a. Semigroup a => a -> a -> a
(<>) ([(Key, [Pointer])] -> IntMap [Pointer])
-> (Block -> [(Key, [Pointer])]) -> Block -> IntMap [Pointer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pointer -> (Key, [Pointer])) -> [Pointer] -> [(Key, [Pointer])]
forall a b. (a -> b) -> [a] -> [b]
map (\Pointer
p -> (Pointer -> Key
pointerLine Pointer
p, Pointer -> [Pointer]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pointer
p)) ([Pointer] -> [(Key, [Pointer])])
-> (Block -> [Pointer]) -> Block -> [(Key, [Pointer])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> [Pointer]
blockPointers

-- | Create a source table from the given line span and source lines.
makeSourceTable :: Monoid a => Line -> Line -> [a] -> I.IntMap [a]
makeSourceTable :: Key -> Key -> [a] -> IntMap [a]
makeSourceTable Key
minLine Key
maxLine [a]
slines = [(Key, [a])] -> IntMap [a]
forall a. [(Key, a)] -> IntMap a
I.fromDistinctAscList ([(Key, [a])] -> IntMap [a]) -> [(Key, [a])] -> IntMap [a]
forall a b. (a -> b) -> a -> b
$
    [Key] -> [[a]] -> [(Key, [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key
minLine .. Key
maxLine] (Key -> [[a]] -> [[a]]
forall a. Key -> [a] -> [a]
drop (Key
minLine Key -> Key -> Key
forall a. Num a => a -> a -> a
- Key
1) ([a] -> [[a]]
forall a. Monoid a => [a] -> [[a]]
slices [a]
slines))

{- | Turns a list into a list of tail slices of the original list, with each element at index @i@ dropping
the first @i@ elements of the original list and tailing a 'mempty'.

This allows for correct behavior on out-of-source-bounds pointers.
-}
slices :: Monoid a => [a] -> [[a]]
slices :: [a] -> [[a]]
slices [] = [a] -> [[a]]
forall a. a -> [a]
repeat (a -> [a]
forall a. a -> [a]
repeat a
forall a. Monoid a => a
mempty)
slices [a]
xs = ([a]
xs [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> a -> [a]
forall a. a -> [a]
repeat a
forall a. Monoid a => a
mempty) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
forall a. Monoid a => [a] -> [[a]]
slices ([a] -> [a]
forall a. [a] -> [a]
tail [a]
xs)

-- | Renders a single 'Errata'.
renderErrata
    :: Source source
    => I.IntMap [source]    -- ^ The source table.
    -> Errata               -- ^ The 'Errata' to render.
    -> [I.IntMap [Pointer]] -- ^ The pointers of each block grouped by line.
    -> [Line]               -- ^ The mininum line of each block.
    -> [Line]               -- ^ The maxinum line of each block.
    -> TB.Builder
renderErrata :: IntMap [source]
-> Errata -> [IntMap [Pointer]] -> [Key] -> [Key] -> Builder
renderErrata IntMap [source]
srcTable (Errata {[Block]
Maybe Body
errataBody :: Errata -> Maybe Body
errataHeader :: Errata -> Maybe Body
errataBody :: Maybe Body
errataBlocks :: [Block]
errataHeader :: Maybe Body
errataBlocks :: Errata -> [Block]
..}) [IntMap [Pointer]]
blockPointersGrouped [Key]
minPointers [Key]
maxPointers = Builder
errorMessage
    where
        blockMessages :: [Builder]
blockMessages = ZipList Builder -> [Builder]
forall a. ZipList a -> [a]
getZipList (ZipList Builder -> [Builder]) -> ZipList Builder -> [Builder]
forall a b. (a -> b) -> a -> b
$ IntMap [source]
-> Block -> IntMap [Pointer] -> (Key, Key) -> Builder
forall source.
Source source =>
IntMap [source]
-> Block -> IntMap [Pointer] -> (Key, Key) -> Builder
renderBlock IntMap [source]
srcTable
            (Block -> IntMap [Pointer] -> (Key, Key) -> Builder)
-> ZipList Block
-> ZipList (IntMap [Pointer] -> (Key, Key) -> Builder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> ZipList Block
forall a. [a] -> ZipList a
ZipList [Block]
errataBlocks
            ZipList (IntMap [Pointer] -> (Key, Key) -> Builder)
-> ZipList (IntMap [Pointer]) -> ZipList ((Key, Key) -> Builder)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [IntMap [Pointer]] -> ZipList (IntMap [Pointer])
forall a. [a] -> ZipList a
ZipList [IntMap [Pointer]]
blockPointersGrouped
            ZipList ((Key, Key) -> Builder)
-> ZipList (Key, Key) -> ZipList Builder
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(Key, Key)] -> ZipList (Key, Key)
forall a. [a] -> ZipList a
ZipList ([Key] -> [Key] -> [(Key, Key)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
minPointers [Key]
maxPointers)

        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. a -> a
id Maybe Body
errataHeader
            , case [Builder]
blockMessages of
                [] -> Builder
""
                [Builder]
xs -> case Maybe Body
errataHeader of
                    Maybe Body
Nothing -> Builder -> [Builder] -> Builder
unsplit Builder
"\n\n" [Builder]
xs
                    Just Body
_  -> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> [Builder] -> Builder
unsplit Builder
"\n\n" [Builder]
xs
            , 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
"\n" Body -> Body -> Body
forall a. Semigroup a => a -> a -> a
<>) Maybe Body
errataBody
            ]

-- | Renders a single block.
renderBlock
    :: Source source
    => I.IntMap [source]  -- ^ The source table.
    -> Block              -- ^ The block to render.
    -> I.IntMap [Pointer] -- ^ The pointers of this block grouped by line.
    -> (Line, Line)       -- ^ The mininum and maximum lines of this block.
    -> TB.Builder
renderBlock :: IntMap [source]
-> Block -> IntMap [Pointer] -> (Key, Key) -> Builder
renderBlock IntMap [source]
srcTable block :: Block
block@(Block {[Pointer]
Maybe Body
(FilePath, Key, Key)
Style
blockBody :: Block -> Maybe Body
blockHeader :: Block -> Maybe Body
blockLocation :: Block -> (FilePath, Key, Key)
blockStyle :: Block -> Style
blockBody :: Maybe Body
blockPointers :: [Pointer]
blockHeader :: Maybe Body
blockLocation :: (FilePath, Key, Key)
blockStyle :: Style
blockPointers :: Block -> [Pointer]
..}) IntMap [Pointer]
blockPointersGrouped ~(Key
minBlockLine, Key
maxBlockLine) = Builder
blockMessage
    where
        slines :: [(Key, source)]
slines = [Key] -> [source] -> [(Key, source)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key
minBlockLine .. Key
maxBlockLine] ([source] -> ([source] -> [source]) -> Maybe [source] -> [source]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [source] -> [source]
forall a. a -> a
id (Maybe [source] -> [source]) -> Maybe [source] -> [source]
forall a b. (a -> b) -> a -> b
$ Key -> IntMap [source] -> Maybe [source]
forall a. Key -> IntMap a -> Maybe a
I.lookup Key
minBlockLine IntMap [source]
srcTable)

        -- Padding size before the line prefix.
        padding :: Key
padding = FilePath -> Key
forall (t :: * -> *) a. Foldable t => t a -> Key
length (Key -> FilePath
forall a. Show a => a -> FilePath
show Key
maxBlockLine)

        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, Key, Key) -> Body
styleLocation Style
blockStyle (FilePath, Key, Key)
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 Body
"" (Body
"\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 Builder
"" (Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Maybe Builder -> Builder) -> Maybe Builder -> Builder
forall a b. (a -> b) -> a -> b
$ [(Key, source)]
-> Block -> Key -> IntMap [Pointer] -> Maybe Builder
forall source.
Source source =>
[(Key, source)]
-> Block -> Key -> IntMap [Pointer] -> Maybe Builder
renderSourceLines [(Key, source)]
slines Block
block Key
padding IntMap [Pointer]
blockPointersGrouped
            , 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
"\n" Body -> Body -> Body
forall a. Semigroup a => a -> a -> a
<>) Maybe Body
blockBody
            ]

-- | Renders the source lines for a block.
renderSourceLines
    :: forall source
    .  Source source
    => [(Line, source)]   -- ^ The source lines, from the minimum line to the maximum line for the block.
    -> Block              -- ^ The block to render.
    -> Int                -- ^ The length of the actual number of the maximum line.
    -> I.IntMap [Pointer] -- ^ The pointers of this block grouped by line.
    -> Maybe (TB.Builder)
renderSourceLines :: [(Key, source)]
-> Block -> Key -> IntMap [Pointer] -> Maybe Builder
renderSourceLines [(Key, source)]
_ Block
_ Key
_ (IntMap [Pointer] -> Bool
forall a. IntMap a -> Bool
I.null -> Bool
True) = Maybe Builder
forall a. Maybe a
Nothing
renderSourceLines [(Key, source)]
slines (Block {[Pointer]
Maybe Body
(FilePath, Key, Key)
Style
blockBody :: Maybe Body
blockPointers :: [Pointer]
blockHeader :: Maybe Body
blockLocation :: (FilePath, Key, Key)
blockStyle :: Style
blockBody :: Block -> Maybe Body
blockHeader :: Block -> Maybe Body
blockLocation :: Block -> (FilePath, Key, Key)
blockStyle :: Block -> Style
blockPointers :: Block -> [Pointer]
..}) Key
padding IntMap [Pointer]
pointersGrouped = Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> Builder
unsplit Builder
"\n" [Builder]
sourceLines
    where
        Style {Body
Key -> Body
[(Key, Key)] -> Body -> Body
(FilePath, Key, Key) -> Body
styleUpDownRight :: Style -> Body
styleUpRight :: Style -> Body
styleDownRight :: Style -> Body
styleHorizontal :: Style -> Body
styleVertical :: Style -> Body
styleUnderline :: Style -> Body
styleLinePrefix :: Style -> Body
styleEllipsis :: Style -> Body
styleLine :: Style -> [(Key, Key)] -> Body -> Body
styleNumber :: Style -> Key -> Body
styleUpDownRight :: Body
styleUpRight :: Body
styleDownRight :: Body
styleHorizontal :: Body
styleVertical :: Body
styleUnderline :: Body
styleLinePrefix :: Body
styleEllipsis :: Body
styleLine :: [(Key, Key)] -> Body -> Body
styleNumber :: Key -> Body
styleLocation :: (FilePath, Key, Key) -> Body
styleLocation :: Style -> (FilePath, Key, Key) -> Body
..} = Style
blockStyle

        -- Shows a line in accordance to the style.
        -- We might get a line that's out-of-bounds, usually the EOF line, so we can default to empty.
        showLine :: [(Column, Column)] -> source -> TB.Builder
        showLine :: [(Key, Key)] -> source -> Builder
showLine [(Key, Key)]
hs = Body -> Builder
TB.fromText (Body -> Builder) -> (source -> Body) -> source -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Key)] -> Body -> Body
styleLine [(Key, Key)]
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

        -- Generic prefix without line number.
        prefix :: Builder
prefix = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
            [ Key -> Body -> Builder
replicateB Key
padding Body
" ", Builder
" ", Body -> Builder
TB.fromText Body
styleLinePrefix, Builder
" "
            ]

        -- Prefix for omitting lines when spanning many lines.
        omitPrefix :: Builder
omitPrefix = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
            [ Body -> Builder
TB.fromText Body
styleEllipsis, Key -> Body -> Builder
replicateB (Key
padding Key -> Key -> Key
forall a. Num a => a -> a -> a
- Key
1) Body
" ", Builder
" ", Body -> Builder
TB.fromText Body
styleLinePrefix, Builder
" "
            ]

        -- Prefix with a line number.
        linePrefix :: Line -> TB.Builder
        linePrefix :: Key -> Builder
linePrefix Key
n = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
            [ Body -> Builder
TB.fromText (Key -> Body
styleNumber Key
n), Key -> Body -> Builder
replicateB (Key
padding Key -> Key -> Key
forall a. Num a => a -> a -> a
- FilePath -> Key
forall (t :: * -> *) a. Foldable t => t a -> Key
length (Key -> FilePath
forall a. Show a => a -> FilePath
show Key
n)) Body
" ", Builder
" "
            , Body -> Builder
TB.fromText Body
styleLinePrefix, Builder
" "
            ]

        -- The resulting source lines.
        -- Extra prefix for padding.
        sourceLines :: [Builder]
sourceLines = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Key -> Body -> Builder
replicateB Key
padding Body
" ", Builder
" ", Body -> Builder
TB.fromText Body
styleLinePrefix]
            Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Key -> [(Key, source)] -> [Builder]
makeSourceLines Key
0 [(Key, source)]
slines

        -- Whether there will be a multiline span.
        hasConnMulti :: Bool
hasConnMulti = IntMap [Pointer] -> Key
forall a. IntMap a -> Key
I.size (([Pointer] -> Bool) -> IntMap [Pointer] -> IntMap [Pointer]
forall a. (a -> Bool) -> IntMap a -> IntMap a
I.filter ((Pointer -> Bool) -> [Pointer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Pointer -> Bool
pointerConnect) IntMap [Pointer]
pointersGrouped) Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
> Key
1

        -- Whether line /n/ has a connection to somewhere else (including the same line).
        hasConn :: Line -> Bool
        hasConn :: Key -> Bool
hasConn Key
n = Bool -> ([Pointer] -> Bool) -> Maybe [Pointer] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Pointer -> Bool) -> [Pointer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Pointer -> Bool
pointerConnect) (Maybe [Pointer] -> Bool) -> Maybe [Pointer] -> Bool
forall a b. (a -> b) -> a -> b
$ Key -> IntMap [Pointer] -> Maybe [Pointer]
forall a. Key -> IntMap a -> Maybe a
I.lookup Key
n IntMap [Pointer]
pointersGrouped

        -- Whether line /n/ has a connection to a line before or after it (but not including).
        connAround :: Line -> (Bool, Bool)
        connAround :: Key -> (Bool, Bool)
connAround Key
n =
            let (IntMap [Pointer]
a, IntMap [Pointer]
b) = Key -> IntMap [Pointer] -> (IntMap [Pointer], IntMap [Pointer])
forall a. Key -> IntMap a -> (IntMap a, IntMap a)
I.split Key
n IntMap [Pointer]
pointersGrouped
            in ((([Pointer] -> Bool) -> IntMap [Pointer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (([Pointer] -> Bool) -> IntMap [Pointer] -> Bool)
-> ((Pointer -> Bool) -> [Pointer] -> Bool)
-> (Pointer -> Bool)
-> IntMap [Pointer]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pointer -> Bool) -> [Pointer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any) Pointer -> Bool
pointerConnect IntMap [Pointer]
a, (([Pointer] -> Bool) -> IntMap [Pointer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (([Pointer] -> Bool) -> IntMap [Pointer] -> Bool)
-> ((Pointer -> Bool) -> [Pointer] -> Bool)
-> (Pointer -> Bool)
-> IntMap [Pointer]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pointer -> Bool) -> [Pointer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any) Pointer -> Bool
pointerConnect IntMap [Pointer]
b)

        -- Makes the source lines.
        -- We have an @extra@ parameter to keep track of extra lines when spanning multiple lines.
        makeSourceLines :: Line -> [(Line, source)] -> [TB.Builder]

        -- No lines left.
        makeSourceLines :: Key -> [(Key, source)] -> [Builder]
makeSourceLines Key
_ [] = []

        -- The next line is a line we have to decorate with pointers.
        makeSourceLines Key
_ (pr :: (Key, source)
pr@(Key
n, source
_):[(Key, source)]
ns)
            | Just [Pointer]
p <- Key -> IntMap [Pointer] -> Maybe [Pointer]
forall a. Key -> IntMap a -> Maybe a
I.lookup Key
n IntMap [Pointer]
pointersGrouped = [Pointer] -> (Key, source) -> [Builder]
makeDecoratedLines [Pointer]
p (Key, source)
pr [Builder] -> [Builder] -> [Builder]
forall a. Semigroup a => a -> a -> a
<> Key -> [(Key, source)] -> [Builder]
makeSourceLines Key
0 [(Key, source)]
ns

        -- The next line is an extra line, within a limit (currently 2, may be configurable later).
        makeSourceLines Key
extra ((Key
n, source
l):[(Key, source)]
ns)
            | Key
extra Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
< Key
2 =
                let mid :: Builder
mid = if
                        | (Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd (Key -> (Bool, Bool)
connAround Key
n) -> Body -> Builder
TB.fromText Body
styleVertical Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" "
                        | Bool
hasConnMulti       -> Builder
"  "
                        | Bool
otherwise          -> Builder
""
                in (Key -> Builder
linePrefix Key
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
mid Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [(Key, Key)] -> source -> Builder
showLine [] source
l) Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Key -> [(Key, source)] -> [Builder]
makeSourceLines (Key
extra Key -> Key -> Key
forall a. Num a => a -> a -> a
+ Key
1) [(Key, source)]
ns

        -- We reached the extra line limit, so now there's some logic to figure out what's next.
        makeSourceLines Key
_ [(Key, source)]
ns =
            let ([(Key, source)]
es, [(Key, source)]
ns') = ((Key, source) -> Bool)
-> [(Key, source)] -> ([(Key, source)], [(Key, source)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((Key -> IntMap [Pointer] -> Bool
forall a. Key -> IntMap a -> Bool
`I.member` IntMap [Pointer]
pointersGrouped) (Key -> Bool) -> ((Key, source) -> Key) -> (Key, source) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, source) -> Key
forall a b. (a, b) -> a
fst) [(Key, source)]
ns
            in case ([(Key, source)]
es, [(Key, source)]
ns') of
                -- There were no lines left to decorate anyways.
                ([(Key, source)]
_, []) -> []

                -- There are lines left to decorate, and it came right after.
                ([], [(Key, source)]
_) -> Key -> [(Key, source)] -> [Builder]
makeSourceLines Key
0 [(Key, source)]
ns'

                -- There is a single extra line, so we can use that as the before-line.
                -- No need for omission, because it came right before.
                ([(Key
n, source
l)], [(Key, source)]
_) ->
                    let mid :: Builder
mid = if
                            | (Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd (Key -> (Bool, Bool)
connAround Key
n) -> Body -> Builder
TB.fromText Body
styleVertical Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" "
                            | Bool
hasConnMulti       -> Builder
"  "
                            | Bool
otherwise          -> Builder
""
                    in (Key -> Builder
linePrefix Key
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
mid Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [(Key, Key)] -> source -> Builder
showLine [] source
l) Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Key -> [(Key, source)] -> [Builder]
makeSourceLines Key
0 [(Key, source)]
ns'

                -- There are more than one line in between, so we omit all but the last.
                -- We use the last one as the before-line.
                ([(Key, source)]
_, [(Key, source)]
_) ->
                    let (Key
n, source
l) = [(Key, source)] -> (Key, source)
forall a. [a] -> a
last [(Key, source)]
es
                        mid :: Builder
mid = if
                            | (Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd (Key -> (Bool, Bool)
connAround Key
n) -> Body -> Builder
TB.fromText Body
styleVertical Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" "
                            | Bool
hasConnMulti       -> Builder
"  "
                            | Bool
otherwise          -> Builder
""
                    in (Builder
omitPrefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
mid) Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: (Key -> Builder
linePrefix Key
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
mid Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [(Key, Key)] -> source -> Builder
showLine [] source
l) Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Key -> [(Key, source)] -> [Builder]
makeSourceLines Key
0 [(Key, source)]
ns'

        -- Decorate a line that has pointers.
        -- The pointers we get are assumed to be all on the same line.
        makeDecoratedLines :: [Pointer] -> (Line, source) -> [TB.Builder]
        makeDecoratedLines :: [Pointer] -> (Key, source) -> [Builder]
makeDecoratedLines [Pointer]
pointers (Key
num, source
line) =
            (Key -> Builder
linePrefix Key
num 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
<> Body
" "
                    | Bool
hasConnMulti                  -> Body
"  "
                    | Bool
otherwise                     -> Body
""

                -- Shortcuts to where this line connects to.
                hasConnHere :: Bool
hasConnHere = Key -> Bool
hasConn Key
num
                (Bool
hasConnBefore, Bool
hasConnAfter) = Key -> (Bool, Bool)
connAround Key
num
                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

                -- The sorted pointers by column.
                pointersSorted :: [Pointer]
pointersSorted = (Pointer -> (Key, Key)) -> [Pointer] -> [Pointer]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Pointer -> (Key, Key)
pointerColumns [Pointer]
pointers

                -- The line number we're on.
                sline :: Builder
sline = [(Key, Key)] -> source -> Builder
showLine ((Pointer -> (Key, Key)) -> [Pointer] -> [(Key, Key)]
forall a b. (a -> b) -> [a] -> [b]
map Pointer -> (Key, Key)
pointerColumns [Pointer]
pointersSorted) source
line

                -- The resulting decoration lines.
                decorationLines :: [Builder]
decorationLines = case (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]
forall a. [a] -> [a]
init [Pointer]
pointersSorted) of
                    -- There's only one pointer, so no need for more than just an underline and label.
                    [Pointer]
_ | [Pointer] -> Key
forall (t :: * -> *) a. Foldable t => t a -> Key
length [Pointer]
pointersSorted Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
1 -> [[Pointer] -> Builder
underline [Pointer]
pointersSorted]

                    -- There's no labels at all, so we just need the underline.
                    [] -> [[Pointer] -> Builder
underline [Pointer]
pointersSorted]

                    -- Otherwise, we have three steps to do:
                    -- The underline directly underneath.
                    -- An extra connector for the labels other than the rightmost one.
                    -- The remaining connectors and the labels.
                    [Pointer]
hasLabels -> [Pointer] -> Builder
underline [Pointer]
pointersSorted
                        Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Pointer] -> Builder
connectors [Pointer]
hasLabels
                        Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: (([Pointer] -> Builder) -> [[Pointer]] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map [Pointer] -> Builder
connectorAndLabel ([[Pointer]] -> [Builder])
-> ([[Pointer]] -> [[Pointer]]) -> [[Pointer]] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Pointer]] -> [[Pointer]]
forall a. [a] -> [a]
reverse ([[Pointer]] -> [[Pointer]])
-> ([[Pointer]] -> [[Pointer]]) -> [[Pointer]] -> [[Pointer]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Pointer]] -> [[Pointer]]
forall a. [a] -> [a]
tail ([[Pointer]] -> [Builder]) -> [[Pointer]] -> [Builder]
forall a b. (a -> b) -> a -> b
$ [Pointer] -> [[Pointer]]
forall a. [a] -> [[a]]
inits [Pointer]
hasLabels)

                -- Create an underline directly under the source. The last pointer can have a label on this line.
                underline :: [Pointer] -> TB.Builder
                underline :: [Pointer] -> Builder
underline [Pointer]
ps =
                    let (Builder
decor, Key
_) = (Key -> Bool -> [Pointer] -> Builder)
-> (Key -> (Key, Builder)) -> [Pointer] -> (Builder, Key)
foldDecorations
                            (\Key
n Bool
isFirst [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 -> Key -> Body -> Builder
replicateB Key
n Body
styleHorizontal
                                | Bool
isFirst                                             -> Key -> Body -> Builder
replicateB Key
n Body
" "
                                | (Pointer -> Bool) -> [Pointer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Pointer -> Bool
pointerConnect [Pointer]
rest                             -> Key -> Body -> Builder
replicateB Key
n Body
styleHorizontal
                                | Bool
otherwise                                           -> Key -> Body -> Builder
replicateB Key
n Body
" "
                            )
                            (\Key
n -> (Key
n, Key -> Body -> Builder
replicateB Key
n Body
styleUnderline))
                            [Pointer]
ps
                        lbl :: Body
lbl = Body -> (Body -> Body) -> Maybe Body -> Body
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Body
"" (Body
" " 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
$ [Pointer] -> Pointer
forall a. [a] -> a
last [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
<> Body
" "
                            | Bool
hasConnMulti                                 -> Body
"  "
                            | Bool
otherwise                                    -> Body
""
                    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

                -- Create connectors underneath. No labels are rendered here.
                connectors :: [Pointer] -> TB.Builder
                connectors :: [Pointer] -> Builder
connectors [Pointer]
ps =
                    let (Builder
decor, Key
_) = (Key -> Bool -> [Pointer] -> Builder)
-> (Key -> (Key, Builder)) -> [Pointer] -> (Builder, Key)
foldDecorations
                            (\Key
n Bool
_ [Pointer]
_ -> Key -> Body -> Builder
replicateB Key
n Body
" ")
                            (\Key
_ -> (Key
1, Body -> Builder
TB.fromText Body
styleVertical))
                            [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
<> Body
" "
                            | Bool
hasConnMulti                -> Body
"  "
                            | Bool
otherwise                   -> Body
""
                    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

                -- Create connectors and labels underneath. The last pointer can have a label on this line.
                connectorAndLabel :: [Pointer] -> TB.Builder
                connectorAndLabel :: [Pointer] -> Builder
connectorAndLabel [Pointer]
ps =
                    let (Builder
decor, Key
finalCol) = (Key -> Bool -> [Pointer] -> Builder)
-> (Key -> (Key, Builder)) -> [Pointer] -> (Builder, Key)
foldDecorations
                            (\Key
n Bool
_ [Pointer]
_ -> Key -> Body -> Builder
replicateB Key
n Body
" ")
                            (\Key
_ -> (Key
1, Body -> Builder
TB.fromText Body
styleVertical))
                            ([Pointer] -> [Pointer]
forall a. [a] -> [a]
init [Pointer]
ps)
                        lbl :: Builder
lbl = Builder -> (Body -> Builder) -> Maybe Body -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
""
                            (\Body
x -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
                                [ Key -> Body -> Builder
replicateB (Pointer -> Key
pointerColStart ([Pointer] -> Pointer
forall a. [a] -> a
last [Pointer]
ps) Key -> Key -> Key
forall a. Num a => a -> a -> a
- Key
finalCol) Body
" "
                                , Body -> Builder
TB.fromText Body
styleUpRight
                                , Builder
" "
                                , Body -> Builder
TB.fromText Body
x
                                ]
                            )
                            (Pointer -> Maybe Body
pointerLabel ([Pointer] -> Pointer
forall a. [a] -> a
last [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
<> Body
" "
                            | Bool
hasConnMulti                -> Body
"  "
                            | Bool
otherwise                   -> Body
""
                    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

-- | Makes a line of decorations below the source.
foldDecorations
    :: (Column -> Bool -> [Pointer] -> TB.Builder) -- ^ Catch up from the previous pointer to this pointer.
    -> (Column -> (Int, TB.Builder))               -- ^ Something in the middle that ends before the next pointer.
    -> [Pointer]
    -> (TB.Builder, Column)
foldDecorations :: (Key -> Bool -> [Pointer] -> Builder)
-> (Key -> (Key, Builder)) -> [Pointer] -> (Builder, Key)
foldDecorations Key -> Bool -> [Pointer] -> Builder
catchUp Key -> (Key, Builder)
reachAfter [Pointer]
ps =
    let (Builder
decor, Key
finalCol, Bool
_) = (([Pointer], (Builder, Key, Bool))
 -> Pointer -> (Builder, Key, Bool))
-> (Builder, Key, Bool) -> [Pointer] -> (Builder, Key, Bool)
forall a b. (([a], b) -> a -> b) -> b -> [a] -> b
paral
            (\([Pointer]
rest, (Builder
xs, Key
c, Bool
isFirst)) p :: Pointer
p@(Pointer {Bool
Key
Maybe Body
pointerColEnd :: Pointer -> Key
pointerLabel :: Maybe Body
pointerConnect :: Bool
pointerColEnd :: Key
pointerColStart :: Key
pointerLine :: Key
pointerColStart :: Pointer -> Key
pointerLabel :: Pointer -> Maybe Body
pointerConnect :: Pointer -> Bool
pointerLine :: Pointer -> Key
..}) ->
                let (Key
afterLen, Builder
afterText) = Key -> (Key, Builder)
reachAfter (Key
pointerColEnd Key -> Key -> Key
forall a. Num a => a -> a -> a
- Key
pointerColStart)
                in
                ( [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
                    [ Builder
xs
                    , Key -> Bool -> [Pointer] -> Builder
catchUp (Key
pointerColStart Key -> Key -> Key
forall a. Num a => a -> a -> a
- Key
c) Bool
isFirst (Pointer
pPointer -> [Pointer] -> [Pointer]
forall a. a -> [a] -> [a]
:[Pointer]
rest)
                    , Builder
afterText
                    ]
                , Key
pointerColStart Key -> Key -> Key
forall a. Num a => a -> a -> a
+ Key
afterLen
                , Bool
False
                )
            )
            (Builder
"", Key
1, Bool
True)
            [Pointer]
ps
    in (Builder
decor, Key
finalCol)

-- | Paramorphism on lists (strictly, from the left).
paral :: (([a], b) -> a -> b) -> b -> [a] -> b
paral :: (([a], b) -> a -> b) -> b -> [a] -> b
paral ([a], b) -> a -> b
_ b
b [] = b
b
paral ([a], b) -> a -> b
f b
b (a
a:[a]
as) =
    let !b' :: b
b' = ([a], b) -> a -> b
f ([a]
as, b
b) a
a
    in (([a], b) -> a -> b) -> b -> [a] -> b
forall a b. (([a], b) -> a -> b) -> b -> [a] -> b
paral ([a], b) -> a -> b
f b
b' [a]
as

-- | Puts text between each item.
unsplit :: TB.Builder -> [TB.Builder] -> TB.Builder
unsplit :: Builder -> [Builder] -> Builder
unsplit Builder
_ []     = Builder
""
unsplit Builder
a (Builder
x:[Builder]
xs) = (Builder -> Builder -> Builder) -> Builder -> [Builder] -> Builder
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Builder
acc 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 #-}

-- | Replicates text into a builder.
replicateB :: Int -> T.Text -> TB.Builder
replicateB :: Key -> Body -> Builder
replicateB Key
n Body
xs = Body -> Builder
TB.fromText (Key -> Body -> Body
T.replicate Key
n Body
xs)
{-# INLINE replicateB #-}