{-# 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 = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map Block -> IntMap [Pointer]
groupBlockPointers 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 = (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> Maybe (Int, a)
I.lookupMin) [[IntMap [Pointer]]]
blockPointersGrouped
        maxPointers :: [[Int]]
maxPointers = (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> Maybe (Int, a)
I.lookupMax) [[IntMap [Pointer]]]
blockPointersGrouped

        minLine :: Int
minLine = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Int]]
minPointers)
        maxLine :: Int
maxLine = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (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 = forall a. Source a => Int -> Int -> [a] -> IntMap [a]
makeSourceTable Int
minLine Int
maxLine (forall s. Source s => s -> [s]
sourceToLines source
source)

        errataMessages :: [Builder]
errataMessages = forall a. ZipList a -> [a]
getZipList forall a b. (a -> b) -> a -> b
$ forall source.
Source source =>
IntMap [source]
-> Errata -> [IntMap [Pointer]] -> [Int] -> [Int] -> Builder
renderErrata IntMap [source]
srcTable
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> ZipList a
ZipList [Errata]
errs
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. [a] -> ZipList a
ZipList [[IntMap [Pointer]]]
blockPointersGrouped
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. [a] -> ZipList a
ZipList [[Int]]
minPointers
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
I.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Pointer
p -> (Pointer -> Int
pointerLine Pointer
p, forall (f :: * -> *) a. Applicative f => a -> f a
pure Pointer
p)) 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 = forall a. [(Int, a)] -> IntMap a
I.fromDistinctAscList forall a b. (a -> b) -> a -> b
$
    forall a b. [a] -> [b] -> [(a, b)]
