{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# 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           Control.Arrow ((&&&))
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

#if defined(usewcwidth)
import           Foreign.C
#endif

-- | Renders a collection of 'Errata'.
renderErrors :: Source source => source -> [Errata] -> TB.Builder
renderErrors :: forall source. Source source => 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 :: [[Int]]
minPointers = (([IntMap [Pointer]] -> [Int]) -> [[IntMap [Pointer]]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (([IntMap [Pointer]] -> [Int]) -> [[IntMap [Pointer]]] -> [[Int]])
-> ((IntMap [Pointer] -> Int) -> [IntMap [Pointer]] -> [Int])
-> (IntMap [Pointer] -> Int)
-> [[IntMap [Pointer]]]
-> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap [Pointer] -> Int) -> [IntMap [Pointer]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map) (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 Int -> Int
forall a. a -> a
id (Maybe Int -> Int)
-> (IntMap [Pointer] -> Maybe Int) -> IntMap [Pointer] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, [Pointer]) -> Int) -> Maybe (Int, [Pointer]) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, [Pointer]) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, [Pointer]) -> Maybe Int)
-> (IntMap [Pointer] -> Maybe (Int, [Pointer]))
-> IntMap [Pointer]
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap [Pointer] -> Maybe (Int, [Pointer])
forall a. IntMap a -> Maybe (Int, a)
I.lookupMin) [[IntMap [Pointer]]]
blockPointersGrouped
        maxPointers :: [[Int]]
maxPointers = (([IntMap [Pointer]] -> [Int]) -> [[IntMap [Pointer]]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (([IntMap [Pointer]] -> [Int]) -> [[IntMap [Pointer]]] -> [[Int]])
-> ((IntMap [Pointer] -> Int) -> [IntMap [Pointer]] -> [Int])
-> (IntMap [Pointer] -> Int)
-> [[IntMap [Pointer]]]
-> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap [Pointer] -> Int) -> [IntMap [Pointer]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map) (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Int -> Int
forall a. a -> a
id (Maybe Int -> Int)
-> (IntMap [Pointer] -> Maybe Int) -> IntMap [Pointer] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, [Pointer]) -> Int) -> Maybe (Int, [Pointer]) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, [Pointer]) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, [Pointer]) -> Maybe Int)
-> (IntMap [Pointer] -> Maybe (Int, [Pointer]))
-> IntMap [Pointer]
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap [Pointer] -> Maybe (Int, [Pointer])
forall a. IntMap a -> Maybe (Int, a)
I.lookupMax) [[IntMap [Pointer]]]
blockPointersGrouped

        minLine :: Int
minLine = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Int]]
minPointers)
        maxLine :: Int
maxLine = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Int]]
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 = Int -> Int -> [source] -> IntMap [source]
forall a. Source a => Int -> Int -> [a] -> IntMap [a]
makeSourceTable Int
minLine Int
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]] -> [Int] -> [Int] -> Builder
forall source.
Source source =>
IntMap [source]
-> Errata -> [IntMap [Pointer]] -> [Int] -> [Int] -> Builder
renderErrata IntMap [source]
srcTable
            (Errata -> [IntMap [Pointer]] -> [Int] -> [Int] -> Builder)
-> ZipList Errata
-> ZipList ([IntMap [Pointer]] -> [Int] -> [Int] -> 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]] -> [Int] -> [Int] -> Builder)
-> ZipList [IntMap [Pointer]]
-> ZipList ([Int] -> [Int] -> Builder)
forall a b. ZipList (a -> b) -> ZipList a -> ZipList b
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 ([Int] -> [Int] -> Builder)
-> ZipList [Int] -> ZipList ([Int] -> Builder)
forall a b. ZipList (a -> b) -> ZipList a -> ZipList b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [[Int]] -> ZipList [Int]
forall a. [a] -> ZipList a
ZipList [[Int]]
minPointers
            ZipList ([Int] -> Builder) -> ZipList [Int] -> ZipList Builder
forall a b. ZipList (a -> b) -> ZipList a -> ZipList b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [[Int]] -> ZipList [Int]
forall a. [a] -> ZipList a
ZipList [[Int]]
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])
-> [(Int, [Pointer])] -> IntMap [Pointer]
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
I.fromListWith [Pointer] -> [Pointer] -> [Pointer]
forall a. Semigroup a => a -> a -> a
(<>) ([(Int, [Pointer])] -> IntMap [Pointer])
-> (Block -> [(Int, [Pointer])]) -> Block -> IntMap [Pointer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pointer -> (Int, [Pointer])) -> [Pointer] -> [(Int, [Pointer])]
forall a b. (a -> b) -> [a] -> [b]
map (\Pointer
p -> (Pointer -> Int
pointerLine Pointer
p, Pointer -> [Pointer]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pointer
p)) ([Pointer] -> [(Int, [Pointer])])
-> (Block -> [Pointer]) -> Block -> [(Int, [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 :: Source a => Line -> Line -> [a] -> I.IntMap [a]
makeSourceTable :: forall a. Source a => Int -> Int -> [a] -> IntMap [a]
makeSourceTable Int
minLine Int
maxLine [a]
slines = [(Int, [a])] -> IntMap [a]
forall a. [(Int, a)] -> IntMap a
I.fromDistinctAscList ([(Int, [a])] -> IntMap [a]) -> [(Int, [a])] -> IntMap [a]
forall a b. (a -> b) -> a -> b
$
    [Int] -> [[a]] -> [(Int, [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
minLine .. Int
maxLine] (Int -> [[a]] -> [[a]]
forall a. Int -> [a] -> [a]
drop (Int
minLine Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([a] -> [[a]]
forall a. Source 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 an 'emptySource'.

This allows for correct behavior on out-of-source-bounds pointers.
-}
slices :: Source a => [a] -> [[a]]
slices :: forall a. Source a => [a] -> [[a]]
slices [] = [a] -> [[a]]
forall a. a -> [a]
repeat (a -> [a]
forall a. a -> [a]
repeat a
forall s. Source s => s
emptySource)
slices [a]
xs = ([a]
xs [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> a -> [a]
forall a. a -> [a]
repeat a
forall s. Source s => s
emptySource) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
forall a. Source a => [a] -> [[a]]
slices ([a] -> [a]
forall a. HasCallStack => [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 :: forall source.
Source source =>
IntMap [source]
-> Errata -> [IntMap [Pointer]] -> [Int] -> [Int] -> Builder
renderErrata IntMap [source]
srcTable (Errata {[Block]
Maybe Body
errataBlocks :: Errata -> [Block]
errataHeader :: Maybe Body
errataBlocks :: [Block]
errataBody :: Maybe Body
errataBody :: Errata -> Maybe Body
errataHeader :: Errata -> Maybe Body
..}) [IntMap [Pointer]]
blockPointersGrouped [Int]
minPointers [Int]
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] -> (Int, Int) -> Builder
forall source.
Source source =>
IntMap [source]
-> Block -> IntMap [Pointer] -> (Int, Int) -> Builder
renderBlock IntMap [source]
srcTable
            (Block -> IntMap [Pointer] -> (Int, Int) -> Builder)
-> ZipList Block
-> ZipList (IntMap [Pointer] -> (Int, Int) -> 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] -> (Int, Int) -> Builder)
-> ZipList (IntMap [Pointer]) -> ZipList ((Int, Int) -> Builder)
forall a b. ZipList (a -> b) -> ZipList a -> ZipList b
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 ((Int, Int) -> Builder)
-> ZipList (Int, Int) -> ZipList Builder
forall a b. ZipList (a -> b) -> ZipList a -> ZipList b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(Int, Int)] -> ZipList (Int, Int)
forall a. [a] -> ZipList a
ZipList ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
minPointers [Int]
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 :: forall source.
Source source =>
IntMap [source]
-> Block -> IntMap [Pointer] -> (Int, Int) -> Builder
renderBlock IntMap [source]
srcTable block :: Block
block@(Block {[Pointer]
Maybe Body
(FilePath, Int, Int)
Style
blockPointers :: Block -> [Pointer]
blockStyle :: Style
blockLocation :: (FilePath, Int, Int)
blockHeader :: Maybe Body
blockPointers :: [Pointer]
blockBody :: Maybe Body
blockBody :: Block -> Maybe Body
blockHeader :: Block -> Maybe Body
blockLocation :: Block -> (FilePath, Int, Int)
blockStyle :: Block -> Style
..}) IntMap [Pointer]
blockPointersGrouped ~(Int
minBlockLine, Int
maxBlockLine) = Builder
blockMessage
    where
        slines :: [(Int, source)]
slines = [Int] -> [source] -> [(Int, source)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
minBlockLine .. Int
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
$ Int -> IntMap [source] -> Maybe [source]
forall a. Int -> IntMap a -> Maybe a
I.lookup Int
minBlockLine IntMap [source]
srcTable)

        -- Padding size before the line prefix.
        padding :: Int
padding = FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
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, Int, Int) -> Body
styleLocation Style
blockStyle (FilePath, Int, Int)
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
$ [(Int, source)]
-> Block -> Int -> IntMap [Pointer] -> Maybe Builder
forall source.
Source source =>
[(Int, source)]
-> Block -> Int -> IntMap [Pointer] -> Maybe Builder
renderSourceLines [(Int, source)]
slines Block
block Int
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 :: forall source.
Source source =>
[(Int, source)]
-> Block -> Int -> IntMap [Pointer] -> Maybe Builder
renderSourceLines [(Int, source)]
_ Block
_ Int
_ (IntMap [Pointer] -> Bool
forall a. IntMap a -> Bool
I.null -> Bool
True) = Maybe Builder
forall a. Maybe a
Nothing
renderSourceLines [(Int, source)]
slines (Block {[Pointer]
Maybe Body
(FilePath, Int, Int)
Style
blockPointers :: Block -> [Pointer]
blockBody :: Block -> Maybe Body
blockHeader :: Block -> Maybe Body
blockLocation :: Block -> (FilePath, Int, Int)
blockStyle :: Block -> Style
blockStyle :: Style
blockLocation :: (FilePath, Int, Int)
blockHeader :: Maybe Body
blockPointers :: [Pointer]
blockBody :: Maybe Body
..}) Int
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]
decoratedLines
    where
        {- Terminology used in this code:
            ↓↓ gutter
          │    ← padding line
        1 │   line 1 foo bar do
          │ ┌────────^───────^^
          │ │        │ ← connector
          │ │ hook → └ hi ← label
        2 │ │ line 2
        3 │ │ line 3
          │ ├──────^
        4 │ │ line 4 ← extra line
        5 │ │ line 5 ← extra line
        . │ │ ← omission
        7 │ │ line 7 ← extra line
        8 │ │ line 8 baz end
          │ └──────^─────^^^ ← underline
        ↑↑↑↑        ↑↑↑↑↑
        prefix      catch up
        -}
        Style {Bool
Int
Body
Int -> Body
[(PointerStyle, (Int, Int))] -> Body -> Body
(FilePath, Int, Int) -> Body
styleLocation :: Style -> (FilePath, Int, Int) -> Body
styleLocation :: (FilePath, Int, Int) -> Body
styleNumber :: Int -> Body
styleLine :: [(PointerStyle, (Int, Int))] -> Body -> Body
styleEllipsis :: Body
styleLinePrefix :: Body
styleVertical :: Body
styleHorizontal :: Body
styleDownRight :: Body
styleUpRight :: Body
styleUpDownRight :: Body
styleTabWidth :: Int
styleExtraLinesAfter :: Int
styleExtraLinesBefore :: Int
stylePaddingTop :: Bool
stylePaddingBottom :: Bool
styleEnableDecorations :: Bool
styleEnableLinePrefix :: Bool
styleEnableLinePrefix :: Style -> Bool
styleEnableDecorations :: Style -> Bool
stylePaddingBottom :: Style -> Bool
stylePaddingTop :: Style -> Bool
styleExtraLinesBefore :: Style -> Int
styleExtraLinesAfter :: Style -> Int
styleTabWidth :: Style -> Int
styleUpDownRight :: Style -> Body
styleUpRight :: Style -> Body
styleDownRight :: Style -> Body
styleHorizontal :: Style -> Body
styleVertical :: Style -> Body
styleLinePrefix :: Style -> Body
styleEllipsis :: Style -> Body
styleLine :: Style -> [(PointerStyle, (Int, Int))] -> Body -> Body
styleNumber :: Style -> Int -> 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 :: [(PointerStyle, (Column, Column))] -> source -> TB.Builder
        showLine :: [(PointerStyle, (Int, Int))] -> source -> Builder
showLine [(PointerStyle, (Int, Int))]
hs = Body -> Builder
TB.fromText (Body -> Builder) -> (source -> Body) -> source -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Body -> Body -> Body -> Body
Body -> Body -> Body -> Body
T.replace Body
"\t" (Int -> Body -> Body
T.replicate Int
styleTabWidth Body
" ") (Body -> Body) -> (source -> Body) -> source -> Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PointerStyle, (Int, Int))] -> Body -> Body
styleLine [(PointerStyle, (Int, Int))]
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, used for non-source lines i.e. decorations.
        prefix :: TB.Builder
        prefix :: Builder
prefix = if Bool
styleEnableLinePrefix
            then [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Int -> Body -> Builder
replicateB Int
padding Body
" ", Builder
" ", Body -> Builder
TB.fromText Body
styleLinePrefix, Builder
" "]
            else Builder
""

        -- Prefix with a line number, used for source lines.
        linePrefix :: Line -> TB.Builder
        linePrefix :: Int -> Builder
linePrefix Int
n = if Bool
styleEnableLinePrefix
            then [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Body -> Builder
TB.fromText (Int -> Body
styleNumber Int
n), Int -> Body -> Builder
replicateB (Int
padding Int -> Int -> Int
forall a. Num a => a -> a -> a
- FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n)) Body
" ", Builder
" ", Body -> Builder
TB.fromText Body
styleLinePrefix, Builder
" "]
            else Builder
""

        -- The resulting source lines with decorations; extra prefix included for padding.
        decoratedLines :: [TB.Builder]
        decoratedLines :: [Builder]
decoratedLines = [Builder
paddingLine | Bool
stylePaddingTop] [Builder] -> [Builder] -> [Builder]
forall a. Semigroup a => a -> a -> a
<> Int -> [(Int, source)] -> [Builder]
makeDecoratedLines Int
0 [(Int, source)]
slines[Builder] -> [Builder] -> [Builder]
forall a. Semigroup a => a -> a -> a
<> [Builder
paddingLine | Bool
stylePaddingBottom]
            where
                paddingLine :: Builder
paddingLine = if Bool
styleEnableLinePrefix
                    then [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Int -> Body -> Builder
replicateB Int
padding Body
" ", Builder
" ", Body -> Builder
TB.fromText Body
styleLinePrefix]
                    else Builder
""

        -- Whether there will be a multiline span in the block.
        hasConnMulti :: Bool
        hasConnMulti :: Bool
hasConnMulti = IntMap [Pointer] -> Int
forall a. IntMap a -> Int
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) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1

        -- Whether line /n/ has a connection to somewhere else (including the same line).
        hasConn :: Line -> Bool
        hasConn :: Int -> Bool
hasConn Int
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
$ Int -> IntMap [Pointer] -> Maybe [Pointer]
forall a. Int -> IntMap a -> Maybe a
I.lookup Int
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 :: Int -> (Bool, Bool)
connAround Int
n =
            let (IntMap [Pointer]
a, IntMap [Pointer]
b) = Int -> IntMap [Pointer] -> (IntMap [Pointer], IntMap [Pointer])
forall a. Int -> IntMap a -> (IntMap a, IntMap a)
I.split Int
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)

        -- Decorates all the pointed-to source lines, along with extra lines.
        -- We have an @extra@ parameter to keep track of extra lines when spanning multiple lines.
        makeDecoratedLines :: Line -> [(Line, source)] -> [TB.Builder]
        -- No lines left.
        makeDecoratedLines :: Int -> [(Int, source)] -> [Builder]
makeDecoratedLines Int
_ [] = []
        -- The next line is a line we have to decorate with pointers.
        makeDecoratedLines Int
_ (pr :: (Int, source)
pr@(Int
n, source
_):[(Int, source)]
ls)
            | Just [Pointer]
p <- Int -> IntMap [Pointer] -> Maybe [Pointer]
forall a. Int -> IntMap a -> Maybe a
I.lookup Int
n IntMap [Pointer]
pointersGrouped = [Pointer] -> (Int, source) -> [Builder]
decorateLine [Pointer]
p (Int, source)
pr [Builder] -> [Builder] -> [Builder]
forall a. Semigroup a => a -> a -> a
<> Int -> [(Int, source)] -> [Builder]
makeDecoratedLines Int
0 [(Int, source)]
ls
        -- The next line is an extra line, within a limit.
        makeDecoratedLines Int
extra ((Int
n, source
l):[(Int, source)]
ls)
            | Int
extra Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
styleExtraLinesAfter =
                let mid :: Builder
mid = if
                        | Bool -> Bool
not Bool
styleEnableDecorations -> Builder
""
                        | (Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd (Int -> (Bool, Bool)
connAround Int
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 (Int -> Builder
linePrefix Int
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
mid Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [(PointerStyle, (Int, Int))] -> source -> Builder
showLine [] source
l) Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Int -> [(Int, source)] -> [Builder]
makeDecoratedLines (Int
extra Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [(Int, source)]
ls
        -- We reached the extra line limit, so now there's some logic to figure out what's next.
        makeDecoratedLines Int
_ [(Int, source)]
ls =
            let ([(Int, source)]
es, [(Int, source)]
ls') = ((Int, source) -> Bool)
-> [(Int, source)] -> ([(Int, source)], [(Int, source)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((Int -> IntMap [Pointer] -> Bool
forall a. Int -> IntMap a -> Bool
`I.member` IntMap [Pointer]
pointersGrouped) (Int -> Bool) -> ((Int, source) -> Int) -> (Int, source) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, source) -> Int
forall a b. (a, b) -> a
fst) [(Int, source)]
ls
            in case ([(Int, source)]
es, [(Int, source)]
ls') of
                -- There were no lines left to decorate anyways.
                ([(Int, source)]
_, []) -> []
                -- There are lines left to decorate, and it came right after.
                ([], [(Int, source)]
_) -> Int -> [(Int, source)] -> [Builder]
makeDecoratedLines Int
0 [(Int, source)]
ls'
                -- There are more than one line in between, so we take as much as is configured.
                ([(Int, source)]
_, [(Int, source)]
_) ->
                    let es' :: [(Int, source)]
es' = [(Int, source)] -> [(Int, source)]
forall a. [a] -> [a]
reverse ([(Int, source)] -> [(Int, source)])
-> ([(Int, source)] -> [(Int, source)])
-> [(Int, source)]
-> [(Int, source)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Int, source)] -> [(Int, source)]
forall a. Int -> [a] -> [a]
take Int
styleExtraLinesBefore ([(Int, source)] -> [(Int, source)])
-> ([(Int, source)] -> [(Int, source)])
-> [(Int, source)]
-> [(Int, source)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, source)] -> [(Int, source)]
forall a. [a] -> [a]
reverse ([(Int, source)] -> [(Int, source)])
-> [(Int, source)] -> [(Int, source)]
forall a b. (a -> b) -> a -> b
$ [(Int, source)]
es
                        extras :: [Builder]
extras = (((Int, source) -> Builder) -> [(Int, source)] -> [Builder])
-> [(Int, source)] -> ((Int, source) -> Builder) -> [Builder]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int, source) -> Builder) -> [(Int, source)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map [(Int, source)]
es' (((Int, source) -> Builder) -> [Builder])
-> ((Int, source) -> Builder) -> [Builder]
forall a b. (a -> b) -> a -> b
$ \(Int
n, source
l) ->
                            let gutter :: Builder
gutter = if
                                    | Bool -> Bool
not Bool
styleEnableDecorations -> Builder
""
                                    | (Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd (Int -> (Bool, Bool)
connAround Int
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 Int -> Builder
linePrefix Int
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
gutter Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [(PointerStyle, (Int, Int))] -> source -> Builder
showLine [] source
l
                    in case [(Int, source)] -> [(Int, source)] -> Ordering
forall a b. [a] -> [b] -> Ordering
compareLength [(Int, source)]
es' [(Int, source)]
es of
                        -- We only add the omission line if it doesn't take all of the lines.
                        Ordering
LT -> let
                            -- Prefix and gutter for omitting lines when spanning many lines.
                            omitPrefix :: Builder
omitPrefix = if Bool
styleEnableLinePrefix
                                then [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Body -> Builder
TB.fromText Body
styleEllipsis, Int -> Body -> Builder
replicateB (Int
padding Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Body
" ", Builder
" ", Body -> Builder
TB.fromText Body
styleLinePrefix]
                                else Builder
""
                            omitGutter :: Builder
omitGutter = if
                                | Bool -> Bool
not Bool
styleEnableDecorations       -> Builder
""
                                | (Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd ((Bool, Bool) -> Bool)
-> ((Int, source) -> (Bool, Bool)) -> (Int, source) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Bool, Bool)
connAround (Int -> (Bool, Bool))
-> ((Int, source) -> Int) -> (Int, source) -> (Bool, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, source) -> Int
forall a b. (a, b) -> a
fst ((Int, source) -> Bool) -> (Int, source) -> Bool
forall a b. (a -> b) -> a -> b
$ [(Int, source)] -> (Int, source)
forall a. HasCallStack => [a] -> a
head [(Int, source)]
ls -> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Body -> Builder
TB.fromText Body
styleVertical
                                | Bool
otherwise                        -> Builder
""
                            in (Builder
omitPrefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
omitGutter) Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
extras [Builder] -> [Builder] -> [Builder]
forall a. Semigroup a => a -> a -> a
<> Int -> [(Int, source)] -> [Builder]
makeDecoratedLines Int
0 [(Int, source)]
ls'
                        Ordering
_ -> [Builder]
extras [Builder] -> [Builder] -> [Builder]
forall a. Semigroup a => a -> a -> a
<> Int -> [(Int, source)] -> [Builder]
makeDecoratedLines Int
0 [(Int, source)]
ls'

        -- Decorate a line that has pointers.
        -- The pointers we get are assumed to be all on the same line.
        decorateLine :: [Pointer] -> (Line, source) -> [TB.Builder]
        decorateLine :: [Pointer] -> (Int, source) -> [Builder]
decorateLine [Pointer]
pointers (Int
n, source
l) = (Int -> Builder
linePrefix Int
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
gutter Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
stylizedLine) Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
decorationLines
            where
                gutter :: Builder
gutter = if
                    | Bool -> Bool
not Bool
styleEnableDecorations    -> Builder
""
                    | Bool
hasConnBefore Bool -> Bool -> Bool
&& Bool
hasConnUnder -> Body -> Builder
TB.fromText Body
styleVertical Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" "
                    | Bool
hasConnMulti                  -> Builder
"  "
                    | Bool
otherwise                     -> Builder
""

                -- Shortcuts to where this line connects to.
                hasConnHere :: Bool
hasConnHere = Int -> Bool
hasConn Int
n
                (Bool
hasConnBefore, Bool
hasConnAfter) = Int -> (Bool, Bool)
connAround Int
n
                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 -> (Int, Int)) -> [Pointer] -> [Pointer]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Pointer -> (Int, Int)
pointerColumns [Pointer]
pointers

                -- The actual source line.
                sourceLine :: Body
sourceLine = source -> Body
forall s. Source s => s -> Body
sourceToText source
l

                -- The source line stylized.
                stylizedLine :: Builder
stylizedLine = [(PointerStyle, (Int, Int))] -> source -> Builder
showLine ((Pointer -> (PointerStyle, (Int, Int)))
-> [Pointer] -> [(PointerStyle, (Int, Int))]
forall a b. (a -> b) -> [a] -> [b]
map (Pointer -> PointerStyle
pointerStyle (Pointer -> PointerStyle)
-> (Pointer -> (Int, Int)) -> Pointer -> (PointerStyle, (Int, Int))
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Pointer -> (Int, Int)
pointerColumns) [Pointer]
pointersSorted) source
l

                -- 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. HasCallStack => [a] -> [a]
init [Pointer]
pointersSorted) of
                    [Pointer]
_ | Bool -> Bool
not Bool
styleEnableDecorations -> []
                    -- There's only one pointer, so no need for more than just an underline and label.
                    [Pointer]
_ | [Pointer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pointer]
pointersSorted Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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. HasCallStack => [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, Int
_) = (Int -> Bool -> [Pointer] -> Body -> Builder)
-> (Int -> Pointer -> Body -> (Int, Builder))
-> [Pointer]
-> Body
-> (Builder, Int)
foldDecorations
                            (\Int
k Bool
isFirst [Pointer]
rest Body
text -> 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 -> Int -> Int -> Body -> Body -> Builder
replaceWithWidth Int
k Int
styleTabWidth Body
text Body
styleHorizontal
                                | Bool
isFirst                                             -> Int -> Int -> Body -> Body -> Builder
replaceWithWidth Int
k Int
styleTabWidth Body
text Body
" "
                                | (Pointer -> Bool) -> [Pointer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Pointer -> Bool
pointerConnect [Pointer]
rest                             -> Int -> Int -> Body -> Body -> Builder
replaceWithWidth Int
k Int
styleTabWidth Body
text Body
styleHorizontal
                                | Bool
otherwise                                           -> Int -> Int -> Body -> Body -> Builder
replaceWithWidth Int
k Int
styleTabWidth Body
text Body
" "
                            )
                            (\Int
k Pointer
p Body
text ->
                                let x :: Body
x = PointerStyle -> Body
styleUnderline (Pointer -> PointerStyle
pointerStyle Pointer
p)
                                in (Int
k, Int -> Int -> Body -> Body -> Builder
replaceWithWidth Int
k Int
styleTabWidth Body
text Body
x)
                            )
                            [Pointer]
ps
                            Body
sourceLine
                        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. HasCallStack => [a] -> a
last [Pointer]
ps
                        decorGutter :: Body
decorGutter = 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
decorGutter 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, Int
_) = (Int -> Bool -> [Pointer] -> Body -> Builder)
-> (Int -> Pointer -> Body -> (Int, Builder))
-> [Pointer]
-> Body
-> (Builder, Int)
foldDecorations
                            (\Int
k Bool
_ [Pointer]
_ Body
text -> Int -> Int -> Body -> Body -> Builder
replaceWithWidth Int
k Int
styleTabWidth Body
text Body
" ")
                            (\Int
_ Pointer
p Body
_ ->
                                let x :: Body
x = PointerStyle -> Body
styleConnector (Pointer -> PointerStyle
pointerStyle Pointer
p)
                                in (Int
1, Body -> Builder
TB.fromText Body
x)
                            )
                            [Pointer]
ps
                            Body
sourceLine
                        decorGutter :: Body
decorGutter = 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
decorGutter 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, Int
finalCol) = (Int -> Bool -> [Pointer] -> Body -> Builder)
-> (Int -> Pointer -> Body -> (Int, Builder))
-> [Pointer]
-> Body
-> (Builder, Int)
foldDecorations
                            (\Int
k Bool
_ [Pointer]
_ Body
text -> Int -> Int -> Body -> Body -> Builder
replaceWithWidth Int
k Int
styleTabWidth Body
text Body
" ")
                            (\Int
_ Pointer
p Body
_ ->
                                let x :: Body
x = PointerStyle -> Body
styleConnector (Pointer -> PointerStyle
pointerStyle Pointer
p)
                                in (Int
1, Body -> Builder
TB.fromText Body
x)
                            )
                            ([Pointer] -> [Pointer]
forall a. HasCallStack => [a] -> [a]
init [Pointer]
ps)
                            Body
sourceLine
                        pointer :: Pointer
pointer = [Pointer] -> Pointer
forall a. HasCallStack => [a] -> a
last [Pointer]
ps
                        hook :: Body
hook = PointerStyle -> Body
styleHook (Pointer -> PointerStyle
pointerStyle Pointer
pointer)
                        lbl :: Builder
lbl = Builder -> (Body -> Builder) -> Maybe Body -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
""
                            (\Body
x -> if
                                | PointerStyle -> Bool
styleEnableHook (Pointer -> PointerStyle
pointerStyle Pointer
pointer) -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
                                    [ Int -> Body -> Builder
replicateB (Pointer -> Int
pointerColStart Pointer
pointer Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
finalCol) Body
" "
                                    , Body -> Builder
TB.fromText Body
hook
                                    , Builder
" "
                                    , Body -> Builder
TB.fromText Body
x
                                    ]
                                | Bool
otherwise -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
                                    [ Int -> Body -> Builder
replicateB (Pointer -> Int
pointerColStart Pointer
pointer Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
finalCol) Body
" "
                                    , Body -> Builder
TB.fromText Body
x
                                    ]
                            )
                            (Pointer -> Maybe Body
pointerLabel Pointer
pointer)
                        decorGutter :: Body
decorGutter = 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
decorGutter 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
    :: (Int -> Bool -> [Pointer] -> T.Text -> TB.Builder)
    {- ^ Catch up from the previous pointer to this pointer.

    @catchUp distance isFirst pointers text@ should return text of at least length @distance@.
    -}
    -> (Int -> Pointer -> T.Text -> (Int, TB.Builder))
    {- ^ Add text underneath the pointer before the next pointer.

    @underlinePointer pointerLen pointer text@ should return the text and its length.
    -}
    -> [Pointer]
    -> T.Text
    -> (TB.Builder, Column)
foldDecorations :: (Int -> Bool -> [Pointer] -> Body -> Builder)
-> (Int -> Pointer -> Body -> (Int, Builder))
-> [Pointer]
-> Body
-> (Builder, Int)
foldDecorations Int -> Bool -> [Pointer] -> Body -> Builder
catchUp Int -> Pointer -> Body -> (Int, Builder)
underlinePointer [Pointer]
ps Body
line =
    let (Builder
decor, Int
finalCol, Bool
_, Body
_) = (([Pointer], (Builder, Int, Bool, Body))
 -> Pointer -> (Builder, Int, Bool, Body))
-> (Builder, Int, Bool, Body)
-> [Pointer]
-> (Builder, Int, Bool, Body)
forall a b. (([a], b) -> a -> b) -> b -> [a] -> b
paral
            (\([Pointer]
rest, (Builder
xs, Int
c, Bool
isFirst, Body
remainingLine)) p :: Pointer
p@(Pointer {Bool
Int
Maybe Body
PointerStyle
pointerLine :: Pointer -> Int
pointerConnect :: Pointer -> Bool
pointerStyle :: Pointer -> PointerStyle
pointerLabel :: Pointer -> Maybe Body
pointerColStart :: Pointer -> Int
pointerLine :: Int
pointerColStart :: Int
pointerColEnd :: Int
pointerConnect :: Bool
pointerLabel :: Maybe Body
pointerStyle :: PointerStyle
pointerColEnd :: Pointer -> Int
..}) ->
                let (Body
textBefore, Body
textUnderAndRest) = Int -> Body -> (Body, Body)
T.splitAt (Int
pointerColStart Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c) Body
remainingLine
                    (Body
textUnder, Body
textRest) = Int -> Body -> (Body, Body)
T.splitAt (Int
pointerColEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pointerColStart) Body
textUnderAndRest
                    (Int
afterLen, Builder
afterText) = Int -> Pointer -> Body -> (Int, Builder)
underlinePointer (Int
pointerColEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pointerColStart) Pointer
p Body
textUnder
                in
                ( [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
                    [ Builder
xs
                    , Int -> Bool -> [Pointer] -> Body -> Builder
catchUp (Int
pointerColStart Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c) Bool
isFirst (Pointer
pPointer -> [Pointer] -> [Pointer]
forall a. a -> [a] -> [a]
:[Pointer]
rest) Body
textBefore
                    , Builder
afterText
                    ]
                , Int
pointerColStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
afterLen
                , Bool
False
                , Body
textRest
                )
            )
            (Builder
"", Int
1, Bool
True, Body
line)
            [Pointer]
ps
    in (Builder
decor, Int
finalCol)

-- | Paramorphism on lists (strictly, from the left).
paral :: (([a], b) -> a -> b) -> b -> [a] -> b
paral :: forall a b. (([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

-- | Compares length of two lists without traversing them completely.
compareLength :: [a] -> [b] -> Ordering
compareLength :: forall a b. [a] -> [b] -> Ordering
compareLength []     []     = Ordering
EQ
compareLength (a
_:[a]
xs) (b
_:[b]
ys) = [a] -> [b] -> Ordering
forall a b. [a] -> [b] -> Ordering
compareLength [a]
xs [b]
ys
compareLength []     [b]
_      = Ordering
LT
compareLength [a]
_      []     = Ordering
GT

-- | 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 b a. (b -> a -> b) -> b -> [a] -> b
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 :: Int -> Body -> Builder
replicateB Int
n Body
xs = Body -> Builder
TB.fromText (Int -> Body -> Body
T.replicate Int
n Body
xs)
{-# INLINE replicateB #-}

{- | Replaces each character in the text with the appropriate instances of the given text based on character width.

The result will also be right-padded with the given text to the given length.

For tabs, the tab width given is used to make it equivalent to that many spaces.
-}
replaceWithWidth :: Int -> Int -> T.Text -> T.Text -> TB.Builder
replaceWithWidth :: Int -> Int -> Body -> Body -> Builder
replaceWithWidth Int
len Int
tab Body
ref Body
xs = (Builder -> Char -> Builder) -> Builder -> Body -> Builder
forall a. (a -> Char -> a) -> a -> Body -> a
T.foldl' (\Builder
acc Char
c -> Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Body -> Builder
replicateB (Char -> Int
width Char
c) Body
xs) Builder
"" Body
ref Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Body -> Builder
replicateB (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Body -> Int
T.length Body
ref) Body
xs
    where
        width :: Char -> Int
width Char
'\t' = Int
tab
        width Char
c = Char -> Int
charWidth Char
c
{-# INLINE replaceWithWidth #-}

#if defined(usewcwidth)
foreign import ccall unsafe "wchar.h wcwidth" wcwidth :: CWchar -> CInt
{-| Get the designated render width of a character, based on the native wcwidth.
Where wcwidth would return -1, 0 is returned instead.

The result will depend on the current locale and Unicode version.
-}
charWidth :: Char -> Int
charWidth = max 0 . fromEnum . wcwidth . toEnum . fromEnum
#else
{-| Get the designated render width of a character: 0 for a combining character, 1 for a regular character,
2 for a wide character. (Wide characters are rendered as exactly double width in apps and fonts that support it.)

(From Pandoc.)
-}
charWidth :: Char -> Int
charWidth :: Char -> Int
charWidth Char
c = if
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x0300'                     -> Int
1
    -- Combining
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0300' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x036F'   -> Int
0
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0370' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x10FC'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1100' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x115F'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1160' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x11A2'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x11A3' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x11A7'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x11A8' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x11F9'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x11FA' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x11FF'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1200' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2328'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x2329' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x232A'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x232B' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2E31'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x2E80' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x303E'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x303F'                    -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x3041' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x3247'   -> Int
2
    -- Ambiguous
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x3248' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x324F'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x3250' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x4DBF'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x4DC0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x4DFF'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x4E00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xA4C6'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xA4D0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xA95F'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xA960' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xA97C'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xA980' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xABF9'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xAC00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xD7FB'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xD800' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xDFFF'   -> Int
1
    -- Ambiguous
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xE000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xF8FF'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xF900' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFAFF'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFB00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFDFD'   -> Int
1
    -- Ambiguous
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFE00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFE0F'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFE10' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFE19'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFE20' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFE26'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFE30' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFE6B'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFE70' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFEFF'   -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFF01' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFF60'   -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFF61' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x16A38'  -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1B000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1B001' -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1D000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1F1FF' -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1F200' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1F251' -> Int
2
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1F300' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1F773' -> Int
1
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x20000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x3FFFD' -> Int
2
    | Bool
otherwise                        -> Int
1
#endif