zip [Int
minLine .. Int
maxLine] (forall a. Int -> [a] -> [a]
drop (Int
minLine forall a. Num a => a -> a -> a
- Int
1) (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 [] = forall a. a -> [a]
repeat (forall a. a -> [a]
repeat forall s. Source s => s
emptySource)
slices [a]
xs = ([a]
xs forall a. Semigroup a => a -> a -> a
<> forall a. a -> [a]
repeat forall s. Source s => s
emptySource) forall a. a -> [a] -> [a]
: forall a. Source a => [a] -> [[a]]
slices (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 :: forall source.
Source source =>
IntMap [source]
-> Errata -> [IntMap [Pointer]] -> [Int] -> [Int] -> 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 [Int]
minPointers [Int]
maxPointers = Builder
errorMessage
    where
        blockMessages :: [Builder]
blockMessages = forall a. ZipList a -> [a]
getZipList forall a b. (a -> b) -> a -> b
$ forall source.
Source source =>
IntMap [source]
-> Block -> IntMap [Pointer] -> (Int, Int) -> Builder
renderBlock IntMap [source]
srcTable
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> ZipList a
ZipList [Block]
errataBlocks
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. [a] -> ZipList a
ZipList [IntMap [Pointer]]
blockPointersGrouped
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. [a] -> ZipList a
ZipList (forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
minPointers [Int]
maxPointers)

        errorMessage :: Builder
errorMessage = forall a. Monoid a => [a] -> a
mconcat
            [ Body -> Builder
TB.fromText forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe 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" forall a. Semigroup a => a -> a -> a
<> Builder -> [Builder] -> Builder
unsplit Builder
"\n\n" [Builder]
xs
            , Body -> Builder
TB.fromText forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Body
"" (Body
"\n" 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
blockBody :: Block -> Maybe Body
blockHeader :: Block -> Maybe Body
blockLocation :: Block -> (FilePath, Int, Int)
blockStyle :: Block -> Style
blockBody :: Maybe Body
blockPointers :: [Pointer]
blockHeader :: Maybe Body
blockLocation :: (FilePath, Int, Int)
blockStyle :: Style
blockPointers :: Block -> [Pointer]
..}) IntMap [Pointer]
blockPointersGrouped ~(Int
minBlockLine, Int
maxBlockLine) = Builder
blockMessage
    where
        slines :: [(Int, source)]
slines = forall a b. [a] -> [b] -> [(a, b)]
zip [Int
minBlockLine .. Int
maxBlockLine] (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> Maybe a
I.lookup Int
minBlockLine IntMap [source]
srcTable)

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

        blockMessage :: Builder
blockMessage = forall a. Monoid a => [a] -> a
mconcat
            [ Body -> Builder
TB.fromText forall a b. (a -> b) -> a -> b
$ Style -> (FilePath, Int, Int) -> Body
styleLocation Style
blockStyle (FilePath, Int, Int)
blockLocation
            , Body -> Builder
TB.fromText forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Body
"" (Body
"\n" forall a. Semigroup a => a -> a -> a
<>) Maybe Body
blockHeader
            , forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" (Builder
"\n" forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Body
"" (Body
"\n" 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
_ (forall a. IntMap a -> Bool
I.null -> Bool
True) = forall a. Maybe a
Nothing
renderSourceLines [(Int, source)]
slines (Block {[Pointer]
Maybe Body
(FilePath, Int, Int)
Style
blockBody :: Maybe Body
blockPointers :: [Pointer]
blockHeader :: Maybe Body
blockLocation :: (FilePath, Int, Int)
blockStyle :: Style
blockBody :: Block -> Maybe Body
blockHeader :: Block -> Maybe Body
blockLocation :: Block -> (FilePath, Int, Int)
blockStyle :: Block -> Style
blockPointers :: Block -> [Pointer]
..}) Int
padding IntMap [Pointer]
pointersGrouped = forall a. a -> Maybe a
Just 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
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
styleEnableLinePrefix :: Bool
styleEnableDecorations :: Bool
stylePaddingBottom :: Bool
stylePaddingTop :: Bool
styleExtraLinesBefore :: Int
styleExtraLinesAfter :: Int
styleTabWidth :: Int
styleUpDownRight :: Body
styleUpRight :: Body
styleDownRight :: Body
styleHorizontal :: Body
styleVertical :: Body
styleLinePrefix :: Body
styleEllipsis :: Body
styleLine :: [(PointerStyle, (Int, Int))] -> Body -> Body
styleNumber :: Int -> Body
styleLocation :: (FilePath, Int, Int) -> Body
styleLocation :: Style -> (FilePath, Int, 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Body -> Body -> Body -> Body
T.replace Body
"\t" (Int -> Body -> Body
T.replicate Int
styleTabWidth Body
" ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PointerStyle, (Int, Int))] -> Body -> Body
styleLine [(PointerStyle, (Int, Int))]
hs forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 forall a. Monoid a => [a] -> a
mconcat [Body -> Builder
TB.fromText (Int -> Body
styleNumber Int
n), Int -> Body -> Builder
replicateB (Int
padding forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length (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] forall a. Semigroup a => a -> a -> a
<> Int -> [(Int, source)] -> [Builder]
makeDecoratedLines Int
0 [(Int, source)]
slinesforall a. Semigroup a => a -> a -> a
<> [Builder
paddingLine | Bool
stylePaddingBottom]
            where
                paddingLine :: Builder
paddingLine = if Bool
styleEnableLinePrefix
                    then 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 = forall a. IntMap a -> Int
I.size (forall a. (a -> Bool) -> IntMap a -> IntMap a
I.filter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Pointer -> Bool
pointerConnect) IntMap [Pointer]
pointersGrouped) 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Pointer -> Bool
pointerConnect) forall a b. (a -> b) -> a -> b
$ 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) = forall a. Int -> IntMap a -> (IntMap a, IntMap a)
I.split Int
n IntMap [Pointer]
pointersGrouped
            in ((forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any) Pointer -> Bool
pointerConnect IntMap [Pointer]
a, (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 <- forall a. Int -> IntMap a -> Maybe a
I.lookup Int
n IntMap [Pointer]
pointersGrouped = [Pointer] -> (Int, source) -> [Builder]
decorateLine [Pointer]
p (Int, source)
pr 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 forall a. Ord a => a -> a -> Bool
< Int
styleExtraLinesAfter =
                let mid :: Builder
mid = if
                        | Bool -> Bool
not Bool
styleEnableDecorations -> Builder
""
                        | forall a b. (a, b) -> b
snd (Int -> (Bool, Bool)
connAround Int
n)         -> Body -> Builder
TB.fromText Body
styleVertical forall a. Semigroup a => a -> a -> a
<> Builder
" "
                        | Bool
hasConnMulti               -> Builder
"  "
                        | Bool
otherwise                  -> Builder
""
                in (Int -> Builder
linePrefix Int
n forall a. Semigroup a => a -> a -> a
<> Builder
mid forall a. Semigroup a => a -> a -> a
<> [(PointerStyle, (Int, Int))] -> source -> Builder
showLine [] source
l) forall a. a -> [a] -> [a]
: Int -> [(Int, source)] -> [Builder]
makeDecoratedLines (Int
extra 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') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((forall a. Int -> IntMap a -> Bool
`I.member` IntMap [Pointer]
pointersGrouped) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
styleExtraLinesBefore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [(Int, source)]
es
                        extras :: [Builder]
extras = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [(Int, source)]
es' forall a b. (a -> b) -> a -> b
$ \(Int
n, source
l) ->
                            let gutter :: Builder
gutter = if
                                    | Bool -> Bool
not Bool
styleEnableDecorations -> Builder
""
                                    | forall a b. (a, b) -> b
snd (Int -> (Bool, Bool)
connAround Int
n)         -> Body -> Builder
TB.fromText Body
styleVertical forall a. Semigroup a => a -> a -> a
<> Builder
" "
                                    | Bool
hasConnMulti               -> Builder
"  "
                                    | Bool
otherwise                  -> Builder
""
                            in Int -> Builder
linePrefix Int
n forall a. Semigroup a => a -> a -> a
<> Builder
gutter forall a. Semigroup a => a -> a -> a
<> [(PointerStyle, (Int, Int))] -> source -> Builder
showLine [] source
l
                    in case 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 forall a. Monoid a => [a] -> a
mconcat [Body -> Builder
TB.fromText Body
styleEllipsis, Int -> Body -> Builder
replicateB (Int
padding 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
""
                                | forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Bool, Bool)
connAround forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Int, source)]
ls -> Builder
" " forall a. Semigroup a => a -> a -> a
<> Body -> Builder
TB.fromText Body
styleVertical
                                | Bool
otherwise                        -> Builder
""
                            in (Builder
omitPrefix forall a. Semigroup a => a -> a -> a
<> Builder
omitGutter) forall a. a -> [a] -> [a]
: [Builder]
extras forall a. Semigroup a => a -> a -> a
<> Int -> [(Int, source)] -> [Builder]
makeDecoratedLines Int
0 [(Int, source)]
ls'
                        Ordering
_ -> [Builder]
extras 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 forall a. Semigroup a => a -> a -> a
<> Builder
gutter forall a. Semigroup a => a -> a -> a
<> Builder
stylizedLine) 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 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 = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Pointer -> (Int, Int)
pointerColumns [Pointer]
pointers

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

                -- The source line stylized.
                stylizedLine :: Builder
stylizedLine = [(PointerStyle, (Int, Int))] -> source -> Builder
showLine (forall a b. (a -> b) -> [a] -> [b]
map (Pointer -> PointerStyle
pointerStyle 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 forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pointer -> Maybe Body
pointerLabel) (forall a. [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]
_ | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pointer]
pointersSorted 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
                        forall a. a -> [a] -> [a]
: [Pointer] -> Builder
connectors [Pointer]
hasLabels
                        forall a. a -> [a] -> [a]
: (forall a b. (a -> b) -> [a] -> [b]
map [Pointer] -> Builder
connectorAndLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ 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
&& 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
" "
                                | 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Body
"" (Body
" " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pointer -> Maybe Body
pointerLabel forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [Pointer]
ps
                        decorGutter :: Body
decorGutter = if
                            | Bool
hasConnHere Bool -> Bool -> Bool
&& Bool
hasConnBefore Bool -> Bool -> Bool
&& Bool
hasConnAfter -> Body
styleUpDownRight forall a. Semigroup a => a -> a -> a
<> Body
styleHorizontal
                            | Bool
hasConnHere Bool -> Bool -> Bool
&& Bool
hasConnBefore                 -> Body
styleUpRight forall a. Semigroup a => a -> a -> a
<> Body
styleHorizontal
                            | Bool
hasConnHere Bool -> Bool -> Bool
&& Bool
hasConnAfter                  -> Body
styleDownRight forall a. Semigroup a => a -> a -> a
<> Body
styleHorizontal
                            | Bool
hasConnBefore Bool -> Bool -> Bool
&& Bool
hasConnAfter                -> Body
styleVertical forall a. Semigroup a => a -> a -> a
<> Body
" "
                            | Bool
hasConnMulti                                 -> Body
"  "
                            | Bool
otherwise                                    -> Body
""
                    in Builder
prefix forall a. Semigroup a => a -> a -> a
<> Body -> Builder
TB.fromText Body
decorGutter forall a. Semigroup a => a -> a -> a
<> Builder
decor 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 forall a. Semigroup a => a -> a -> a
<> Body
" "
                            | Bool
hasConnMulti                -> Body
"  "
                            | Bool
otherwise                   -> Body
""
                    in Builder
prefix forall a. Semigroup a => a -> a -> a
<> Body -> Builder
TB.fromText Body
decorGutter 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)
                            )
                            (forall a. [a] -> [a]
init [Pointer]
ps)
                            Body
sourceLine
                        pointer :: Pointer
pointer = forall a. [a] -> a
last [Pointer]
ps
                        hook :: Body
hook = PointerStyle -> Body
styleHook (Pointer -> PointerStyle
pointerStyle Pointer
pointer)
                        lbl :: Builder
lbl = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
""
                            (\Body
x -> if
                                | PointerStyle -> Bool
styleEnableHook (Pointer -> PointerStyle
pointerStyle Pointer
pointer) -> forall a. Monoid a => [a] -> a
mconcat
                                    [ Int -> Body -> Builder
replicateB (Pointer -> Int
pointerColStart Pointer
pointer 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 -> forall a. Monoid a => [a] -> a
mconcat
                                    [ Int -> Body -> Builder
replicateB (Pointer -> Int
pointerColStart Pointer
pointer 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 forall a. Semigroup a => a -> a -> a
<> Body
" "
                            | Bool
hasConnMulti                -> Body
"  "
                            | Bool
otherwise                   -> Body
""
                    in Builder
prefix forall a. Semigroup a => a -> a -> a
<> Body -> Builder
TB.fromText Body
decorGutter forall a. Semigroup a => a -> a -> a
<> Builder
decor 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
_) = 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
pointerColEnd :: Pointer -> Int
pointerStyle :: PointerStyle
pointerLabel :: Maybe Body
pointerConnect :: Bool
pointerColEnd :: Int
pointerColStart :: Int
pointerLine :: Int
pointerColStart :: Pointer -> Int
pointerLabel :: Pointer -> Maybe Body
pointerStyle :: Pointer -> PointerStyle
pointerConnect :: Pointer -> Bool
pointerLine :: Pointer -> Int
..}) ->
                let (Body
textBefore, Body
textUnderAndRest) = Int -> Body -> (Body, Body)
T.splitAt (Int
pointerColStart forall a. Num a => a -> a -> a
- Int
c) Body
remainingLine
                    (Body
textUnder, Body
textRest) = Int -> Body -> (Body, Body)
T.splitAt (Int
pointerColEnd forall a. Num a => a -> a -> a
- Int
pointerColStart) Body
textUnderAndRest
                    (Int
afterLen, Builder
afterText) = Int -> Pointer -> Body -> (Int, Builder)
underlinePointer (Int
pointerColEnd forall a. Num a => a -> a -> a
- Int
pointerColStart) Pointer
p Body
textUnder
                in
                ( forall a. Monoid a => [a] -> a
mconcat
                    [ Builder
xs
                    , Int -> Bool -> [Pointer] -> Body -> Builder
catchUp (Int
pointerColStart forall a. Num a => a -> a -> a
- Int
c) Bool
isFirst (Pointer
pforall a. a -> [a] -> [a]
:[Pointer]
rest) Body
textBefore
                    , Builder
afterText
                    ]
                , Int
pointerColStart 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 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) = 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) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Builder
acc Builder
y -> Builder
acc forall a. Semigroup a => a -> a -> a
<> Builder
a 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 = forall a. (a -> Char -> a) -> a -> Body -> a
T.foldl' (\Builder
acc Char
c -> Builder
acc forall a. Semigroup a => a -> a -> a
<> Int -> Body -> Builder
replicateB (Char -> Int
width Char
c) Body
xs) Builder
"" Body
ref forall a. Semigroup a => a -> a -> a
<> Int -> Body -> Builder
replicateB (Int
len 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 forall a. Ord a => a -> a -> Bool
< Char
'\x0300'                     -> Int
1
    -- Combining
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x0300' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x036F'   -> Int
0
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x0370' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x10FC'   -> Int
1
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x1100' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x115F'   -> Int
2
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x1160' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x11A2'   -> Int
1
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x11A3' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x11A7'   -> Int
2
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x11A8' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x11F9'   -> Int
1
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x11FA' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x11FF'   -> Int
2
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x1200' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x2328'   -> Int
1
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x2329' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x232A'   -> Int
2
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x232B' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x2E31'   -> Int
1
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x2E80' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x303E'   -> Int
2
    | Char
c forall a. Eq a => a -> a -> Bool
== Char
'\x303F'                    -> Int
1
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x3041' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x3247'   -> Int
2
    -- Ambiguous
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x3248' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x324F'   -> Int
1
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x3250' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x4DBF'   -> Int
2
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x4DC0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x4DFF'   -> Int
1
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x4E00' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xA4C6'   -> Int
2
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\xA4D0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xA95F'   -> Int
1
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\xA960' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xA97C'   -> Int
2
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\xA980' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xABF9'   -> Int
1
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\xAC00' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xD7FB'   -> Int
2
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\xD800' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xDFFF'   -> Int
1
    -- Ambiguous
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\xE000' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xF8FF'   -> Int
1
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\xF900' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xFAFF'   -> Int
2
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\xFB00' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xFDFD'   -> Int
1
    -- Ambiguous
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\xFE00' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xFE0F'   -> Int
1
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\xFE10' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xFE19'   -> Int
2
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\xFE20' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xFE26'   -> Int
1
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\xFE30' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xFE6B'   -> Int
2
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\xFE70' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xFEFF'   -> Int
1
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\xFF01' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xFF60'   -> Int
2
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\xFF61' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x16A38'  -> Int
1
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x1B000' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x1B001' -> Int
2
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x1D000' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x1F1FF' -> Int
1
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x1F200' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x1F251' -> Int
2
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x1F300' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x1F773' -> Int
1
    | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\x20000' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x3FFFD' -> Int
2
    | Bool
otherwise                        -> Int
1
#endif