{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable     #-}
{-# LANGUAGE DeriveFunctor      #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DeriveTraversable  #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE MultiWayIf         #-}
{-# LANGUAGE NoImplicitPrelude  #-}
{-# LANGUAGE OverloadedStrings  #-}
{- |
   Module      : Text.DocLayout
   Copyright   : Copyright (C) 2010-2019 John MacFarlane
   License     : BSD 3

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

A prettyprinting library for the production of text documents,
including wrapped text, indentation and other prefixes, and
blocks for tables.
-}

module Text.DocLayout (
     -- * Rendering
       render
     , renderPlain
     , renderANSI
     -- * Doc constructors
     , cr
     , blankline
     , blanklines
     , space
     , literal
     , text
     , char
     , prefixed
     , flush
     , nest
     , hang
     , beforeNonBlank
     , nowrap
     , afterBreak
     , lblock
     , cblock
     , rblock
     , vfill
     , nestle
     , chomp
     , inside
     , braces
     , brackets
     , parens
     , quotes
     , doubleQuotes
     , bold
     , italic
     , underlined
     , strikeout
     , fg
     , bg
     , Color
     , black
     , red
     , green
     , yellow
     , blue
     , magenta
     , cyan
     , white
     , link
     , empty
     -- * Functions for concatenating documents
     , (<+>)
     , ($$)
     , ($+$)
     , hcat
     , hsep
     , vcat
     , vsep
     -- * Functions for querying documents
     , isEmpty
     , offset
     , minOffset
     , updateColumn
     , height
     , charWidth
     , realLength
     , realLengthNarrowContext
     , realLengthWideContext
     , realLengthNarrowContextNoShortcut
     , realLengthWideContextNoShortcut
     -- * Char properties
     , isSkinToneModifier
     , isEmojiVariation
     , isZWJ
     -- * Utility functions
     , unfoldD
     -- * Types
     , Doc(..)
     , HasChars(..)
     , Attributed
     )

where
import Prelude
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Safe (lastMay, initSafe)
import Control.Monad
import Control.Monad.State.Strict
import GHC.Generics
import Data.Bifunctor (second)
import Data.Char (isSpace, ord)
import Data.List (foldl', intersperse)
import Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.List.NonEmpty as N
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
import qualified Data.Map.Internal as MInt
import Data.Data (Data, Typeable)
import Data.Foldable (toList)
import Data.String
import qualified Data.Text as T
import Data.Text (Text)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as B
import Text.DocLayout.HasChars
import Text.DocLayout.ANSIFont
import Text.DocLayout.Attributed
#if MIN_VERSION_base(4,11,0)
#else
import Data.Semigroup
#endif
import Text.Emoji (baseEmojis)


-- | Document, including structure relevant for layout.
data Doc a = Text Int a            -- ^ Text with specified width.
         | Block Int [Attributed a]           -- ^ A block with a width and lines.
         | VFill Int a             -- ^ A vertically expandable block;
                 -- when concatenated with a block, expands to height
                 -- of block, with each line containing the specified text.
         | CookedText Int (Attributed a) -- ^ Text which doesn't need further cooking
         | Prefixed Text (Doc a)   -- ^ Doc with each line prefixed with text.
                 -- Note that trailing blanks are omitted from the prefix
                 -- when the line after it is empty.
         | BeforeNonBlank (Doc a)  -- ^ Doc that renders only before nonblank.
         | Flush (Doc a)           -- ^ Doc laid out flush to left margin.
         | BreakingSpace           -- ^ A space or line break, in context.
         | AfterBreak Text         -- ^ Text printed only at start of line.
         | CarriageReturn          -- ^ Newline unless we're at start of line.
         | NewLine                 -- ^ newline.
         | BlankLines Int          -- ^ Ensure a number of blank lines.
         | Concat (Doc a) (Doc a)  -- ^ Two documents concatenated.
         | Styled StyleReq (Doc a)
         | Linked Text (Doc a)       -- ^ A hyperlink
         | Empty
         deriving (Int -> Doc a -> ShowS
[Doc a] -> ShowS
Doc a -> String
(Int -> Doc a -> ShowS)
-> (Doc a -> String) -> ([Doc a] -> ShowS) -> Show (Doc a)
forall a. Show a => Int -> Doc a -> ShowS
forall a. Show a => [Doc a] -> ShowS
forall a. Show a => Doc a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Doc a -> ShowS
showsPrec :: Int -> Doc a -> ShowS
$cshow :: forall a. Show a => Doc a -> String
show :: Doc a -> String
$cshowList :: forall a. Show a => [Doc a] -> ShowS
showList :: [Doc a] -> ShowS
Show, ReadPrec [Doc a]
ReadPrec (Doc a)
Int -> ReadS (Doc a)
ReadS [Doc a]
(Int -> ReadS (Doc a))
-> ReadS [Doc a]
-> ReadPrec (Doc a)
-> ReadPrec [Doc a]
-> Read (Doc a)
forall a. Read a => ReadPrec [Doc a]
forall a. Read a => ReadPrec (Doc a)
forall a. Read a => Int -> ReadS (Doc a)
forall a. Read a => ReadS [Doc a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Doc a)
readsPrec :: Int -> ReadS (Doc a)
$creadList :: forall a. Read a => ReadS [Doc a]
readList :: ReadS [Doc a]
$creadPrec :: forall a. Read a => ReadPrec (Doc a)
readPrec :: ReadPrec (Doc a)
$creadListPrec :: forall a. Read a => ReadPrec [Doc a]
readListPrec :: ReadPrec [Doc a]
Read, Doc a -> Doc a -> Bool
(Doc a -> Doc a -> Bool) -> (Doc a -> Doc a -> Bool) -> Eq (Doc a)
forall a. Eq a => Doc a -> Doc a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Doc a -> Doc a -> Bool
== :: Doc a -> Doc a -> Bool
$c/= :: forall a. Eq a => Doc a -> Doc a -> Bool
/= :: Doc a -> Doc a -> Bool
Eq, Eq (Doc a)
Eq (Doc a) =>
(Doc a -> Doc a -> Ordering)
-> (Doc a -> Doc a -> Bool)
-> (Doc a -> Doc a -> Bool)
-> (Doc a -> Doc a -> Bool)
-> (Doc a -> Doc a -> Bool)
-> (Doc a -> Doc a -> Doc a)
-> (Doc a -> Doc a -> Doc a)
-> Ord (Doc a)
Doc a -> Doc a -> Bool
Doc a -> Doc a -> Ordering
Doc a -> Doc a -> Doc a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Doc a)
forall a. Ord a => Doc a -> Doc a -> Bool
forall a. Ord a => Doc a -> Doc a -> Ordering
forall a. Ord a => Doc a -> Doc a -> Doc a
$ccompare :: forall a. Ord a => Doc a -> Doc a -> Ordering
compare :: Doc a -> Doc a -> Ordering
$c< :: forall a. Ord a => Doc a -> Doc a -> Bool
< :: Doc a -> Doc a -> Bool
$c<= :: forall a. Ord a => Doc a -> Doc a -> Bool
<= :: Doc a -> Doc a -> Bool
$c> :: forall a. Ord a => Doc a -> Doc a -> Bool
> :: Doc a -> Doc a -> Bool
$c>= :: forall a. Ord a => Doc a -> Doc a -> Bool
>= :: Doc a -> Doc a -> Bool
$cmax :: forall a. Ord a => Doc a -> Doc a -> Doc a
max :: Doc a -> Doc a -> Doc a
$cmin :: forall a. Ord a => Doc a -> Doc a -> Doc a
min :: Doc a -> Doc a -> Doc a
Ord, (forall a b. (a -> b) -> Doc a -> Doc b)
-> (forall a b. a -> Doc b -> Doc a) -> Functor Doc
forall a b. a -> Doc b -> Doc a
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Doc a -> Doc b
fmap :: forall a b. (a -> b) -> Doc a -> Doc b
$c<$ :: forall a b. a -> Doc b -> Doc a
<$ :: forall a b. a -> Doc b -> Doc a
Functor, (forall m. Monoid m => Doc m -> m)
-> (forall m a. Monoid m => (a -> m) -> Doc a -> m)
-> (forall m a. Monoid m => (a -> m) -> Doc a -> m)
-> (forall a b. (a -> b -> b) -> b -> Doc a -> b)
-> (forall a b. (a -> b -> b) -> b -> Doc a -> b)
-> (forall b a. (b -> a -> b) -> b -> Doc a -> b)
-> (forall b a. (b -> a -> b) -> b -> Doc a -> b)
-> (forall a. (a -> a -> a) -> Doc a -> a)
-> (forall a. (a -> a -> a) -> Doc a -> a)
-> (forall a. Doc a -> [a])
-> (forall a. Doc a -> Bool)
-> (forall a. Doc a -> Int)
-> (forall a. Eq a => a -> Doc a -> Bool)
-> (forall a. Ord a => Doc a -> a)
-> (forall a. Ord a => Doc a -> a)
-> (forall a. Num a => Doc a -> a)
-> (forall a. Num a => Doc a -> a)
-> Foldable Doc
forall a. Eq a => a -> Doc a -> Bool
forall a. Num a => Doc a -> a
forall a. Ord a => Doc a -> a
forall m. Monoid m => Doc m -> m
forall a. Doc a -> Bool
forall a. Doc a -> Int
forall a. Doc a -> [a]
forall a. (a -> a -> a) -> Doc a -> a
forall m a. Monoid m => (a -> m) -> Doc a -> m
forall b a. (b -> a -> b) -> b -> Doc a -> b
forall a b. (a -> b -> b) -> b -> Doc a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Doc m -> m
fold :: forall m. Monoid m => Doc m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Doc a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Doc a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Doc a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Doc a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Doc a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Doc a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Doc a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Doc a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Doc a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Doc a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Doc a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Doc a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Doc a -> a
foldr1 :: forall a. (a -> a -> a) -> Doc a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Doc a -> a
foldl1 :: forall a. (a -> a -> a) -> Doc a -> a
$ctoList :: forall a. Doc a -> [a]
toList :: forall a. Doc a -> [a]
$cnull :: forall a. Doc a -> Bool
null :: forall a. Doc a -> Bool
$clength :: forall a. Doc a -> Int
length :: forall a. Doc a -> Int
$celem :: forall a. Eq a => a -> Doc a -> Bool
elem :: forall a. Eq a => a -> Doc a -> Bool
$cmaximum :: forall a. Ord a => Doc a -> a
maximum :: forall a. Ord a => Doc a -> a
$cminimum :: forall a. Ord a => Doc a -> a
minimum :: forall a. Ord a => Doc a -> a
$csum :: forall a. Num a => Doc a -> a
sum :: forall a. Num a => Doc a -> a
$cproduct :: forall a. Num a => Doc a -> a
product :: forall a. Num a => Doc a -> a
Foldable, Functor Doc
Foldable Doc
(Functor Doc, Foldable Doc) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Doc a -> f (Doc b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Doc (f a) -> f (Doc a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Doc a -> m (Doc b))
-> (forall (m :: * -> *) a. Monad m => Doc (m a) -> m (Doc a))
-> Traversable Doc
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Doc (m a) -> m (Doc a)
forall (f :: * -> *) a. Applicative f => Doc (f a) -> f (Doc a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Doc a -> m (Doc b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Doc a -> f (Doc b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Doc a -> f (Doc b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Doc a -> f (Doc b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Doc (f a) -> f (Doc a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Doc (f a) -> f (Doc a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Doc a -> m (Doc b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Doc a -> m (Doc b)
$csequence :: forall (m :: * -> *) a. Monad m => Doc (m a) -> m (Doc a)
sequence :: forall (m :: * -> *) a. Monad m => Doc (m a) -> m (Doc a)
Traversable,
                  Typeable (Doc a)
Typeable (Doc a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Doc a -> c (Doc a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Doc a))
-> (Doc a -> Constr)
-> (Doc a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Doc a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Doc a)))
-> ((forall b. Data b => b -> b) -> Doc a -> Doc a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Doc a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Doc a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Doc a -> m (Doc a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Doc a -> m (Doc a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Doc a -> m (Doc a))
-> Data (Doc a)
Doc a -> Constr
Doc a -> DataType
(forall b. Data b => b -> b) -> Doc a -> Doc a
forall a. Data a => Typeable (Doc a)
forall a. Data a => Doc a -> Constr
forall a. Data a => Doc a -> DataType
forall a. Data a => (forall b. Data b => b -> b) -> Doc a -> Doc a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Doc a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Doc a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Doc a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doc a -> c (Doc a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Doc a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Doc a))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Doc a -> u
forall u. (forall d. Data d => d -> u) -> Doc a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Doc a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doc a -> c (Doc a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Doc a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Doc a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doc a -> c (Doc a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doc a -> c (Doc a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Doc a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Doc a)
$ctoConstr :: forall a. Data a => Doc a -> Constr
toConstr :: Doc a -> Constr
$cdataTypeOf :: forall a. Data a => Doc a -> DataType
dataTypeOf :: Doc a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Doc a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Doc a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Doc a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Doc a))
$cgmapT :: forall a. Data a => (forall b. Data b => b -> b) -> Doc a -> Doc a
gmapT :: (forall b. Data b => b -> b) -> Doc a -> Doc a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Doc a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Doc a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Doc a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Doc a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
Data, Typeable, (forall x. Doc a -> Rep (Doc a) x)
-> (forall x. Rep (Doc a) x -> Doc a) -> Generic (Doc a)
forall x. Rep (Doc a) x -> Doc a
forall x. Doc a -> Rep (Doc a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Doc a) x -> Doc a
forall a x. Doc a -> Rep (Doc a) x
$cfrom :: forall a x. Doc a -> Rep (Doc a) x
from :: forall x. Doc a -> Rep (Doc a) x
$cto :: forall a x. Rep (Doc a) x -> Doc a
to :: forall x. Rep (Doc a) x -> Doc a
Generic)


instance Semigroup (Doc a) where
  Doc a
x <> :: Doc a -> Doc a -> Doc a
<> Doc a
Empty = Doc a
x
  Doc a
Empty <> Doc a
x = Doc a
x
  Doc a
x <> Doc a
y     = Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Concat Doc a
x Doc a
y

instance Monoid (Doc a) where
  mappend :: Doc a -> Doc a -> Doc a
mappend = Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: Doc a
mempty = Doc a
forall a. Doc a
Empty

instance HasChars a => IsString (Doc a) where
  fromString :: String -> Doc a
fromString = String -> Doc a
forall a. HasChars a => String -> Doc a
text

{-# DEPRECATED unfoldD "unfoldD will be removed from the API." #-}
-- | Unfold a 'Doc' into a flat list.
unfoldD :: Doc a -> [Doc a]
unfoldD :: forall a. Doc a -> [Doc a]
unfoldD Doc a
Empty = []
unfoldD (Concat x :: Doc a
x@Concat{} Doc a
y) = Doc a -> [Doc a]
forall a. Doc a -> [Doc a]
unfoldD Doc a
x [Doc a] -> [Doc a] -> [Doc a]
forall a. Semigroup a => a -> a -> a
<> Doc a -> [Doc a]
forall a. Doc a -> [Doc a]
unfoldD Doc a
y
unfoldD (Concat Doc a
x Doc a
y)          = Doc a
x Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: Doc a -> [Doc a]
forall a. Doc a -> [Doc a]
unfoldD Doc a
y
unfoldD Doc a
x                     = [Doc a
x]

-- | True if the document is empty.
isEmpty :: Doc a -> Bool
isEmpty :: forall a. Doc a -> Bool
isEmpty Doc a
Empty = Bool
True
isEmpty Doc a
_     = Bool
False

-- | The empty document.
empty :: Doc a
empty :: forall a. Doc a
empty = Doc a
forall a. Monoid a => a
mempty

-- | Concatenate documents horizontally.
hcat :: [Doc a] -> Doc a
hcat :: forall a. [Doc a] -> Doc a
hcat = [Doc a] -> Doc a
forall a. Monoid a => [a] -> a
mconcat

-- | Concatenate a list of 'Doc's, putting breakable spaces
-- between them.
infixr 6 <+>
(<+>) :: Doc a -> Doc a -> Doc a
<+> :: forall a. Doc a -> Doc a -> Doc a
(<+>) Doc a
x Doc a
y
  | Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
x = Doc a
y
  | Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
y = Doc a
x
  | Bool
otherwise = Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall a. Doc a
space Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
y

-- | Same as 'hcat', but putting breakable spaces between the
-- 'Doc's.
hsep :: [Doc a] -> Doc a
hsep :: forall a. [Doc a] -> Doc a
hsep = (Doc a -> Doc a -> Doc a) -> Doc a -> [Doc a] -> Doc a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
(<+>) Doc a
forall a. Doc a
empty

infixr 5 $$
-- | @a $$ b@ puts @a@ above @b@.
($$) :: Doc a -> Doc a -> Doc a
$$ :: forall a. Doc a -> Doc a -> Doc a
($$) Doc a
x Doc a
y
  | Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
x = Doc a
y
  | Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
y = Doc a
x
  | Bool
otherwise = Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall a. Doc a
cr Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
y

infixr 5 $+$
-- | @a $+$ b@ puts @a@ above @b@, with a blank line between.
($+$) :: Doc a -> Doc a -> Doc a
$+$ :: forall a. Doc a -> Doc a -> Doc a
($+$) Doc a
x Doc a
y
  | Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
x = Doc a
y
  | Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
y = Doc a
x
  | Bool
otherwise = Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall a. Doc a
blankline Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
y

-- | List version of '$$'.
vcat :: [Doc a] -> Doc a
vcat :: forall a. [Doc a] -> Doc a
vcat = (Doc a -> Doc a -> Doc a) -> Doc a -> [Doc a] -> Doc a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
($$) Doc a
forall a. Doc a
empty

-- | List version of '$+$'.
vsep :: [Doc a] -> Doc a
vsep :: forall a. [Doc a] -> Doc a
vsep = (Doc a -> Doc a -> Doc a) -> Doc a -> [Doc a] -> Doc a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
($+$) Doc a
forall a. Doc a
empty

-- | Removes leading blank lines from a 'Doc'.
nestle :: Doc a -> Doc a
nestle :: forall a. Doc a -> Doc a
nestle Doc a
d =
  case Doc a
d of
    BlankLines Int
_              -> Doc a
forall a. Doc a
Empty
    Doc a
NewLine                   -> Doc a
forall a. Doc a
Empty
    Concat (Concat Doc a
x Doc a
y) Doc a
z     -> Doc a -> Doc a
forall a. Doc a -> Doc a
nestle (Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Concat Doc a
x (Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Concat Doc a
y Doc a
z))
    Concat BlankLines{} Doc a
x     -> Doc a -> Doc a
forall a. Doc a -> Doc a
nestle Doc a
x
    Concat Doc a
NewLine Doc a
x          -> Doc a -> Doc a
forall a. Doc a -> Doc a
nestle Doc a
x
    Doc a
_                         -> Doc a
d

-- | Chomps trailing blank space off of a 'Doc'.
chomp :: Doc a -> Doc a
chomp :: forall a. Doc a -> Doc a
chomp Doc a
d =
    case Doc a
d of
    BlankLines Int
_              -> Doc a
forall a. Doc a
Empty
    Doc a
NewLine                   -> Doc a
forall a. Doc a
Empty
    Doc a
CarriageReturn            -> Doc a
forall a. Doc a
Empty
    Doc a
BreakingSpace             -> Doc a
forall a. Doc a
Empty
    Prefixed Text
s Doc a
d'             -> Text -> Doc a -> Doc a
forall a. Text -> Doc a -> Doc a
Prefixed Text
s (Doc a -> Doc a
forall a. Doc a -> Doc a
chomp Doc a
d')
    Concat (Concat Doc a
x Doc a
y) Doc a
z     -> Doc a -> Doc a
forall a. Doc a -> Doc a
chomp (Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Concat Doc a
x (Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Concat Doc a
y Doc a
z))
    Concat Doc a
x Doc a
y                ->
        case Doc a -> Doc a
forall a. Doc a -> Doc a
chomp Doc a
y of
          Doc a
Empty -> Doc a -> Doc a
forall a. Doc a -> Doc a
chomp Doc a
x
          Doc a
z     -> Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
z
    Doc a
_                         -> Doc a
d

-- Elements of a document with Styled and Linked subtrees flattened out into
-- a linear structure with open and close tags. An implementation detail of
-- the rendering process.
data FlatDoc a = FText Int a
               | FBlock Int [Attributed a]
               | FVFill Int a
               | FCookedText Int (Attributed a)
               | FPrefixed Text (NonEmpty (FlatDoc a))
               | FBeforeNonBlank (NonEmpty (FlatDoc a))
               | FFlush (NonEmpty (FlatDoc a))
               | FBreakingSpace
               | FAfterBreak (NonEmpty (FlatDoc a))
               | FCarriageReturn
               | FNewLine
               | FBlankLines Int
               | FStyleOpen StyleReq
               | FStyleClose
               | FLinkOpen Text
               | FLinkClose
         deriving (Int -> FlatDoc a -> ShowS
[FlatDoc a] -> ShowS
FlatDoc a -> String
(Int -> FlatDoc a -> ShowS)
-> (FlatDoc a -> String)
-> ([FlatDoc a] -> ShowS)
-> Show (FlatDoc a)
forall a. Show a => Int -> FlatDoc a -> ShowS
forall a. Show a => [FlatDoc a] -> ShowS
forall a. Show a => FlatDoc a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> FlatDoc a -> ShowS
showsPrec :: Int -> FlatDoc a -> ShowS
$cshow :: forall a. Show a => FlatDoc a -> String
show :: FlatDoc a -> String
$cshowList :: forall a. Show a => [FlatDoc a] -> ShowS
showList :: [FlatDoc a] -> ShowS
Show, ReadPrec [FlatDoc a]
ReadPrec (FlatDoc a)
Int -> ReadS (FlatDoc a)
ReadS [FlatDoc a]
(Int -> ReadS (FlatDoc a))
-> ReadS [FlatDoc a]
-> ReadPrec (FlatDoc a)
-> ReadPrec [FlatDoc a]
-> Read (FlatDoc a)
forall a. Read a => ReadPrec [FlatDoc a]
forall a. Read a => ReadPrec (FlatDoc a)
forall a. Read a => Int -> ReadS (FlatDoc a)
forall a. Read a => ReadS [FlatDoc a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (FlatDoc a)
readsPrec :: Int -> ReadS (FlatDoc a)
$creadList :: forall a. Read a => ReadS [FlatDoc a]
readList :: ReadS [FlatDoc a]
$creadPrec :: forall a. Read a => ReadPrec (FlatDoc a)
readPrec :: ReadPrec (FlatDoc a)
$creadListPrec :: forall a. Read a => ReadPrec [FlatDoc a]
readListPrec :: ReadPrec [FlatDoc a]
Read, FlatDoc a -> FlatDoc a -> Bool
(FlatDoc a -> FlatDoc a -> Bool)
-> (FlatDoc a -> FlatDoc a -> Bool) -> Eq (FlatDoc a)
forall a. Eq a => FlatDoc a -> FlatDoc a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => FlatDoc a -> FlatDoc a -> Bool
== :: FlatDoc a -> FlatDoc a -> Bool
$c/= :: forall a. Eq a => FlatDoc a -> FlatDoc a -> Bool
/= :: FlatDoc a -> FlatDoc a -> Bool
Eq, Eq (FlatDoc a)
Eq (FlatDoc a) =>
(FlatDoc a -> FlatDoc a -> Ordering)
-> (FlatDoc a -> FlatDoc a -> Bool)
-> (FlatDoc a -> FlatDoc a -> Bool)
-> (FlatDoc a -> FlatDoc a -> Bool)
-> (FlatDoc a -> FlatDoc a -> Bool)
-> (FlatDoc a -> FlatDoc a -> FlatDoc a)
-> (FlatDoc a -> FlatDoc a -> FlatDoc a)
-> Ord (FlatDoc a)
FlatDoc a -> FlatDoc a -> Bool
FlatDoc a -> FlatDoc a -> Ordering
FlatDoc a -> FlatDoc a -> FlatDoc a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (FlatDoc a)
forall a. Ord a => FlatDoc a -> FlatDoc a -> Bool
forall a. Ord a => FlatDoc a -> FlatDoc a -> Ordering
forall a. Ord a => FlatDoc a -> FlatDoc a -> FlatDoc a
$ccompare :: forall a. Ord a => FlatDoc a -> FlatDoc a -> Ordering
compare :: FlatDoc a -> FlatDoc a -> Ordering
$c< :: forall a. Ord a => FlatDoc a -> FlatDoc a -> Bool
< :: FlatDoc a -> FlatDoc a -> Bool
$c<= :: forall a. Ord a => FlatDoc a -> FlatDoc a -> Bool
<= :: FlatDoc a -> FlatDoc a -> Bool
$c> :: forall a. Ord a => FlatDoc a -> FlatDoc a -> Bool
> :: FlatDoc a -> FlatDoc a -> Bool
$c>= :: forall a. Ord a => FlatDoc a -> FlatDoc a -> Bool
>= :: FlatDoc a -> FlatDoc a -> Bool
$cmax :: forall a. Ord a => FlatDoc a -> FlatDoc a -> FlatDoc a
max :: FlatDoc a -> FlatDoc a -> FlatDoc a
$cmin :: forall a. Ord a => FlatDoc a -> FlatDoc a -> FlatDoc a
min :: FlatDoc a -> FlatDoc a -> FlatDoc a
Ord, (forall a b. (a -> b) -> FlatDoc a -> FlatDoc b)
-> (forall a b. a -> FlatDoc b -> FlatDoc a) -> Functor FlatDoc
forall a b. a -> FlatDoc b -> FlatDoc a
forall a b. (a -> b) -> FlatDoc a -> FlatDoc b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> FlatDoc a -> FlatDoc b
fmap :: forall a b. (a -> b) -> FlatDoc a -> FlatDoc b
$c<$ :: forall a b. a -> FlatDoc b -> FlatDoc a
<$ :: forall a b. a -> FlatDoc b -> FlatDoc a
Functor, (forall m. Monoid m => FlatDoc m -> m)
-> (forall m a. Monoid m => (a -> m) -> FlatDoc a -> m)
-> (forall m a. Monoid m => (a -> m) -> FlatDoc a -> m)
-> (forall a b. (a -> b -> b) -> b -> FlatDoc a -> b)
-> (forall a b. (a -> b -> b) -> b -> FlatDoc a -> b)
-> (forall b a. (b -> a -> b) -> b -> FlatDoc a -> b)
-> (forall b a. (b -> a -> b) -> b -> FlatDoc a -> b)
-> (forall a. (a -> a -> a) -> FlatDoc a -> a)
-> (forall a. (a -> a -> a) -> FlatDoc a -> a)
-> (forall a. FlatDoc a -> [a])
-> (forall a. FlatDoc a -> Bool)
-> (forall a. FlatDoc a -> Int)
-> (forall a. Eq a => a -> FlatDoc a -> Bool)
-> (forall a. Ord a => FlatDoc a -> a)
-> (forall a. Ord a => FlatDoc a -> a)
-> (forall a. Num a => FlatDoc a -> a)
-> (forall a. Num a => FlatDoc a -> a)
-> Foldable FlatDoc
forall a. Eq a => a -> FlatDoc a -> Bool
forall a. Num a => FlatDoc a -> a
forall a. Ord a => FlatDoc a -> a
forall m. Monoid m => FlatDoc m -> m
forall a. FlatDoc a -> Bool
forall a. FlatDoc a -> Int
forall a. FlatDoc a -> [a]
forall a. (a -> a -> a) -> FlatDoc a -> a
forall m a. Monoid m => (a -> m) -> FlatDoc a -> m
forall b a. (b -> a -> b) -> b -> FlatDoc a -> b
forall a b. (a -> b -> b) -> b -> FlatDoc a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => FlatDoc m -> m
fold :: forall m. Monoid m => FlatDoc m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> FlatDoc a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> FlatDoc a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> FlatDoc a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> FlatDoc a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> FlatDoc a -> b
foldr :: forall a b. (a -> b -> b) -> b -> FlatDoc a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> FlatDoc a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> FlatDoc a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> FlatDoc a -> b
foldl :: forall b a. (b -> a -> b) -> b -> FlatDoc a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> FlatDoc a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> FlatDoc a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> FlatDoc a -> a
foldr1 :: forall a. (a -> a -> a) -> FlatDoc a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> FlatDoc a -> a
foldl1 :: forall a. (a -> a -> a) -> FlatDoc a -> a
$ctoList :: forall a. FlatDoc a -> [a]
toList :: forall a. FlatDoc a -> [a]
$cnull :: forall a. FlatDoc a -> Bool
null :: forall a. FlatDoc a -> Bool
$clength :: forall a. FlatDoc a -> Int
length :: forall a. FlatDoc a -> Int
$celem :: forall a. Eq a => a -> FlatDoc a -> Bool
elem :: forall a. Eq a => a -> FlatDoc a -> Bool
$cmaximum :: forall a. Ord a => FlatDoc a -> a
maximum :: forall a. Ord a => FlatDoc a -> a
$cminimum :: forall a. Ord a => FlatDoc a -> a
minimum :: forall a. Ord a => FlatDoc a -> a
$csum :: forall a. Num a => FlatDoc a -> a
sum :: forall a. Num a => FlatDoc a -> a
$cproduct :: forall a. Num a => FlatDoc a -> a
product :: forall a. Num a => FlatDoc a -> a
Foldable, Functor FlatDoc
Foldable FlatDoc
(Functor FlatDoc, Foldable FlatDoc) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> FlatDoc a -> f (FlatDoc b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    FlatDoc (f a) -> f (FlatDoc a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> FlatDoc a -> m (FlatDoc b))
-> (forall (m :: * -> *) a.
    Monad m =>
    FlatDoc (m a) -> m (FlatDoc a))
-> Traversable FlatDoc
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => FlatDoc (m a) -> m (FlatDoc a)
forall (f :: * -> *) a.
Applicative f =>
FlatDoc (f a) -> f (FlatDoc a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FlatDoc a -> m (FlatDoc b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FlatDoc a -> f (FlatDoc b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FlatDoc a -> f (FlatDoc b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FlatDoc a -> f (FlatDoc b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
FlatDoc (f a) -> f (FlatDoc a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
FlatDoc (f a) -> f (FlatDoc a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FlatDoc a -> m (FlatDoc b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FlatDoc a -> m (FlatDoc b)
$csequence :: forall (m :: * -> *) a. Monad m => FlatDoc (m a) -> m (FlatDoc a)
sequence :: forall (m :: * -> *) a. Monad m => FlatDoc (m a) -> m (FlatDoc a)
Traversable,
                  Typeable (FlatDoc a)
Typeable (FlatDoc a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> FlatDoc a -> c (FlatDoc a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (FlatDoc a))
-> (FlatDoc a -> Constr)
-> (FlatDoc a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (FlatDoc a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (FlatDoc a)))
-> ((forall b. Data b => b -> b) -> FlatDoc a -> FlatDoc a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FlatDoc a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FlatDoc a -> r)
-> (forall u. (forall d. Data d => d -> u) -> FlatDoc a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FlatDoc a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FlatDoc a -> m (FlatDoc a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FlatDoc a -> m (FlatDoc a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FlatDoc a -> m (FlatDoc a))
-> Data (FlatDoc a)
FlatDoc a -> Constr
FlatDoc a -> DataType
(forall b. Data b => b -> b) -> FlatDoc a -> FlatDoc a
forall a. Data a => Typeable (FlatDoc a)
forall a. Data a => FlatDoc a -> Constr
forall a. Data a => FlatDoc a -> DataType
forall a.
Data a =>
(forall b. Data b => b -> b) -> FlatDoc a -> FlatDoc a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> FlatDoc a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> FlatDoc a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FlatDoc a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FlatDoc a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> FlatDoc a -> m (FlatDoc a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> FlatDoc a -> m (FlatDoc a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FlatDoc a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FlatDoc a -> c (FlatDoc a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FlatDoc a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FlatDoc a))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FlatDoc a -> u
forall u. (forall d. Data d => d -> u) -> FlatDoc a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FlatDoc a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FlatDoc a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FlatDoc a -> m (FlatDoc a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FlatDoc a -> m (FlatDoc a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FlatDoc a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FlatDoc a -> c (FlatDoc a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FlatDoc a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FlatDoc a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FlatDoc a -> c (FlatDoc a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FlatDoc a -> c (FlatDoc a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FlatDoc a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FlatDoc a)
$ctoConstr :: forall a. Data a => FlatDoc a -> Constr
toConstr :: FlatDoc a -> Constr
$cdataTypeOf :: forall a. Data a => FlatDoc a -> DataType
dataTypeOf :: FlatDoc a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FlatDoc a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FlatDoc a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FlatDoc a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FlatDoc a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> FlatDoc a -> FlatDoc a
gmapT :: (forall b. Data b => b -> b) -> FlatDoc a -> FlatDoc a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FlatDoc a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FlatDoc a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FlatDoc a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FlatDoc a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> FlatDoc a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FlatDoc a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> FlatDoc a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FlatDoc a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> FlatDoc a -> m (FlatDoc a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FlatDoc a -> m (FlatDoc a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> FlatDoc a -> m (FlatDoc a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FlatDoc a -> m (FlatDoc a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> FlatDoc a -> m (FlatDoc a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FlatDoc a -> m (FlatDoc a)
Data, Typeable, (forall x. FlatDoc a -> Rep (FlatDoc a) x)
-> (forall x. Rep (FlatDoc a) x -> FlatDoc a)
-> Generic (FlatDoc a)
forall x. Rep (FlatDoc a) x -> FlatDoc a
forall x. FlatDoc a -> Rep (FlatDoc a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (FlatDoc a) x -> FlatDoc a
forall a x. FlatDoc a -> Rep (FlatDoc a) x
$cfrom :: forall a x. FlatDoc a -> Rep (FlatDoc a) x
from :: forall x. FlatDoc a -> Rep (FlatDoc a) x
$cto :: forall a x. Rep (FlatDoc a) x -> FlatDoc a
to :: forall x. Rep (FlatDoc a) x -> FlatDoc a
Generic)

-- Given a Doc, return an equivalent list of FlatDocs, to be processed by
-- renderList. Worth noting:
--   * Treelike docs (Styled, and Linked) are turned into lists beginning
--     with an "open" tag and ending with a "close" tag, with the flattened
--     inner content in between.
--   * Other Docs with inner content are eliminated if the inner content is
--     empty, otherwise the inner content is itself flattened and made into
--     a NonEmpty.
flatten :: HasChars a => Doc a -> [FlatDoc a]
flatten :: forall a. HasChars a => Doc a -> [FlatDoc a]
flatten (Text Int
n a
a) = [Int -> a -> FlatDoc a
forall a. Int -> a -> FlatDoc a
FText Int
n a
a]
flatten (Block Int
n [Attributed a]
a) = [Int -> [Attributed a] -> FlatDoc a
forall a. Int -> [Attributed a] -> FlatDoc a
FBlock Int
n [Attributed a]
a]
flatten (VFill Int
n a
a) = [Int -> a -> FlatDoc a
forall a. Int -> a -> FlatDoc a
FVFill Int
n a
a]
flatten (CookedText Int
n Attributed a
a) = [Int -> Attributed a -> FlatDoc a
forall a. Int -> Attributed a -> FlatDoc a
FCookedText Int
n Attributed a
a]
flatten (Prefixed Text
p Doc a
d) | [FlatDoc a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FlatDoc a]
f = []
                       | Bool
otherwise = [Text -> NonEmpty (FlatDoc a) -> FlatDoc a
forall a. Text -> NonEmpty (FlatDoc a) -> FlatDoc a
FPrefixed Text
p ([FlatDoc a] -> NonEmpty (FlatDoc a)
forall a. HasCallStack => [a] -> NonEmpty a
N.fromList [FlatDoc a]
f)]
                       where f :: [FlatDoc a]
f = ([FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize ([FlatDoc a] -> [FlatDoc a])
-> (Doc a -> [FlatDoc a]) -> Doc a -> [FlatDoc a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> [FlatDoc a]
forall a. HasChars a => Doc a -> [FlatDoc a]
flatten) Doc a
d
flatten (BeforeNonBlank Doc a
d) | [FlatDoc a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FlatDoc a]
f = []
                           | Bool
otherwise = [NonEmpty (FlatDoc a) -> FlatDoc a
forall a. NonEmpty (FlatDoc a) -> FlatDoc a
FBeforeNonBlank ([FlatDoc a] -> NonEmpty (FlatDoc a)
forall a. HasCallStack => [a] -> NonEmpty a
N.fromList [FlatDoc a]
f)]
                           where f :: [FlatDoc a]
f = Doc a -> [FlatDoc a]
forall a. HasChars a => Doc a -> [FlatDoc a]
flatten Doc a
d
flatten (Flush Doc a
d) | [FlatDoc a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FlatDoc a]
f = []
                  | Bool
otherwise = [NonEmpty (FlatDoc a) -> FlatDoc a
forall a. NonEmpty (FlatDoc a) -> FlatDoc a
FFlush ([FlatDoc a] -> NonEmpty (FlatDoc a)
forall a. HasCallStack => [a] -> NonEmpty a
N.fromList [FlatDoc a]
f)]
                  where f :: [FlatDoc a]
f = Doc a -> [FlatDoc a]
forall a. HasChars a => Doc a -> [FlatDoc a]
flatten Doc a
d
flatten Doc a
BreakingSpace = [FlatDoc a
forall a. FlatDoc a
FBreakingSpace]
flatten Doc a
CarriageReturn = [FlatDoc a
forall a. FlatDoc a
FCarriageReturn]
flatten (AfterBreak Text
t) | [FlatDoc a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FlatDoc a]
f = []
                       | Bool
otherwise = [NonEmpty (FlatDoc a) -> FlatDoc a
forall a. NonEmpty (FlatDoc a) -> FlatDoc a
FAfterBreak ([FlatDoc a] -> NonEmpty (FlatDoc a)
forall a. HasCallStack => [a] -> NonEmpty a
N.fromList [FlatDoc a]
f)]
                       where f :: [FlatDoc a]
f = Doc a -> [FlatDoc a]
forall a. HasChars a => Doc a -> [FlatDoc a]
flatten (Doc a -> [FlatDoc a]) -> Doc a -> [FlatDoc a]
forall a b. (a -> b) -> a -> b
$ String -> Doc a
forall a. IsString a => String -> a
fromString (String -> Doc a) -> String -> Doc a
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t
flatten Doc a
NewLine = [FlatDoc a
forall a. FlatDoc a
FNewLine]
flatten (BlankLines Int
n) = [Int -> FlatDoc a
forall a. Int -> FlatDoc a
FBlankLines Int
n]
flatten Doc a
Empty = []
flatten (Concat Doc a
x Doc a
y) = Doc a -> [FlatDoc a]
forall a. HasChars a => Doc a -> [FlatDoc a]
flatten Doc a
x [FlatDoc a] -> [FlatDoc a] -> [FlatDoc a]
forall a. Semigroup a => a -> a -> a
<> Doc a -> [FlatDoc a]
forall a. HasChars a => Doc a -> [FlatDoc a]
flatten Doc a
y
flatten (Linked Text
l Doc a
x) = Text -> FlatDoc a
forall a. Text -> FlatDoc a
FLinkOpen Text
l FlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
: Doc a -> [FlatDoc a]
forall a. HasChars a => Doc a -> [FlatDoc a]
flatten Doc a
x [FlatDoc a] -> [FlatDoc a] -> [FlatDoc a]
forall a. Semigroup a => a -> a -> a
<> [FlatDoc a
forall a. FlatDoc a
FLinkClose]
flatten (Styled StyleReq
f Doc a
x) = StyleReq -> FlatDoc a
forall a. StyleReq -> FlatDoc a
FStyleOpen StyleReq
f FlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
: Doc a -> [FlatDoc a]
forall a. HasChars a => Doc a -> [FlatDoc a]
flatten Doc a
x [FlatDoc a] -> [FlatDoc a] -> [FlatDoc a]
forall a. Semigroup a => a -> a -> a
<> [FlatDoc a
forall a. FlatDoc a
FStyleClose]

type DocState a = State (RenderState a) ()

data RenderState a = RenderState{
         forall a. RenderState a -> [Attr a]
output     :: [Attr a]        -- ^ In reverse order
       , forall a. RenderState a -> Text
prefix     :: Text
       , forall a. RenderState a -> Bool
usePrefix  :: Bool
       , forall a. RenderState a -> Maybe Int
lineLength :: Maybe Int  -- ^ 'Nothing' means no wrapping
       , forall a. RenderState a -> Int
column     :: Int
       , forall a. RenderState a -> Int
newlines   :: Int        -- ^ Number of preceding newlines
       , forall a. RenderState a -> [Font]
fontStack  :: [Font]
       , forall a. RenderState a -> Maybe Text
linkTarget :: Maybe Text -- ^ Current link target
       }

peekFont :: RenderState a -> Font
peekFont :: forall a. RenderState a -> Font
peekFont RenderState a
st = case RenderState a -> [Font]
forall a. RenderState a -> [Font]
fontStack RenderState a
st of
                [] -> Font
baseFont
                Font
x:[Font]
_ -> Font
x

newline :: HasChars a => DocState a
newline :: forall a. HasChars a => DocState a
newline = do
  RenderState a
st' <- StateT (RenderState a) Identity (RenderState a)
forall s (m :: * -> *). MonadState s m => m s
get
  let rawpref :: Text
rawpref = RenderState a -> Text
forall a. RenderState a -> Text
prefix RenderState a
st'
  Bool -> DocState a -> DocState a
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RenderState a -> Int
forall a. RenderState a -> Int
column RenderState a
st' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& RenderState a -> Bool
forall a. RenderState a -> Bool
usePrefix RenderState a
st' Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
rawpref)) (DocState a -> DocState a) -> DocState a -> DocState a
forall a b. (a -> b) -> a -> b
$ do
     let pref :: a
pref = String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isSpace Text
rawpref
     (RenderState a -> RenderState a) -> DocState a
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RenderState a -> RenderState a) -> DocState a)
-> (RenderState a -> RenderState a) -> DocState a
forall a b. (a -> b) -> a -> b
$ \RenderState a
st -> RenderState a
st{ output = Attr Nothing baseFont pref : output st
                       , column = column st + realLength pref }
  (RenderState a -> RenderState a) -> DocState a
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RenderState a -> RenderState a) -> DocState a)
-> (RenderState a -> RenderState a) -> DocState a
forall a b. (a -> b) -> a -> b
$ \RenderState a
st -> RenderState a
st { output = Attr Nothing baseFont "\n" : output st
                     , column = 0
                     , newlines = newlines st + 1
                     }

outp :: HasChars a => Int -> a -> DocState a
outp :: forall a. HasChars a => Int -> a -> DocState a
outp Int
off a
s = do           -- offset >= 0 (0 might be combining char)
  RenderState a
st' <- StateT (RenderState a) Identity (RenderState a)
forall s (m :: * -> *). MonadState s m => m s
get
  let pref :: a
pref = if RenderState a -> Bool
forall a. RenderState a -> Bool
usePrefix RenderState a
st' then String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ RenderState a -> Text
forall a. RenderState a -> Text
prefix RenderState a
st' else a
forall a. Monoid a => a
mempty
  let font :: Font
font = RenderState a -> Font
forall a. RenderState a -> Font
peekFont RenderState a
st'
  Bool -> DocState a -> DocState a
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RenderState a -> Int
forall a. RenderState a -> Int
column RenderState a
st' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not (a -> Bool
forall a. HasChars a => a -> Bool
isNull a
pref Bool -> Bool -> Bool
&& Font
font Font -> Font -> Bool
forall a. Eq a => a -> a -> Bool
== Font
baseFont)) (DocState a -> DocState a) -> DocState a -> DocState a
forall a b. (a -> b) -> a -> b
$
    (RenderState a -> RenderState a) -> DocState a
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RenderState a -> RenderState a) -> DocState a)
-> (RenderState a -> RenderState a) -> DocState a
forall a b. (a -> b) -> a -> b
$ \RenderState a
st -> RenderState a
st{ output = Attr Nothing baseFont pref : output st
                    , column = column st + realLength pref }
  (RenderState a -> RenderState a) -> DocState a
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RenderState a -> RenderState a) -> DocState a)
-> (RenderState a -> RenderState a) -> DocState a
forall a b. (a -> b) -> a -> b
$ \RenderState a
st -> RenderState a
st{ output = Attr (linkTarget st) font s : output st
                    , column = column st + off
                    , newlines = 0 }

-- | Synonym for 'renderPlain'.
render :: HasChars a => Maybe Int -> Doc a -> a
render :: forall a. HasChars a => Maybe Int -> Doc a -> a
render = Maybe Int -> Doc a -> a
forall a. HasChars a => Maybe Int -> Doc a -> a
renderPlain

-- | Render a 'Doc' with ANSI escapes.  @renderANSI (Just n)@ will use
-- a line length of @n@ to reflow text on breakable spaces.
-- @renderANSI Nothing@ will not reflow text.
renderANSI :: HasChars a => Maybe Int -> Doc a -> TL.Text
renderANSI :: forall a. HasChars a => Maybe Int -> Doc a -> Text
renderANSI Maybe Int
n Doc a
d = Builder -> Text
B.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Attributed a -> Builder
forall {a}. HasChars a => Attributed a -> Builder
go (Attributed a -> Builder) -> Attributed a -> Builder
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc a -> Attributed a
forall a. HasChars a => Maybe Int -> Doc a -> Attributed a
prerender Maybe Int
n Doc a
d where
  go :: Attributed a -> Builder
go Attributed a
s = (\(Maybe Text
_,Font
_,Builder
o) -> Builder
o) (Attributed a -> (Maybe Text, Font, Builder)
forall {a}.
HasChars a =>
Attributed a -> (Maybe Text, Font, Builder)
go' Attributed a
s) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText (Font -> Text
forall a. (Semigroup a, IsString a) => Font -> a
renderFont Font
baseFont) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText (Maybe Text -> Text
forall a. (Semigroup a, IsString a) => Maybe a -> a
renderOSC8 Maybe Text
forall a. Maybe a
Nothing)
  go' :: Attributed a -> (Maybe Text, Font, Builder)
go' (Attributed Seq (Attr a)
s) = ((Maybe Text, Font, Builder)
 -> Attr a -> (Maybe Text, Font, Builder))
-> (Maybe Text, Font, Builder)
-> Seq (Attr a)
-> (Maybe Text, Font, Builder)
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Maybe Text, Font, Builder)
-> Attr a -> (Maybe Text, Font, Builder)
forall a.
HasChars a =>
(Maybe Text, Font, Builder)
-> Attr a -> (Maybe Text, Font, Builder)
attrRender (Maybe Text
forall a. Maybe a
Nothing, Font
baseFont, Text -> Builder
B.fromText Text
"") Seq (Attr a)
s

-- | Render a 'Doc' without using ANSI escapes.  @renderPlain (Just n)@ will use
-- a line length of @n@ to reflow text on breakable spaces.
-- @renderPlain Nothing@ will not reflow text.
renderPlain :: HasChars a => Maybe Int -> Doc a -> a
renderPlain :: forall a. HasChars a => Maybe Int -> Doc a -> a
renderPlain Maybe Int
n Doc a
d = Attributed a -> a
forall {m}. HasChars m => Attributed m -> m
go (Attributed a -> a) -> Attributed a -> a
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc a -> Attributed a
forall a. HasChars a => Maybe Int -> Doc a -> Attributed a
prerender Maybe Int
n Doc a
d where
  go :: Attributed m -> m
go (Attributed Seq (Attr m)
s) = (Attr m -> m) -> Seq (Attr m) -> m
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Attr m -> m
forall a. HasChars a => Attr a -> a
attrStrip Seq (Attr m)
s

attrStrip :: HasChars a => Attr a -> a
attrStrip :: forall a. HasChars a => Attr a -> a
attrStrip (Attr Maybe Text
_ Font
_ a
y) | a -> Bool
forall a. HasChars a => a -> Bool
isNull a
y = a
""
                       | Bool
otherwise = a
y

attrRender :: HasChars a => (Link, Font, B.Builder) -> Attr a -> (Link, Font, B.Builder)
attrRender :: forall a.
HasChars a =>
(Maybe Text, Font, Builder)
-> Attr a -> (Maybe Text, Font, Builder)
attrRender (Maybe Text
l, Font
f, Builder
acc) (Attr Maybe Text
m Font
g a
y)
    | a -> Bool
forall a. HasChars a => a -> Bool
isNull a
y = (Maybe Text
l, Font
f, Builder
acc)
    | Bool
otherwise = (Maybe Text
m, Font
g, Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText Text
newFont Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
B.fromText Text
newLink Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall a. HasChars a => a -> Builder
build a
y)
  where
    newLink :: Text
newLink = if Maybe Text
l Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text
m then Text
forall a. Monoid a => a
mempty else Maybe Text -> Text
forall a. (Semigroup a, IsString a) => Maybe a -> a
renderOSC8 Maybe Text
m
    newFont :: Text
newFont = if Font
f Font -> Font -> Bool
forall a. Eq a => a -> a -> Bool
== Font
g then Text
forall a. Monoid a => a
mempty else Font -> Text
forall a. (Semigroup a, IsString a) => Font -> a
renderFont Font
g

prerender :: HasChars a => Maybe Int -> Doc a -> Attributed a
prerender :: forall a. HasChars a => Maybe Int -> Doc a -> Attributed a
prerender Maybe Int
linelen Doc a
doc = [Attr a] -> Attributed a
forall a. [Attr a] -> Attributed a
fromList ([Attr a] -> Attributed a)
-> (RenderState a -> [Attr a]) -> RenderState a -> Attributed a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attr a] -> [Attr a]
forall a. [a] -> [a]
reverse ([Attr a] -> [Attr a])
-> (RenderState a -> [Attr a]) -> RenderState a -> [Attr a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderState a -> [Attr a]
forall a. RenderState a -> [Attr a]
output (RenderState a -> Attributed a) -> RenderState a -> Attributed a
forall a b. (a -> b) -> a -> b
$
  State (RenderState a) () -> RenderState a -> RenderState a
forall s a. State s a -> s -> s
execState (Doc a -> State (RenderState a) ()
forall a. HasChars a => Doc a -> DocState a
renderDoc Doc a
doc) RenderState a
forall {a}. RenderState a
startingState
   where startingState :: RenderState a
startingState = RenderState{
                            output :: [Attr a]
output = [Attr a]
forall a. Monoid a => a
mempty
                          , prefix :: Text
prefix = Text
forall a. Monoid a => a
mempty
                          , usePrefix :: Bool
usePrefix = Bool
True
                          , lineLength :: Maybe Int
lineLength = Maybe Int
linelen
                          , column :: Int
column = Int
0
                          , newlines :: Int
newlines = Int
2
                          , fontStack :: [Font]
fontStack = []
                          , linkTarget :: Maybe Text
linkTarget = Maybe Text
forall a. Maybe a
Nothing }

renderDoc :: HasChars a => Doc a -> DocState a
renderDoc :: forall a. HasChars a => Doc a -> DocState a
renderDoc = [FlatDoc a] -> DocState a
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList ([FlatDoc a] -> DocState a)
-> (Doc a -> [FlatDoc a]) -> Doc a -> DocState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize ([FlatDoc a] -> [FlatDoc a])
-> (Doc a -> [FlatDoc a]) -> Doc a -> [FlatDoc a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> [FlatDoc a]
forall a. HasChars a => Doc a -> [FlatDoc a]
flatten


normalize :: HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize :: forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize [] = []
normalize [FlatDoc a
FNewLine] = [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize [FlatDoc a
forall a. FlatDoc a
FCarriageReturn]
normalize [FBlankLines Int
_] = [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize [FlatDoc a
forall a. FlatDoc a
FCarriageReturn]
normalize [FlatDoc a
FBreakingSpace] = []
normalize (FBlankLines Int
m : FBlankLines Int
n : [FlatDoc a]
xs) =
  [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize (Int -> FlatDoc a
forall a. Int -> FlatDoc a
FBlankLines (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
m Int
n) FlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
: [FlatDoc a]
xs)
normalize (FBlankLines Int
num : FlatDoc a
FBreakingSpace : [FlatDoc a]
xs) =
  [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize (Int -> FlatDoc a
forall a. Int -> FlatDoc a
FBlankLines Int
num FlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
: [FlatDoc a]
xs)
normalize (FBlankLines Int
m : FlatDoc a
FCarriageReturn : [FlatDoc a]
xs) = [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize (Int -> FlatDoc a
forall a. Int -> FlatDoc a
FBlankLines Int
m FlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
: [FlatDoc a]
xs)
normalize (FBlankLines Int
m : FlatDoc a
FNewLine : [FlatDoc a]
xs) = [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize (Int -> FlatDoc a
forall a. Int -> FlatDoc a
FBlankLines Int
m FlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
: [FlatDoc a]
xs)
normalize (FlatDoc a
FNewLine : FBlankLines Int
m : [FlatDoc a]
xs) = [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize (Int -> FlatDoc a
forall a. Int -> FlatDoc a
FBlankLines Int
m FlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
: [FlatDoc a]
xs)
normalize (FlatDoc a
FNewLine : FlatDoc a
FBreakingSpace : [FlatDoc a]
xs) = [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize (FlatDoc a
forall a. FlatDoc a
FNewLine FlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
: [FlatDoc a]
xs)
normalize (FlatDoc a
FNewLine : FlatDoc a
FCarriageReturn : [FlatDoc a]
xs) = [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize (FlatDoc a
forall a. FlatDoc a
FNewLine FlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
: [FlatDoc a]
xs)
normalize (FlatDoc a
FCarriageReturn : FlatDoc a
FCarriageReturn : [FlatDoc a]
xs) =
  [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize (FlatDoc a
forall a. FlatDoc a
FCarriageReturn FlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
: [FlatDoc a]
xs)
normalize (FlatDoc a
FCarriageReturn : FBlankLines Int
m : [FlatDoc a]
xs) = [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize (Int -> FlatDoc a
forall a. Int -> FlatDoc a
FBlankLines Int
m FlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
: [FlatDoc a]
xs)
normalize (FlatDoc a
FCarriageReturn : FlatDoc a
FBreakingSpace : [FlatDoc a]
xs) =
  [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize (FlatDoc a
forall a. FlatDoc a
FCarriageReturn FlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
: [FlatDoc a]
xs)
normalize (FlatDoc a
FBreakingSpace : FlatDoc a
FCarriageReturn : [FlatDoc a]
xs) =
  [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize (FlatDoc a
forall a. FlatDoc a
FCarriageReturnFlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
:[FlatDoc a]
xs)
normalize (FlatDoc a
FBreakingSpace : FlatDoc a
FNewLine : [FlatDoc a]
xs) = [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize (FlatDoc a
forall a. FlatDoc a
FNewLineFlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
:[FlatDoc a]
xs)
normalize (FlatDoc a
FBreakingSpace : FBlankLines Int
n : [FlatDoc a]
xs) = [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize (Int -> FlatDoc a
forall a. Int -> FlatDoc a
FBlankLines Int
nFlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
:[FlatDoc a]
xs)
normalize (FlatDoc a
FBreakingSpace : FlatDoc a
FBreakingSpace : [FlatDoc a]
xs) = [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize (FlatDoc a
forall a. FlatDoc a
FBreakingSpaceFlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
:[FlatDoc a]
xs)
normalize (FlatDoc a
x:[FlatDoc a]
xs) = FlatDoc a
x FlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
: [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize [FlatDoc a]
xs

mergeBlocks :: HasChars a => Int -> (Int, [a]) -> (Int, [a]) -> (Int, [a])
mergeBlocks :: forall a.
HasChars a =>
Int -> (Int, [a]) -> (Int, [a]) -> (Int, [a])
mergeBlocks Int
h (Int
w1,[a]
lns1) (Int
w2,[a]
lns2) =
  (Int
w, (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
l1 a
l2 -> Int -> a -> a
forall {a}. HasChars a => Int -> a -> a
pad Int
w1 a
l1 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
l2) [a]
lns1' [a]
lns2')
 where
  w :: Int
w  = Int
w1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w2
  len1 :: Int
len1 = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
h [a]
lns1  -- note lns1 might be infinite
  len2 :: Int
len2 = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
h [a]
lns2
  lns1' :: [a]
lns1' = if Int
len1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
h
             then [a]
lns1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len1) a
forall a. Monoid a => a
mempty
             else Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
h [a]
lns1
  lns2' :: [a]
lns2' = if Int
len2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
h
             then [a]
lns2 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len2) a
forall a. Monoid a => a
mempty
             else Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
h [a]
lns2
  pad :: Int -> a -> a
pad Int
n a
s = a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> a
forall a. HasChars a => Int -> Char -> a
replicateChar (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. HasChars a => a -> Int
realLength a
s) Char
' '

renderList :: HasChars a => [FlatDoc a] -> DocState a
renderList :: forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [] = () -> StateT (RenderState a) Identity ()
forall a. a -> StateT (RenderState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

renderList (FText Int
off a
s : [FlatDoc a]
xs) = do
  Int -> a -> StateT (RenderState a) Identity ()
forall a. HasChars a => Int -> a -> DocState a
outp Int
off a
s
  [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
xs

renderList (FCookedText Int
off Attributed a
s : [FlatDoc a]
xs) = do
  RenderState a
st' <- StateT (RenderState a) Identity (RenderState a)
forall s (m :: * -> *). MonadState s m => m s
get
  let pref :: a
pref = if RenderState a -> Bool
forall a. RenderState a -> Bool
usePrefix RenderState a
st' then String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ RenderState a -> Text
forall a. RenderState a -> Text
prefix RenderState a
st' else a
forall a. Monoid a => a
mempty
  let elems :: Attributed a -> [Attr a]
elems (Attributed Seq (Attr a)
x) = [Attr a] -> [Attr a]
forall a. [a] -> [a]
reverse ([Attr a] -> [Attr a]) -> [Attr a] -> [Attr a]
forall a b. (a -> b) -> a -> b
$ Seq (Attr a) -> [Attr a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Attr a)
x
  Bool
-> StateT (RenderState a) Identity ()
-> StateT (RenderState a) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RenderState a -> Int
forall a. RenderState a -> Int
column RenderState a
st' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Bool -> Bool
not (a -> Bool
forall a. HasChars a => a -> Bool
isNull a
pref))  (StateT (RenderState a) Identity ()
 -> StateT (RenderState a) Identity ())
-> StateT (RenderState a) Identity ()
-> StateT (RenderState a) Identity ()
forall a b. (a -> b) -> a -> b
$
    (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RenderState a -> RenderState a)
 -> StateT (RenderState a) Identity ())
-> (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \RenderState a
st -> RenderState a
st{ output = Attr Nothing baseFont pref : output st
                      , column = column st + realLength pref }
  (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RenderState a -> RenderState a)
 -> StateT (RenderState a) Identity ())
-> (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \RenderState a
st -> RenderState a
st{ output = elems s ++ output st
                    , column = column st + off
                    , newlines = 0 }
  [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
xs

-- FStyleOpen and FStyleClose are balanced by construction when we create
-- them in `flatten`, so we can just pop the stack when we encounter
-- FStyleClose
renderList (FStyleOpen StyleReq
style : [FlatDoc a]
xs) = do
  RenderState a
st <- StateT (RenderState a) Identity (RenderState a)
forall s (m :: * -> *). MonadState s m => m s
get
  let prevFont :: Font
prevFont = RenderState a -> Font
forall a. RenderState a -> Font
peekFont RenderState a
st
  let nextFont :: Font
nextFont = Font
prevFont Font -> StyleReq -> Font
~> StyleReq
style
  (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RenderState a -> RenderState a)
 -> StateT (RenderState a) Identity ())
-> (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \RenderState a
s -> RenderState a
s{fontStack = nextFont : fontStack s}
  [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
xs

renderList (FlatDoc a
FStyleClose : [FlatDoc a]
xs) = do
  (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RenderState a -> RenderState a)
 -> StateT (RenderState a) Identity ())
-> (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \RenderState a
s -> RenderState a
s{fontStack = drop 1 $ fontStack s}
  [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
xs

-- Nested links are nonsensical, we only handle the outermost and
-- silently ignore any attempts to have a link inside a link

-- Nested links are nonsensical, we only handle the outermost and
-- silently ignore any attempts to have a link inside a link
renderList (FLinkOpen Text
target : [FlatDoc a]
xs) = do
  RenderState a
st <- StateT (RenderState a) Identity (RenderState a)
forall s (m :: * -> *). MonadState s m => m s
get
  case RenderState a -> Maybe Text
forall a. RenderState a -> Maybe Text
linkTarget RenderState a
st of
    Maybe Text
Nothing -> do
      (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RenderState a -> RenderState a)
 -> StateT (RenderState a) Identity ())
-> (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \RenderState a
s -> RenderState a
s{linkTarget = Just target}
      [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
xs
    Maybe Text
_ -> do
      let ([FlatDoc a]
next, [FlatDoc a]
rest) = (FlatDoc a -> Bool) -> [FlatDoc a] -> ([FlatDoc a], [FlatDoc a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break FlatDoc a -> Bool
forall a. FlatDoc a -> Bool
isLinkClose [FlatDoc a]
xs
      [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList ([FlatDoc a]
next [FlatDoc a] -> [FlatDoc a] -> [FlatDoc a]
forall a. Semigroup a => a -> a -> a
<> Int -> [FlatDoc a] -> [FlatDoc a]
forall a. Int -> [a] -> [a]
drop Int
1 [FlatDoc a]
rest)
  where
    isLinkClose :: FlatDoc a -> Bool
isLinkClose FlatDoc a
FLinkClose = Bool
True
    isLinkClose FlatDoc a
_ = Bool
False

renderList (FlatDoc a
FLinkClose : [FlatDoc a]
xs) = do
  (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RenderState a -> RenderState a)
 -> StateT (RenderState a) Identity ())
-> (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \RenderState a
s -> RenderState a
s{linkTarget = Nothing}
  [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
xs

renderList (FPrefixed Text
pref NonEmpty (FlatDoc a)
d : [FlatDoc a]
xs) = do
  RenderState a
st <- StateT (RenderState a) Identity (RenderState a)
forall s (m :: * -> *). MonadState s m => m s
get
  let oldPref :: Text
oldPref = RenderState a -> Text
forall a. RenderState a -> Text
prefix RenderState a
st
  RenderState a -> StateT (RenderState a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put RenderState a
st{ prefix = prefix st <> pref }
  [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList ([FlatDoc a] -> StateT (RenderState a) Identity ())
-> [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a b. (a -> b) -> a -> b
$ [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize ([FlatDoc a] -> [FlatDoc a]) -> [FlatDoc a] -> [FlatDoc a]
forall a b. (a -> b) -> a -> b
$ NonEmpty (FlatDoc a) -> [FlatDoc a]
forall a. NonEmpty a -> [a]
N.toList NonEmpty (FlatDoc a)
d
  (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RenderState a -> RenderState a)
 -> StateT (RenderState a) Identity ())
-> (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \RenderState a
s -> RenderState a
s{ prefix = oldPref }
  -- renderDoc CarriageReturn
  [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
xs

renderList (FFlush NonEmpty (FlatDoc a)
d : [FlatDoc a]
xs) = do
  RenderState a
st <- StateT (RenderState a) Identity (RenderState a)
forall s (m :: * -> *). MonadState s m => m s
get
  let oldUsePrefix :: Bool
oldUsePrefix = RenderState a -> Bool
forall a. RenderState a -> Bool
usePrefix RenderState a
st
  RenderState a -> StateT (RenderState a) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put RenderState a
st{ usePrefix = False }
  [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList ([FlatDoc a] -> StateT (RenderState a) Identity ())
-> [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a b. (a -> b) -> a -> b
$ [FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize ([FlatDoc a] -> [FlatDoc a]) -> [FlatDoc a] -> [FlatDoc a]
forall a b. (a -> b) -> a -> b
$ NonEmpty (FlatDoc a) -> [FlatDoc a]
forall a. NonEmpty a -> [a]
N.toList NonEmpty (FlatDoc a)
d
  (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RenderState a -> RenderState a)
 -> StateT (RenderState a) Identity ())
-> (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \RenderState a
s -> RenderState a
s{ usePrefix = oldUsePrefix }
  [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
xs

renderList (FBeforeNonBlank NonEmpty (FlatDoc a)
d : [FlatDoc a]
xs) = do
  let next :: [FlatDoc a]
next = (FlatDoc a -> Bool) -> [FlatDoc a] -> [FlatDoc a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (FlatDoc a -> Bool) -> FlatDoc a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatDoc a -> Bool
forall a. FlatDoc a -> Bool
isPrintable) [FlatDoc a]
xs
  case [FlatDoc a]
next of
    (FlatDoc a
x:[FlatDoc a]
_) | FlatDoc a -> Bool
forall a. HasChars a => FlatDoc a -> Bool
startsBlank FlatDoc a
x -> [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
xs
          | Bool
otherwise     -> [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList ([FlatDoc a] -> [FlatDoc a]
forall a. HasChars a => [FlatDoc a] -> [FlatDoc a]
normalize ([FlatDoc a] -> [FlatDoc a]) -> [FlatDoc a] -> [FlatDoc a]
forall a b. (a -> b) -> a -> b
$ NonEmpty (FlatDoc a) -> [FlatDoc a]
forall a. NonEmpty a -> [a]
N.toList NonEmpty (FlatDoc a)
d) StateT (RenderState a) Identity ()
-> StateT (RenderState a) Identity ()
-> StateT (RenderState a) Identity ()
forall a b.
StateT (RenderState a) Identity a
-> StateT (RenderState a) Identity b
-> StateT (RenderState a) Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
xs
    []                    -> [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
xs

renderList (FBlankLines Int
num : [FlatDoc a]
xs) = do
  RenderState a
st <- StateT (RenderState a) Identity (RenderState a)
forall s (m :: * -> *). MonadState s m => m s
get
  case RenderState a -> [Attr a]
forall a. RenderState a -> [Attr a]
output RenderState a
st of
     [Attr a]
_ | RenderState a -> Int
forall a. RenderState a -> Int
newlines RenderState a
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
num -> () -> StateT (RenderState a) Identity ()
forall a. a -> StateT (RenderState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       | Bool
otherwise -> Int
-> StateT (RenderState a) Identity ()
-> StateT (RenderState a) Identity ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
- RenderState a -> Int
forall a. RenderState a -> Int
newlines RenderState a
st) StateT (RenderState a) Identity ()
forall a. HasChars a => DocState a
newline
  [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
xs

renderList (FlatDoc a
FCarriageReturn : [FlatDoc a]
xs) = do
  RenderState a
st <- StateT (RenderState a) Identity (RenderState a)
forall s (m :: * -> *). MonadState s m => m s
get
  if RenderState a -> Int
forall a. RenderState a -> Int
newlines RenderState a
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
     then [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
xs
     else do
       StateT (RenderState a) Identity ()
forall a. HasChars a => DocState a
newline
       [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
xs

renderList (FlatDoc a
FNewLine : [FlatDoc a]
xs) = do
  StateT (RenderState a) Identity ()
forall a. HasChars a => DocState a
newline
  [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
xs

renderList (FlatDoc a
FBreakingSpace : [FlatDoc a]
xs) = do
  let isBreakingSpace :: FlatDoc a -> Bool
isBreakingSpace FlatDoc a
FBreakingSpace = Bool
True
      isBreakingSpace FlatDoc a
_ = Bool
False
  let xs' :: [FlatDoc a]
xs' = (FlatDoc a -> Bool) -> [FlatDoc a] -> [FlatDoc a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile FlatDoc a -> Bool
forall a. FlatDoc a -> Bool
isBreakingSpace [FlatDoc a]
xs
  let next :: [FlatDoc a]
next = (FlatDoc a -> Bool) -> [FlatDoc a] -> [FlatDoc a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (FlatDoc a -> Bool) -> FlatDoc a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatDoc a -> Bool
forall a. HasChars a => FlatDoc a -> Bool
isBreakable) [FlatDoc a]
xs'
  RenderState a
st <- StateT (RenderState a) Identity (RenderState a)
forall s (m :: * -> *). MonadState s m => m s
get
  let off :: Int
off = (Int -> FlatDoc a -> Int) -> Int -> [FlatDoc a] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
tot FlatDoc a
t -> Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FlatDoc a -> Int
forall a. FlatDoc a -> Int
offsetOf FlatDoc a
t) Int
0 [FlatDoc a]
next
  case RenderState a -> Maybe Int
forall a. RenderState a -> Maybe Int
lineLength RenderState a
st of
        Just Int
l | RenderState a -> Int
forall a. RenderState a -> Int
column RenderState a
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
l -> StateT (RenderState a) Identity ()
forall a. HasChars a => DocState a
newline
        Maybe Int
_  -> Bool
-> StateT (RenderState a) Identity ()
-> StateT (RenderState a) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RenderState a -> Int
forall a. RenderState a -> Int
column RenderState a
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (StateT (RenderState a) Identity ()
 -> StateT (RenderState a) Identity ())
-> StateT (RenderState a) Identity ()
-> StateT (RenderState a) Identity ()
forall a b. (a -> b) -> a -> b
$ Int -> a -> StateT (RenderState a) Identity ()
forall a. HasChars a => Int -> a -> DocState a
outp Int
1 a
" "
  [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
xs'

renderList (FAfterBreak NonEmpty (FlatDoc a)
t : [FlatDoc a]
xs) = do
  RenderState a
st <- StateT (RenderState a) Identity (RenderState a)
forall s (m :: * -> *). MonadState s m => m s
get
  if RenderState a -> Int
forall a. RenderState a -> Int
newlines RenderState a
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
     then [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList (NonEmpty (FlatDoc a) -> [FlatDoc a]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (FlatDoc a)
t [FlatDoc a] -> [FlatDoc a] -> [FlatDoc a]
forall a. Semigroup a => a -> a -> a
<> [FlatDoc a]
xs)
     else [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
xs

-- FBlock and FVFill are all that's left
renderList (FlatDoc a
b : [FlatDoc a]
xs) = do
  RenderState a
st <- StateT (RenderState a) Identity (RenderState a)
forall s (m :: * -> *). MonadState s m => m s
get
  let font :: Font
font = RenderState a -> Font
forall a. RenderState a -> Font
peekFont RenderState a
st
  let ([FlatDoc a]
bs, [FlatDoc a]
rest) = (FlatDoc a -> Bool) -> [FlatDoc a] -> ([FlatDoc a], [FlatDoc a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span FlatDoc a -> Bool
forall a. FlatDoc a -> Bool
isBlock [FlatDoc a]
xs
  -- ensure we have right padding unless end of line
  let heightOf :: FlatDoc a -> Int
heightOf (FBlock Int
_ [Attributed a]
ls) = [Attributed a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Attributed a]
ls
      heightOf FlatDoc a
_            = Int
1
  let maxheight :: Int
maxheight = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (FlatDoc a -> Int) -> [FlatDoc a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map FlatDoc a -> Int
forall a. FlatDoc a -> Int
heightOf (FlatDoc a
bFlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
:[FlatDoc a]
bs)
  let toBlockSpec :: FlatDoc a -> (Int, [Attributed a])
toBlockSpec (FBlock Int
w [Attributed a]
ls) = (Int
w, [Attributed a]
ls)
      toBlockSpec (FVFill Int
w a
t)  = (Int
w, (a -> Attributed a) -> [a] -> [Attributed a]
forall a b. (a -> b) -> [a] -> [b]
map (Attr a -> Attributed a
forall a. Attr a -> Attributed a
singleton (Attr a -> Attributed a) -> (a -> Attr a) -> a -> Attributed a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Font -> a -> Attr a
forall a. Maybe Text -> Font -> a -> Attr a
Attr (RenderState a -> Maybe Text
forall a. RenderState a -> Maybe Text
linkTarget RenderState a
st) Font
font)) (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
maxheight ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a -> [a]
forall a. a -> [a]
repeat a
t))
      toBlockSpec FlatDoc a
_            = (Int
0, [])
  let (Int
_, [Attributed a]
lns') = ((Int, [Attributed a])
 -> (Int, [Attributed a]) -> (Int, [Attributed a]))
-> (Int, [Attributed a])
-> [(Int, [Attributed a])]
-> (Int, [Attributed a])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Int
-> (Int, [Attributed a])
-> (Int, [Attributed a])
-> (Int, [Attributed a])
forall a.
HasChars a =>
Int -> (Int, [a]) -> (Int, [a]) -> (Int, [a])
mergeBlocks Int
maxheight) (FlatDoc a -> (Int, [Attributed a])
forall {a}. FlatDoc a -> (Int, [Attributed a])
toBlockSpec FlatDoc a
b)
                             ((FlatDoc a -> (Int, [Attributed a]))
-> [FlatDoc a] -> [(Int, [Attributed a])]
forall a b. (a -> b) -> [a] -> [b]
map FlatDoc a -> (Int, [Attributed a])
forall {a}. FlatDoc a -> (Int, [Attributed a])
toBlockSpec [FlatDoc a]
bs)
  let oldPref :: Text
oldPref = RenderState a -> Text
forall a. RenderState a -> Text
prefix RenderState a
st
  case RenderState a -> Int
forall a. RenderState a -> Int
column RenderState a
st Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
forall a. HasChars a => a -> Int
realLength Text
oldPref of
        Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RenderState a -> RenderState a)
 -> StateT (RenderState a) Identity ())
-> (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \RenderState a
s -> RenderState a
s{ prefix = oldPref <> T.replicate n " " }
        Int
_ -> () -> StateT (RenderState a) Identity ()
forall a. a -> StateT (RenderState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList ([FlatDoc a] -> StateT (RenderState a) Identity ())
-> [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a b. (a -> b) -> a -> b
$ FlatDoc a -> [FlatDoc a] -> [FlatDoc a]
forall a. a -> [a] -> [a]
intersperse FlatDoc a
forall a. FlatDoc a
FCarriageReturn ((Attributed a -> Maybe (FlatDoc a))
-> [Attributed a] -> [FlatDoc a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Attributed a -> Maybe (FlatDoc a)
forall a. HasChars a => Attributed a -> Maybe (FlatDoc a)
cook [Attributed a]
lns')
  (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RenderState a -> RenderState a)
 -> StateT (RenderState a) Identity ())
-> (RenderState a -> RenderState a)
-> StateT (RenderState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \RenderState a
s -> RenderState a
s{ prefix = oldPref }
  [FlatDoc a] -> StateT (RenderState a) Identity ()
forall a. HasChars a => [FlatDoc a] -> DocState a
renderList [FlatDoc a]
rest

isBreakable :: HasChars a => FlatDoc a -> Bool
isBreakable :: forall a. HasChars a => FlatDoc a -> Bool
isBreakable FlatDoc a
FBreakingSpace      = Bool
True
isBreakable FlatDoc a
FCarriageReturn     = Bool
True
isBreakable FlatDoc a
FNewLine            = Bool
True
isBreakable (FBlankLines Int
_)     = Bool
True
isBreakable FlatDoc a
_                  = Bool
False

startsBlank' :: HasChars a => a -> Bool
startsBlank' :: forall a. HasChars a => a -> Bool
startsBlank' a
t = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Maybe Bool -> Char -> Maybe Bool) -> Maybe Bool -> a -> Maybe Bool
forall a b. HasChars a => (b -> Char -> b) -> b -> a -> b
forall b. (b -> Char -> b) -> b -> a -> b
foldlChar Maybe Bool -> Char -> Maybe Bool
go Maybe Bool
forall a. Maybe a
Nothing a
t
  where
   go :: Maybe Bool -> Char -> Maybe Bool
go Maybe Bool
Nothing  Char
c = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Char -> Bool
isSpace Char
c)
   go (Just Bool
b) Char
_ = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b

startsBlank :: HasChars a => FlatDoc a -> Bool
startsBlank :: forall a. HasChars a => FlatDoc a -> Bool
startsBlank (FText Int
_ a
t)                = a -> Bool
forall a. HasChars a => a -> Bool
startsBlank' a
t
startsBlank (FCookedText Int
_ Attributed a
t)          = Attributed a -> Bool
forall a. HasChars a => a -> Bool
startsBlank' Attributed a
t
startsBlank (FBlock Int
n [Attributed a]
ls)              = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& (Attributed a -> Bool) -> [Attributed a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Attributed a -> Bool
forall a. HasChars a => a -> Bool
startsBlank' [Attributed a]
ls
startsBlank (FVFill Int
n a
t)               = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& a -> Bool
forall a. HasChars a => a -> Bool
startsBlank' a
t
startsBlank (FBeforeNonBlank (FlatDoc a
x :| [FlatDoc a]
_)) = FlatDoc a -> Bool
forall a. HasChars a => FlatDoc a -> Bool
startsBlank FlatDoc a
x
startsBlank (FPrefixed Text
_ (FlatDoc a
x :| [FlatDoc a]
_))     = FlatDoc a -> Bool
forall a. HasChars a => FlatDoc a -> Bool
startsBlank FlatDoc a
x
startsBlank (FFlush (FlatDoc a
x :| [FlatDoc a]
_))          = FlatDoc a -> Bool
forall a. HasChars a => FlatDoc a -> Bool
startsBlank FlatDoc a
x
startsBlank FlatDoc a
FBreakingSpace             = Bool
True
startsBlank (FAfterBreak (FlatDoc a
t :| [FlatDoc a]
_))     = FlatDoc a -> Bool
forall a. HasChars a => FlatDoc a -> Bool
startsBlank FlatDoc a
t
startsBlank FlatDoc a
FCarriageReturn            = Bool
True
startsBlank FlatDoc a
FNewLine                   = Bool
True
startsBlank (FBlankLines Int
_)            = Bool
True
startsBlank (FStyleOpen StyleReq
_)             = Bool
True
startsBlank (FLinkOpen Text
_)              = Bool
True
startsBlank FlatDoc a
FStyleClose                = Bool
True
startsBlank FlatDoc a
FLinkClose                 = Bool
True

isPrintable :: FlatDoc a -> Bool
isPrintable :: forall a. FlatDoc a -> Bool
isPrintable FLinkOpen{} = Bool
False
isPrintable FLinkClose{} = Bool
False
isPrintable FStyleOpen{} = Bool
False
isPrintable FStyleClose{} = Bool
False
isPrintable FlatDoc a
_ = Bool
True

isBlock :: FlatDoc a -> Bool
isBlock :: forall a. FlatDoc a -> Bool
isBlock FBlock{} = Bool
True
isBlock FVFill{} = Bool
True
isBlock FlatDoc a
_       = Bool
False

offsetOf :: FlatDoc a -> Int
offsetOf :: forall a. FlatDoc a -> Int
offsetOf (FText Int
o a
_)       = Int
o
offsetOf (FBlock Int
w [Attributed a]
_)      = Int
w
offsetOf (FVFill Int
w a
_)      = Int
w
offsetOf (FCookedText Int
w Attributed a
_) = Int
w
offsetOf FlatDoc a
FBreakingSpace    = Int
1
offsetOf FlatDoc a
_                = Int
0

-- | Create a 'Doc' from a stringlike value.
literal :: HasChars a => a -> Doc a
literal :: forall a. HasChars a => a -> Doc a
literal a
x =
  [Doc a] -> Doc a
forall a. Monoid a => [a] -> a
mconcat ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$
    Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
intersperse Doc a
forall a. Doc a
NewLine ([Doc a] -> [Doc a]) -> [Doc a] -> [Doc a]
forall a b. (a -> b) -> a -> b
$
      (a -> Doc a) -> [a] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map (\a
s -> if a -> Bool
forall a. HasChars a => a -> Bool
isNull a
s
                    then Doc a
forall a. Doc a
Empty
                    else let !len :: Int
len = a -> Int
forall a. HasChars a => a -> Int
realLength a
s
                          in Int -> a -> Doc a
forall a. Int -> a -> Doc a
Text Int
len a
s) ([a] -> [Doc a]) -> [a] -> [Doc a]
forall a b. (a -> b) -> a -> b
$
        a -> [a]
forall a. HasChars a => a -> [a]
splitLines a
x
{-# NOINLINE literal #-}

cook :: HasChars a => Attributed a -> Maybe (FlatDoc a)
cook :: forall a. HasChars a => Attributed a -> Maybe (FlatDoc a)
cook Attributed a
x | Attributed a -> Bool
forall a. HasChars a => a -> Bool
isNull Attributed a
x = Maybe (FlatDoc a)
forall a. Maybe a
Nothing
       | Bool
otherwise = let !len :: Int
len = Attributed a -> Int
forall a. HasChars a => a -> Int
realLength Attributed a
x in FlatDoc a -> Maybe (FlatDoc a)
forall a. a -> Maybe a
Just (Int -> Attributed a -> FlatDoc a
forall a. Int -> Attributed a -> FlatDoc a
FCookedText Int
len Attributed a
x)

-- | A literal string.  (Like 'literal', but restricted to String.)
text :: HasChars a => String -> Doc a
text :: forall a. HasChars a => String -> Doc a
text = a -> Doc a
forall a. HasChars a => a -> Doc a
literal (a -> Doc a) -> (String -> a) -> String -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. IsString a => String -> a
fromString

-- | A character.
char :: HasChars a => Char -> Doc a
char :: forall a. HasChars a => Char -> Doc a
char Char
c = String -> Doc a
forall a. HasChars a => String -> Doc a
text (String -> Doc a) -> String -> Doc a
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. IsString a => String -> a
fromString [Char
c]

-- | A breaking (reflowable) space.
space :: Doc a
space :: forall a. Doc a
space = Doc a
forall a. Doc a
BreakingSpace

-- | A carriage return.  Does nothing if we're at the beginning of
-- a line; otherwise inserts a newline.
cr :: Doc a
cr :: forall a. Doc a
cr = Doc a
forall a. Doc a
CarriageReturn

-- | Inserts a blank line unless one exists already.
-- (@blankline <> blankline@ has the same effect as @blankline@.
blankline :: Doc a
blankline :: forall a. Doc a
blankline = Int -> Doc a
forall a. Int -> Doc a
BlankLines Int
1

-- | Inserts blank lines unless they exist already.
-- (@blanklines m <> blanklines n@ has the same effect as @blanklines (max m n)@.
blanklines :: Int -> Doc a
blanklines :: forall a. Int -> Doc a
blanklines = Int -> Doc a
forall a. Int -> Doc a
BlankLines

-- | Uses the specified string as a prefix for every line of
-- the inside document (except the first, if not at the beginning
-- of the line).
prefixed :: IsString a => String -> Doc a -> Doc a
prefixed :: forall a. IsString a => String -> Doc a -> Doc a
prefixed String
pref Doc a
doc
  | Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
doc = Doc a
forall a. Doc a
Empty
  | Bool
otherwise   = Text -> Doc a -> Doc a
forall a. Text -> Doc a -> Doc a
Prefixed (String -> Text
forall a. IsString a => String -> a
fromString String
pref) Doc a
doc

-- | Makes a 'Doc' flush against the left margin.
flush :: Doc a -> Doc a
flush :: forall a. Doc a -> Doc a
flush Doc a
doc
  | Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
doc = Doc a
forall a. Doc a
Empty
  | Bool
otherwise   = Doc a -> Doc a
forall a. Doc a -> Doc a
Flush Doc a
doc

-- | Indents a 'Doc' by the specified number of spaces.
nest :: IsString a => Int -> Doc a -> Doc a
nest :: forall a. IsString a => Int -> Doc a -> Doc a
nest Int
ind = String -> Doc a -> Doc a
forall a. IsString a => String -> Doc a -> Doc a
prefixed (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
ind Char
' ')

-- | A hanging indent. @hang ind start doc@ prints @start@,
-- then @doc@, leaving an indent of @ind@ spaces on every
-- line but the first.
hang :: IsString a => Int -> Doc a -> Doc a -> Doc a
hang :: forall a. IsString a => Int -> Doc a -> Doc a -> Doc a
hang Int
ind Doc a
start Doc a
doc = Doc a
start Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Int -> Doc a -> Doc a
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
ind Doc a
doc

-- | @beforeNonBlank d@ conditionally includes @d@ unless it is
-- followed by blank space.
beforeNonBlank :: Doc a -> Doc a
beforeNonBlank :: forall a. Doc a -> Doc a
beforeNonBlank = Doc a -> Doc a
forall a. Doc a -> Doc a
BeforeNonBlank

-- | Makes a 'Doc' non-reflowable.
nowrap :: IsString a => Doc a -> Doc a
nowrap :: forall a. IsString a => Doc a -> Doc a
nowrap = [Doc a] -> Doc a
forall a. Monoid a => [a] -> a
mconcat ([Doc a] -> Doc a) -> (Doc a -> [Doc a]) -> Doc a -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc a -> Doc a) -> [Doc a] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Doc a -> Doc a
forall a. IsString a => Doc a -> Doc a
replaceSpace ([Doc a] -> [Doc a]) -> (Doc a -> [Doc a]) -> Doc a -> [Doc a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> [Doc a]
forall a. Doc a -> [Doc a]
unfoldD
  where replaceSpace :: Doc a -> Doc a
replaceSpace Doc a
BreakingSpace = Int -> a -> Doc a
forall a. Int -> a -> Doc a
Text Int
1 (a -> Doc a) -> a -> Doc a
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. IsString a => String -> a
fromString String
" "
        replaceSpace Doc a
x             = Doc a
x

-- | Content to print only if it comes at the beginning of a line,
-- to be used e.g. for escaping line-initial `.` in roff man.
afterBreak :: Text -> Doc a
afterBreak :: forall a. Text -> Doc a
afterBreak = Text -> Doc a
forall a. Text -> Doc a
AfterBreak

-- | Returns the width of a 'Doc'.
offset :: (IsString a, HasChars a) => Doc a -> Int
offset :: forall a. (IsString a, HasChars a) => Doc a -> Int
offset = (Int -> Int -> Int) -> (Int, Int) -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ((Int, Int) -> Int) -> (Doc a -> (Int, Int)) -> Doc a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
forall a.
(IsString a, HasChars a) =>
(Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
getOffset (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
False) (Int
0, Int
0)

-- | Returns the minimal width of a 'Doc' when reflowed at breakable spaces.
minOffset :: HasChars a => Doc a -> Int
minOffset :: forall a. HasChars a => Doc a -> Int
minOffset = (Int -> Int -> Int) -> (Int, Int) -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ((Int, Int) -> Int) -> (Doc a -> (Int, Int)) -> Doc a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
forall a.
(IsString a, HasChars a) =>
(Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
getOffset (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Int
0,Int
0)

-- l = longest, c = current
getOffset :: (IsString a, HasChars a)
          => (Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
getOffset :: forall a.
(IsString a, HasChars a) =>
(Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
getOffset Int -> Bool
breakWhen (!Int
l, !Int
c) Doc a
x =
  case Doc a
x of
    Text Int
n a
_ -> (Int
l, Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
    Block Int
n [Attributed a]
_ -> (Int
l, Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
    VFill Int
n a
_ -> (Int
l, Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
    CookedText Int
n Attributed a
_ -> (Int
l, Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
    Doc a
Empty -> (Int
l, Int
c)
    Styled StyleReq
_ Doc a
d -> (Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
forall a.
(IsString a, HasChars a) =>
(Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
getOffset Int -> Bool
breakWhen (Int
l, Int
c) Doc a
d
    Linked Text
_ Doc a
d -> (Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
forall a.
(IsString a, HasChars a) =>
(Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
getOffset Int -> Bool
breakWhen (Int
l, Int
c) Doc a
d
    Doc a
CarriageReturn -> (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
l Int
c, Int
0)
    Doc a
NewLine -> (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
l Int
c, Int
0)
    BlankLines Int
_ -> (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
l Int
c, Int
0)
    Prefixed Text
t Doc a
d ->
      let (Int
l',Int
c') = (Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
forall a.
(IsString a, HasChars a) =>
(Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
getOffset Int -> Bool
breakWhen (Int
0, Int
0) Doc a
d
       in (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
l (Int
l' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
forall a. HasChars a => a -> Int
realLength Text
t), Int
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
forall a. HasChars a => a -> Int
realLength Text
t)
    BeforeNonBlank Doc a
_ -> (Int
l, Int
c)
    Flush Doc a
d -> (Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
forall a.
(IsString a, HasChars a) =>
(Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
getOffset Int -> Bool
breakWhen (Int
l, Int
c) Doc a
d
    Doc a
BreakingSpace
      | Int -> Bool
breakWhen Int
c -> (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
l Int
c, Int
0)
      | Bool
otherwise -> (Int
l, Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    AfterBreak Text
t -> if Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                       then (Int
l, Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
forall a. HasChars a => a -> Int
realLength Text
t)
                       else (Int
l, Int
c)
    Concat (Concat Doc a
d Doc a
y) Doc a
z ->
      (Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
forall a.
(IsString a, HasChars a) =>
(Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
getOffset Int -> Bool
breakWhen (Int
l, Int
c) (Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Concat Doc a
d (Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Concat Doc a
y Doc a
z))
    Concat (BeforeNonBlank Doc a
d) Doc a
y ->
      if Doc a -> Bool
forall a. Doc a -> Bool
isNonBlank Doc a
y
         then (Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
forall a.
(IsString a, HasChars a) =>
(Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
getOffset Int -> Bool
breakWhen (Int
l, Int
c) (Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
Concat Doc a
d Doc a
y)
         else (Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
forall a.
(IsString a, HasChars a) =>
(Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
getOffset Int -> Bool
breakWhen (Int
l, Int
c) Doc a
y
    Concat Doc a
d Doc a
y ->
      let (Int
l', Int
c') = (Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
forall a.
(IsString a, HasChars a) =>
(Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
getOffset Int -> Bool
breakWhen (Int
l, Int
c) Doc a
d
       in (Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
forall a.
(IsString a, HasChars a) =>
(Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
getOffset Int -> Bool
breakWhen (Int
l', Int
c') Doc a
y

isNonBlank :: Doc a -> Bool
isNonBlank :: forall a. Doc a -> Bool
isNonBlank (Text Int
_ a
_) = Bool
True
isNonBlank (BeforeNonBlank Doc a
d) = Doc a -> Bool
forall a. Doc a -> Bool
isNonBlank Doc a
d
isNonBlank (Flush Doc a
d) = Doc a -> Bool
forall a. Doc a -> Bool
isNonBlank Doc a
d
isNonBlank (Concat Doc a
d Doc a
_) = Doc a -> Bool
forall a. Doc a -> Bool
isNonBlank Doc a
d
isNonBlank Doc a
_ = Bool
False

-- | Returns the column that would be occupied by the last
-- laid out character (assuming no wrapping).
updateColumn :: HasChars a => Doc a -> Int -> Int
updateColumn :: forall a. HasChars a => Doc a -> Int -> Int
updateColumn Doc a
d Int
k = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Doc a -> (Int, Int)) -> Doc a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
forall a.
(IsString a, HasChars a) =>
(Int -> Bool) -> (Int, Int) -> Doc a -> (Int, Int)
getOffset (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
False) (Int
0,Int
k) (Doc a -> Int) -> Doc a -> Int
forall a b. (a -> b) -> a -> b
$ Doc a
d

-- | @lblock n d@ is a block of width @n@ characters, with
-- text derived from @d@ and aligned to the left.
lblock :: HasChars a => Int -> Doc a -> Doc a
lblock :: forall a. HasChars a => Int -> Doc a -> Doc a
lblock = (Attributed a -> Attributed a) -> Int -> Doc a -> Doc a
forall a.
HasChars a =>
(Attributed a -> Attributed a) -> Int -> Doc a -> Doc a
block Attributed a -> Attributed a
forall a. a -> a
id

-- | Like 'lblock' but aligned to the right.
rblock :: HasChars a => Int -> Doc a -> Doc a
rblock :: forall a. HasChars a => Int -> Doc a -> Doc a
rblock Int
w = (Attributed a -> Attributed a) -> Int -> Doc a -> Doc a
forall a.
HasChars a =>
(Attributed a -> Attributed a) -> Int -> Doc a -> Doc a
block (\Attributed a
s -> Int -> Char -> Attributed a
forall a. HasChars a => Int -> Char -> a
replicateChar (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Attributed a -> Int
forall a. HasChars a => a -> Int
realLength Attributed a
s) Char
' ' Attributed a -> Attributed a -> Attributed a
forall a. Semigroup a => a -> a -> a
<> Attributed a
s) Int
w

-- | Like 'lblock' but aligned centered.
cblock :: HasChars a => Int -> Doc a -> Doc a
cblock :: forall a. HasChars a => Int -> Doc a -> Doc a
cblock Int
w = (Attributed a -> Attributed a) -> Int -> Doc a -> Doc a
forall a.
HasChars a =>
(Attributed a -> Attributed a) -> Int -> Doc a -> Doc a
block (\Attributed a
s -> Int -> Char -> Attributed a
forall a. HasChars a => Int -> Char -> a
replicateChar ((Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Attributed a -> Int
forall a. HasChars a => a -> Int
realLength Attributed a
s) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Char
' ' Attributed a -> Attributed a -> Attributed a
forall a. Semigroup a => a -> a -> a
<> Attributed a
s) Int
w

-- | Returns the height of a block or other 'Doc'.
height :: HasChars a => Doc a -> Int
height :: forall a. HasChars a => Doc a -> Int
height = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> (Doc a -> [a]) -> Doc a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
forall a. HasChars a => a -> [a]
splitLines (a -> [a]) -> (Doc a -> a) -> Doc a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Doc a -> a
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing

block :: HasChars a => (Attributed a -> Attributed a) -> Int -> Doc a -> Doc a
block :: forall a.
HasChars a =>
(Attributed a -> Attributed a) -> Int -> Doc a -> Doc a
block Attributed a -> Attributed a
filler Int
width Doc a
d
  | Int
width Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not (Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
d) = (Attributed a -> Attributed a) -> Int -> Doc a -> Doc a
forall a.
HasChars a =>
(Attributed a -> Attributed a) -> Int -> Doc a -> Doc a
block Attributed a -> Attributed a
filler Int
1 Doc a
d
  | Bool
otherwise                    = Int -> [Attributed a] -> Doc a
forall a. Int -> [Attributed a] -> Doc a
Block Int
width [Attributed a]
ls
     where
       preimage :: Attributed a
preimage = Maybe Int -> Doc a -> Attributed a
forall a. HasChars a => Maybe Int -> Doc a -> Attributed a
prerender (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
width) Doc a
d
       reboxed :: [Attributed a]
reboxed = Int -> Attributed a -> [Attributed a]
forall a. HasChars a => Int -> a -> [a]
chop Int
width Attributed a
preimage
       ls :: [Attributed a]
ls = (Attributed a -> Attributed a) -> [Attributed a] -> [Attributed a]
forall a b. (a -> b) -> [a] -> [b]
map Attributed a -> Attributed a
filler [Attributed a]
reboxed

-- | An expandable border that, when placed next to a box,
-- expands to the height of the box.  Strings cycle through the
-- list provided.
vfill :: HasChars a => a -> Doc a
vfill :: forall a. HasChars a => a -> Doc a
vfill a
t = Int -> a -> Doc a
forall a. Int -> a -> Doc a
VFill (a -> Int
forall a. HasChars a => a -> Int
realLength a
t) a
t

chop :: HasChars a => Int -> a -> [a]
chop :: forall a. HasChars a => Int -> a -> [a]
chop Int
n =
   ((Int, a) -> [a]) -> [(Int, a)] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, a) -> [a]
forall {a}. HasChars a => (Int, a) -> [a]
chopLine ([(Int, a)] -> [a]) -> (a -> [(Int, a)]) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, a)] -> [(Int, a)]
forall {a} {b}. (Eq a, Num a) => [(a, b)] -> [(a, b)]
removeFinalEmpty ([(Int, a)] -> [(Int, a)]) -> (a -> [(Int, a)]) -> a -> [(Int, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (Int, a)) -> [a] -> [(Int, a)]
forall a b. (a -> b) -> [a] -> [b]
map a -> (Int, a)
forall {b}. HasChars b => b -> (Int, b)
addRealLength ([a] -> [(Int, a)]) -> (a -> [a]) -> a -> [(Int, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
forall a. HasChars a => a -> [a]
splitLines
 where
   removeFinalEmpty :: [(a, b)] -> [(a, b)]
removeFinalEmpty [(a, b)]
xs = case [(a, b)] -> Maybe (a, b)
forall a. [a] -> Maybe a
lastMay [(a, b)]
xs of
                           Just (a
0, b
_) -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a]
initSafe [(a, b)]
xs
                           Maybe (a, b)
_           -> [(a, b)]
xs
   addRealLength :: b -> (Int, b)
addRealLength b
l = (b -> Int
forall a. HasChars a => a -> Int
realLength b
l, b
l)
   chopLine :: (Int, a) -> [a]
chopLine (Int
len, a
l)
     | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n  = [a
l]
     | Bool
otherwise = ((Int, a) -> a) -> [(Int, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Int, a) -> a
forall a b. (a, b) -> b
snd ([(Int, a)] -> [a]) -> [(Int, a)] -> [a]
forall a b. (a -> b) -> a -> b
$
                    (Char -> [(Int, a)] -> [(Int, a)]) -> [(Int, a)] -> a -> [(Int, a)]
forall a b. HasChars a => (Char -> b -> b) -> b -> a -> b
forall b. (Char -> b -> b) -> b -> a -> b
foldrChar
                     (\Char
c [(Int, a)]
ls ->
                       let clen :: Int
clen = Char -> Int
charWidth Char
c
                           cs :: a
cs = Int -> Char -> a
forall a. HasChars a => Int -> Char -> a
replicateChar Int
1 Char
c
                        in case [(Int, a)]
ls of
                             (Int
len', a
l'):[(Int, a)]
rest
                               | Int
len' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
clen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n ->
                                   (Int
clen, a
cs)(Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:(Int
len', a
l')(Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:[(Int, a)]
rest
                               | Bool
otherwise ->
                                   (Int
len' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
clen, a
cs a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
l')(Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:[(Int, a)]
rest
                             [] -> [(Int
clen, a
cs)]) [] a
l

-- | Encloses a 'Doc' inside a start and end 'Doc'.
inside :: Doc a -> Doc a -> Doc a -> Doc a
inside :: forall a. Doc a -> Doc a -> Doc a -> Doc a
inside Doc a
start Doc a
end Doc a
contents =
  Doc a
start Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
contents Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
end

-- | Puts a 'Doc' in curly braces.
braces :: HasChars a => Doc a -> Doc a
braces :: forall a. HasChars a => Doc a -> Doc a
braces = Doc a -> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a -> Doc a
inside (Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
'{') (Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
'}')

-- | Puts a 'Doc' in square brackets.
brackets :: HasChars a => Doc a -> Doc a
brackets :: forall a. HasChars a => Doc a -> Doc a
brackets = Doc a -> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a -> Doc a
inside (Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
'[') (Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
']')

-- | Puts a 'Doc' in parentheses.
parens :: HasChars a => Doc a -> Doc a
parens :: forall a. HasChars a => Doc a -> Doc a
parens = Doc a -> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a -> Doc a
inside (Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
'(') (Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
')')

-- | Wraps a 'Doc' in single quotes.
quotes :: HasChars a => Doc a -> Doc a
quotes :: forall a. HasChars a => Doc a -> Doc a
quotes = Doc a -> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a -> Doc a
inside (Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
'\'') (Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
'\'')

-- | Wraps a 'Doc' in double quotes.
doubleQuotes :: HasChars a => Doc a -> Doc a
doubleQuotes :: forall a. HasChars a => Doc a -> Doc a
doubleQuotes = Doc a -> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a -> Doc a
inside (Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
'"') (Char -> Doc a
forall a. HasChars a => Char -> Doc a
char Char
'"')

styled :: HasChars a => StyleReq -> Doc a -> Doc a
styled :: forall a. HasChars a => StyleReq -> Doc a -> Doc a
styled StyleReq
_ Doc a
Empty = Doc a
forall a. Doc a
Empty
styled StyleReq
s Doc a
x = StyleReq -> Doc a -> Doc a
forall a. StyleReq -> Doc a -> Doc a
Styled StyleReq
s Doc a
x

-- | Puts a 'Doc' in boldface.
bold :: HasChars a => Doc a -> Doc a
bold :: forall a. HasChars a => Doc a -> Doc a
bold = StyleReq -> Doc a -> Doc a
forall a. HasChars a => StyleReq -> Doc a -> Doc a
styled (Weight -> StyleReq
RWeight Weight
Bold)

-- | Puts a 'Doc' in italics.
italic :: HasChars a => Doc a -> Doc a
italic :: forall a. HasChars a => Doc a -> Doc a
italic = StyleReq -> Doc a -> Doc a
forall a. HasChars a => StyleReq -> Doc a -> Doc a
styled (Shape -> StyleReq
RShape Shape
Italic)

-- | Underlines a 'Doc'.
underlined :: HasChars a => Doc a -> Doc a
underlined :: forall a. HasChars a => Doc a -> Doc a
underlined = StyleReq -> Doc a -> Doc a
forall a. HasChars a => StyleReq -> Doc a -> Doc a
styled (Underline -> StyleReq
RUnderline Underline
ULSingle)

-- | Puts a line through a 'Doc'.
strikeout :: HasChars a => Doc a -> Doc a
strikeout :: forall a. HasChars a => Doc a -> Doc a
strikeout = StyleReq -> Doc a -> Doc a
forall a. HasChars a => StyleReq -> Doc a -> Doc a
styled (Strikeout -> StyleReq
RStrikeout Strikeout
Struck)

-- The Color type is here as an opaque alias to Color8 for the public interface
-- and there's trivial smart constructors for the individual colors to
-- hopefully allow for easier extension to supporting indexed and rgb colors in
-- the future, without dramatically changing the public API.

type Color = Color8

-- | Set foreground color.
fg :: HasChars a => Color -> Doc a -> Doc a
fg :: forall a. HasChars a => Color -> Doc a -> Doc a
fg = StyleReq -> Doc a -> Doc a
forall a. HasChars a => StyleReq -> Doc a -> Doc a
styled (StyleReq -> Doc a -> Doc a)
-> (Color -> StyleReq) -> Color -> Doc a -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Foreground -> StyleReq
RForeground (Foreground -> StyleReq)
-> (Color -> Foreground) -> Color -> StyleReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Foreground
FG

-- | Set background color.
bg :: HasChars a => Color -> Doc a -> Doc a
bg :: forall a. HasChars a => Color -> Doc a -> Doc a
bg = StyleReq -> Doc a -> Doc a
forall a. HasChars a => StyleReq -> Doc a -> Doc a
styled (StyleReq -> Doc a -> Doc a)
-> (Color -> StyleReq) -> Color -> Doc a -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Background -> StyleReq
RBackground (Background -> StyleReq)
-> (Color -> Background) -> Color -> StyleReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Background
BG

blue :: Color
blue :: Color
blue = Color
Blue

black :: Color
black :: Color
black = Color
Black

red :: Color
red :: Color
red = Color
Red

green :: Color
green :: Color
green = Color
Green

yellow :: Color
yellow :: Color
yellow = Color
Yellow

magenta :: Color
magenta :: Color
magenta = Color
Magenta

cyan :: Color
cyan :: Color
cyan = Color
Cyan

white :: Color
white :: Color
white = Color
White

-- | Make Doc a hyperlink.
link :: HasChars a => Text -> Doc a -> Doc a
link :: forall a. HasChars a => Text -> Doc a -> Doc a
link = Text -> Doc a -> Doc a
forall a. Text -> Doc a -> Doc a
Linked

-- | Returns width of a character in a monospace font:  0 for a combining
-- character, 1 for a regular character, 2 for an East Asian wide character.
-- Ambiguous characters are treated as width 1.
charWidth :: Char -> Int
charWidth :: Char -> Int
charWidth = MatchState -> Int
extractLength (MatchState -> Int) -> (Char -> MatchState) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchState -> Char -> MatchState
updateMatchStateNarrow (Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False Int
0 Char
' ' Int
0)

-- | Get real length of string, taking into account combining and double-wide
-- characters. Ambiguous characters are treated as width 1.
realLength :: HasChars a => a -> Int
realLength :: forall a. HasChars a => a -> Int
realLength = a -> Int
forall a. HasChars a => a -> Int
realLengthNarrowContext

-- | Get the real length of a string, taking into account combining and
-- double-wide characters. Ambiguous characters are treated as width 1.
realLengthNarrowContext :: HasChars a => a -> Int
realLengthNarrowContext :: forall a. HasChars a => a -> Int
realLengthNarrowContext = (MatchState -> Char -> MatchState) -> a -> Int
forall a.
HasChars a =>
(MatchState -> Char -> MatchState) -> a -> Int
realLengthWith MatchState -> Char -> MatchState
updateMatchStateNarrow

-- | Get the real length of a string, taking into account combining and
-- double-wide characters. Ambiguous characters are treated as width 2.
realLengthWideContext :: HasChars a => a -> Int
realLengthWideContext :: forall a. HasChars a => a -> Int
realLengthWideContext = (MatchState -> Char -> MatchState) -> a -> Int
forall a.
HasChars a =>
(MatchState -> Char -> MatchState) -> a -> Int
realLengthWith MatchState -> Char -> MatchState
updateMatchStateWide

-- | Like 'realLengthNarrowContext', but avoids optimizations (shortcuts).
-- This is exposed for testing, to ensure that the optimizations are safe.
realLengthNarrowContextNoShortcut :: HasChars a => a -> Int
realLengthNarrowContextNoShortcut :: forall a. HasChars a => a -> Int
realLengthNarrowContextNoShortcut = (MatchState -> Char -> MatchState) -> a -> Int
forall a.
HasChars a =>
(MatchState -> Char -> MatchState) -> a -> Int
realLengthWith MatchState -> Char -> MatchState
updateMatchStateNoShortcut

-- | Like 'realLengthWideContext', but avoids optimizations (shortcuts).
-- This is exposed for testing, to ensure that the optimizations are safe.
realLengthWideContextNoShortcut :: HasChars a => a -> Int
realLengthWideContextNoShortcut :: forall a. HasChars a => a -> Int
realLengthWideContextNoShortcut = (MatchState -> Char -> MatchState) -> a -> Int
forall a.
HasChars a =>
(MatchState -> Char -> MatchState) -> a -> Int
realLengthWith MatchState -> Char -> MatchState
updateMatchStateNoShortcutWide

-- | Get real length of string, taking into account combining and double-wide
-- characters, using the given accumulator. This is exposed for testing.
realLengthWith :: HasChars a => (MatchState -> Char -> MatchState) -> a -> Int
realLengthWith :: forall a.
HasChars a =>
(MatchState -> Char -> MatchState) -> a -> Int
realLengthWith MatchState -> Char -> MatchState
f = MatchState -> Int
extractLength (MatchState -> Int) -> (a -> MatchState) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MatchState -> Char -> MatchState) -> MatchState -> a -> MatchState
forall a b. HasChars a => (b -> Char -> b) -> b -> a -> b
forall b. (b -> Char -> b) -> b -> a -> b
foldlChar MatchState -> Char -> MatchState
f (Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
True Int
0 Char
' ' Int
0)

-- | Update a 'MatchState' by processing a character.
-- For efficiency, we isolate commonly used portions of the basic
-- multilingual plane that do not have emoji in them.
-- This works in a narrow context.
updateMatchStateNarrow :: MatchState -> Char -> MatchState
updateMatchStateNarrow :: MatchState -> Char -> MatchState
updateMatchStateNarrow (MatchState Bool
firstChar Int
tot Char
_ Int
tentative) !Char
c
    -- Control characters have width 0: friends don't let friends use tabs
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x001F'  = MatchState
controlState
    -- ASCII
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x007E'  = MatchState
narrowState
    -- More control characters
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x009F'  = MatchState
controlState
    -- Extended Latin: Latin 1-supplement, Extended-A, Extended-B, IPA Extensions.
    -- This block is full of ambiguous characters, so these shortcuts will not
    -- work in a wide context.
    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x00AD'  = MatchState
controlState    -- Soft hyphen
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x02FF'  = MatchState
narrowState
    -- Combining diacritical marks used in Latin and other scripts
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x036F'  = MatchState
combiningState
    -- Han ideographs
    | 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
'\xA4CF' =
        if | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x4DBF' -> MatchState
wideState       -- Han ideographs
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x4DFF' -> MatchState
narrowState     -- Hexagrams
           | Bool
otherwise     -> MatchState
wideState       -- More Han ideographs
    -- Arabic
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0600' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x06FF' =
        if | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0605' -> MatchState
controlState    -- Number marks
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x060F' -> MatchState
narrowState     -- Punctuation and marks
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x061A' -> MatchState
combiningState  -- Combining marks
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x061B' -> MatchState
narrowState     -- Arabic semicolon
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x061C' -> MatchState
controlState    -- Letter mark
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x064A' -> MatchState
narrowState     -- Main Arabic abjad
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x065F' -> MatchState
combiningState  -- Arabic vowel markers
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0670' -> MatchState
combiningState  -- Superscript alef
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x06D5' -> MatchState
narrowState     -- Arabic digits and letters used in other languages
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x06DC' -> MatchState
combiningState  -- Small high ligatures
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x06DD' -> MatchState
controlState    -- End of ayah
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x06DE' -> MatchState
narrowState     -- Start of rub el hizb
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x06E4' -> MatchState
combiningState  -- More small high ligatures
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x06E6' -> MatchState
narrowState     -- Small vowels
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x06E9' -> MatchState
narrowState     -- Place of sajdah
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x06ED' -> MatchState
combiningState  -- More combining
           | Bool
otherwise     -> MatchState
narrowState     -- All the rest
    -- Devanagari
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0900' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x097F' =
        if | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0902' -> MatchState
combiningState  -- Combining characters
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0939' -> MatchState
narrowState     -- Main Devanagari abugida
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x093A' -> MatchState
combiningState
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x093C' -> MatchState
combiningState
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0940' -> MatchState
narrowState     -- Main Devanagari abugida
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0948' -> MatchState
combiningState  -- Combining characters
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x094D' -> MatchState
combiningState  -- Combining characters
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0950' -> MatchState
narrowState     -- Devanagari om
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0957' -> MatchState
combiningState  -- Combining characters
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0962' -> MatchState
combiningState  -- Combining character
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0963' -> MatchState
combiningState  -- Combining character
           | Bool
otherwise     -> MatchState
narrowState     -- Devanagari digits and up to beginning of Bengali block
    -- Bengali (plus a couple Gurmukhi characters)
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0980' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0A02' =
        if | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0981' -> MatchState
combiningState  -- Combining signs
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x09BC' -> MatchState
combiningState  -- Combining signs
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x09C0' -> MatchState
narrowState     -- Main Bengali abugida
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x09C4' -> MatchState
combiningState  -- Combining signs
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x09CD' -> MatchState
combiningState  -- Combining signs
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x09E1' -> MatchState
narrowState     -- Bengali
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x09E3' -> MatchState
combiningState  -- Combining marks
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x09E2' -> MatchState
combiningState  -- Bengali vocalic vowel signs
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x09E3' -> MatchState
combiningState  -- Bengali vocalic vowel signs
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x09FD' -> MatchState
narrowState     -- Bengali digits and other symbols
           | Bool
otherwise     -> MatchState
combiningState  -- Bengali sandhi mark, plus a few symbols from Gurmukhi
    -- Cyrillic (plus Greek and Armenian for free)
    -- This block has many ambiguous characters, and so cannot be used in wide contexts
    | 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
'\x058F' =
        if | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0482' -> MatchState
narrowState     -- Main Greek and Cyrillic block
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0489' -> MatchState
combiningState  -- Cyrillic combining characters
           | Bool
otherwise     -> MatchState
narrowState     -- Extra Cyrillic characters used in Ukrainian and others, plus Armenian
    -- Japanese
    | 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
'\x324F' =
        if | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x3029' -> MatchState
wideState       -- Punctuation and others
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x302D' -> MatchState
combiningState  -- Tone marks
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x303F' -> MatchState
narrowState     -- Half-fill space
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x3096' -> MatchState
wideState       -- Hiragana and others
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x309A' -> MatchState
combiningState  -- Hiragana voiced marks
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x3247' -> MatchState
wideState       -- Katakana plus compatibility Jamo for Korean
           | Bool
otherwise     -> MatchState
ambiguousState  -- Circled numbers
    -- Korean
    | 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
'\xD7A3' = MatchState
wideState  -- Precomposed Hangul
    -- Telugu (plus one character of Kannada)
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0C00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0C80' =
        if | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0C00' -> MatchState
combiningState  -- Combining characters
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0C04' -> MatchState
combiningState  -- Combining characters
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0C39' -> MatchState
narrowState     -- Main Telugu abugida
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0C3D' -> MatchState
narrowState     -- Telugu avagraha
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0C40' -> MatchState
combiningState  -- Vowel markers
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0C44' -> MatchState
narrowState     -- Vowel markers
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0C56' -> MatchState
combiningState  -- Vowel markers
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0C62' -> MatchState
combiningState  -- Combining character
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0C63' -> MatchState
combiningState  -- Combining character
           | Bool
otherwise     -> MatchState
narrowState     -- Telugu digits
    -- Tamil
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0B80' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0BFF' =
        if | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0B82' -> MatchState
combiningState  -- Combining characters
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0BC0' -> MatchState
combiningState  -- Combining characters
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0BCD' -> MatchState
combiningState  -- Vowel markers
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0BCC' -> MatchState
narrowState     -- Main Tamil abugida
           | Bool
otherwise     -> MatchState
narrowState     -- Tamil digits and others
  where
    narrowState :: MatchState
narrowState    = Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tentative) Char
c Int
1
    wideState :: MatchState
wideState      = Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tentative) Char
c Int
2
    combiningState :: MatchState
combiningState = let w :: Int
w = if Bool
firstChar then Int
1 else Int
0 in Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tentative) Char
c Int
w
    controlState :: MatchState
controlState   = Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tentative) Char
c Int
0
    ambiguousState :: MatchState
ambiguousState = Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tentative) Char
c Int
1
updateMatchStateNarrow MatchState
s Char
c = MatchState -> Char -> MatchState
updateMatchStateNoShortcut MatchState
s Char
c

-- | Update a 'MatchState' by processing a character.
-- For efficiency, we isolate commonly used portions of the basic
-- multilingual plane that do not have emoji in them.
-- This works in a wide context.
updateMatchStateWide :: MatchState -> Char -> MatchState
updateMatchStateWide :: MatchState -> Char -> MatchState
updateMatchStateWide (MatchState Bool
firstChar Int
tot Char
_ Int
tentative) !Char
c
    -- Control characters have width 0: friends don't let friends use tabs
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x001F'  = MatchState
controlState
    -- ASCII
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x007E'  = MatchState
narrowState
    -- Han ideographs
    | 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
'\xA4CF' =
        if | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x4DBF' -> MatchState
wideState       -- Han ideographs
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x4DFF' -> MatchState
narrowState     -- Hexagrams
           | Bool
otherwise     -> MatchState
wideState       -- More Han ideographs
    -- Japanese
    | 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
'\x324F' =
        if | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x3029' -> MatchState
wideState       -- Punctuation and others
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x302D' -> MatchState
combiningState  -- Tone marks
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x303F' -> MatchState
narrowState     -- Half-fill space
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x3096' -> MatchState
wideState       -- Hiragana and others
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x309A' -> MatchState
combiningState  -- Hiragana voiced marks
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x3247' -> MatchState
wideState       -- Katakana plus compatibility Jamo for Korean
           | Bool
otherwise     -> MatchState
ambiguousState  -- Circled numbers
    -- Korean
    | 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
'\xD7A3' = MatchState
wideState  -- Precomposed Hangul
    -- Combining diacritical marks used in Latin and other scripts
    | 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'  = MatchState
combiningState
    -- Arabic
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0600' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x06FF' =
        if | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0605' -> MatchState
controlState    -- Number marks
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x060F' -> MatchState
narrowState     -- Punctuation and marks
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x061A' -> MatchState
combiningState  -- Combining marks
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x061B' -> MatchState
narrowState     -- Arabic semicolon
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x061C' -> MatchState
controlState    -- Letter mark
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x064A' -> MatchState
narrowState     -- Main Arabic abjad
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x065F' -> MatchState
combiningState  -- Arabic vowel markers
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0670' -> MatchState
combiningState  -- Superscript alef
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x06D5' -> MatchState
narrowState     -- Arabic digits and letters used in other languages
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x06DC' -> MatchState
combiningState  -- Small high ligatures
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x06DD' -> MatchState
controlState    -- End of ayah
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x06DE' -> MatchState
narrowState     -- Start of rub el hizb
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x06E4' -> MatchState
combiningState  -- More small high ligatures
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x06E6' -> MatchState
narrowState     -- Small vowels
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x06E9' -> MatchState
narrowState     -- Place of sajdah
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x06ED' -> MatchState
combiningState  -- More combining
           | Bool
otherwise     -> MatchState
narrowState     -- All the rest
    -- Devanagari
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0900' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x097F' =
        if | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0902' -> MatchState
combiningState  -- Combining characters
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0939' -> MatchState
narrowState     -- Main Devanagari abugida
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x093A' -> MatchState
combiningState
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x093C' -> MatchState
combiningState
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0940' -> MatchState
narrowState     -- Main Devanagari abugida
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0948' -> MatchState
combiningState  -- Combining characters
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x094D' -> MatchState
combiningState  -- Combining characters
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0950' -> MatchState
narrowState     -- Devanagari om
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0957' -> MatchState
combiningState  -- Combining characters
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0962' -> MatchState
combiningState  -- Combining character
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0963' -> MatchState
combiningState  -- Combining character
           | Bool
otherwise     -> MatchState
narrowState     -- Devanagari digits and up to beginning of Bengali block
    -- Bengali (plus a couple Gurmukhi characters)
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0980' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0A02' =
        if | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0981' -> MatchState
combiningState  -- Combining signs
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x09BC' -> MatchState
combiningState  -- Combining signs
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x09C0' -> MatchState
narrowState     -- Main Bengali abugida
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x09C4' -> MatchState
combiningState  -- Combining signs
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x09CD' -> MatchState
combiningState  -- Combining signs
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x09E1' -> MatchState
narrowState     -- Bengali
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x09E3' -> MatchState
combiningState  -- Combining marks
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x09E2' -> MatchState
combiningState  -- Bengali vocalic vowel signs
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x09E3' -> MatchState
combiningState  -- Bengali vocalic vowel signs
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x09FD' -> MatchState
narrowState     -- Bengali digits and other symbols
           | Bool
otherwise     -> MatchState
combiningState  -- Bengali sandhi mark, plus a few symbols from Gurmukhi
    -- Telugu (plus one character of Kannada)
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0C00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0C80' =
        if | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0C00' -> MatchState
combiningState  -- Combining characters
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0C04' -> MatchState
combiningState  -- Combining characters
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0C39' -> MatchState
narrowState     -- Main Telugu abugida
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0C3D' -> MatchState
narrowState     -- Telugu avagraha
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0C40' -> MatchState
combiningState  -- Vowel markers
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0C44' -> MatchState
narrowState     -- Vowel markers
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0C56' -> MatchState
combiningState  -- Vowel markers
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0C62' -> MatchState
combiningState  -- Combining character
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0C63' -> MatchState
combiningState  -- Combining character
           | Bool
otherwise     -> MatchState
narrowState     -- Telugu digits
    -- Tamil
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0B80' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0BFF' =
        if | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0B82' -> MatchState
combiningState  -- Combining characters
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0BC0' -> MatchState
combiningState  -- Combining characters
           | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x0BCD' -> MatchState
combiningState  -- Vowel markers
           | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0BCC' -> MatchState
narrowState     -- Main Tamil abugida
           | Bool
otherwise     -> MatchState
narrowState     -- Tamil digits and others
  where
    narrowState :: MatchState
narrowState    = Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tentative) Char
c Int
1
    wideState :: MatchState
wideState      = Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tentative) Char
c Int
2
    combiningState :: MatchState
combiningState = let w :: Int
w = if Bool
firstChar then Int
1 else Int
0 in Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tentative) Char
c Int
w
    controlState :: MatchState
controlState   = Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tentative) Char
c Int
0
    ambiguousState :: MatchState
ambiguousState = Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tentative) Char
c Int
2
updateMatchStateWide MatchState
s Char
c = MatchState -> Char -> MatchState
updateMatchStateNoShortcutWide MatchState
s Char
c

-- | Update a 'MatchState' by processing a character, without taking any
-- shortcuts. This should give the same answer as 'updateMatchStateNarrow', but will
-- be slower. It is here to test that the shortcuts are implemented correctly.
updateMatchStateNoShortcut :: MatchState -> Char -> MatchState
updateMatchStateNoShortcut :: MatchState -> Char -> MatchState
updateMatchStateNoShortcut MatchState
match Char
c = MatchState -> Char -> UnicodeWidth -> MatchState
resolveWidth MatchState
match Char
c (UnicodeWidth -> MatchState) -> UnicodeWidth -> MatchState
forall a b. (a -> b) -> a -> b
$ UnicodeMap -> Char -> UnicodeWidth
unicodeWidth (UnicodeWidth -> UnicodeMap
unicodeRangeMap UnicodeWidth
Narrow) Char
c

-- | Update a 'MatchState' by processing a character, without taking any
-- shortcuts. This should give the same answer as 'updateMatchStateWide', but will
-- be slower. It is here to test that the shortcuts are implemented correctly.
updateMatchStateNoShortcutWide :: MatchState -> Char -> MatchState
updateMatchStateNoShortcutWide :: MatchState -> Char -> MatchState
updateMatchStateNoShortcutWide MatchState
match Char
c = MatchState -> Char -> UnicodeWidth -> MatchState
resolveWidth MatchState
match Char
c (UnicodeWidth -> MatchState) -> UnicodeWidth -> MatchState
forall a b. (a -> b) -> a -> b
$ UnicodeMap -> Char -> UnicodeWidth
unicodeWidth (UnicodeWidth -> UnicodeMap
unicodeRangeMap UnicodeWidth
Wide) Char
c

-- | Update a match state given a character and its class
resolveWidth :: MatchState -> Char -> UnicodeWidth -> MatchState
resolveWidth :: MatchState -> Char -> UnicodeWidth -> MatchState
resolveWidth (MatchState Bool
firstChar Int
tot Char
lastChar Int
tentative) !Char
c = \case
    UnicodeWidth
Narrow                    -> MatchState
narrowState
    UnicodeWidth
Wide                      -> MatchState
wideState
    UnicodeWidth
Combining                 -> MatchState
combiningState
    UnicodeWidth
Control                   -> MatchState
controlState
    UnicodeWidth
Ambiguous                 -> MatchState
ambiguousState
    -- Zero width joiners will join two emoji together, so let's discard the
    -- state and parse the next emoji
    UnicodeWidth
ZWJ | Bool
isLastCharEmojiLike -> Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Char
c Int
2
    UnicodeWidth
ZWJ                       -> MatchState
controlState
    -- Variation modifiers modify the emoji up to this point, so can be
    -- discarded. However, they always make it width 2, so we set the tentative
    -- width to 2.
    UnicodeWidth
EmojiPresentationMod | Just (EmojiInfo Bool
True Bool
_) <- Maybe EmojiInfo
lastCharEmoji
                              -> Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False Int
tot Char
c Int
2
    UnicodeWidth
EmojiPresentationMod      -> MatchState
controlState
    -- Skin tone modifiers make it width 2, but if they are not in a valid
    -- position they end the emoji and take up another width 2.
    UnicodeWidth
EmojiSkinToneMod | Just (EmojiInfo Bool
_ Bool
True) <- Maybe EmojiInfo
lastCharEmoji
                              -> Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False Int
tot Char
c Int
2
    UnicodeWidth
EmojiSkinToneMod          -> MatchState
wideState
  where
    narrowState :: MatchState
narrowState    = Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tentative) Char
c Int
1
    wideState :: MatchState
wideState      = Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tentative) Char
c Int
2
    combiningState :: MatchState
combiningState = let w :: Int
w = if Bool
firstChar then Int
1 else Int
0 in Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tentative) Char
c Int
w
    controlState :: MatchState
controlState   = Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tentative) Char
c Int
0
    ambiguousState :: MatchState
ambiguousState = Bool -> Int -> Char -> Int -> MatchState
MatchState Bool
False (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tentative) Char
c Int
1  -- Should be handled already, but treat it as 1
    lastCharEmoji :: Maybe EmojiInfo
lastCharEmoji = Int -> IntMap EmojiInfo -> Maybe EmojiInfo
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Char -> Int
ord Char
lastChar) IntMap EmojiInfo
emojiMap
    isLastCharEmojiLike :: Bool
isLastCharEmojiLike = Maybe EmojiInfo -> Bool
forall a. Maybe a -> Bool
isJust Maybe EmojiInfo
lastCharEmoji Bool -> Bool -> Bool
|| Char
lastChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\xFE0F' Bool -> Bool -> Bool
|| Char -> Bool
isSkinToneModifier Char
lastChar

-- | Keeps track of state in length calculations, determining whether we're at
-- the first character, the width so far, possibly a tentative width for this
-- group, and the Map for possible emoji continuations.
data MatchState = MatchState
    { MatchState -> Bool
matchIsFirst       :: !Bool
    , MatchState -> Int
matchTotal         :: !Int
    , MatchState -> Char
matchLastChar      :: !Char
    , MatchState -> Int
matchTentative     :: !Int
    }
  deriving (Int -> MatchState -> ShowS
[MatchState] -> ShowS
MatchState -> String
(Int -> MatchState -> ShowS)
-> (MatchState -> String)
-> ([MatchState] -> ShowS)
-> Show MatchState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MatchState -> ShowS
showsPrec :: Int -> MatchState -> ShowS
$cshow :: MatchState -> String
show :: MatchState -> String
$cshowList :: [MatchState] -> ShowS
showList :: [MatchState] -> ShowS
Show)

-- | Get the final width from a 'MatchState'.
extractLength :: MatchState -> Int
extractLength :: MatchState -> Int
extractLength (MatchState Bool
_ Int
tot Char
_ Int
tentative) = Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tentative

-- | The unicode width  of a given character.
data UnicodeWidth = Narrow | Wide | Combining | Control | Ambiguous
                  | ZWJ | EmojiPresentationMod | EmojiSkinToneMod
  deriving (Int -> UnicodeWidth -> ShowS
[UnicodeWidth] -> ShowS
UnicodeWidth -> String
(Int -> UnicodeWidth -> ShowS)
-> (UnicodeWidth -> String)
-> ([UnicodeWidth] -> ShowS)
-> Show UnicodeWidth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnicodeWidth -> ShowS
showsPrec :: Int -> UnicodeWidth -> ShowS
$cshow :: UnicodeWidth -> String
show :: UnicodeWidth -> String
$cshowList :: [UnicodeWidth] -> ShowS
showList :: [UnicodeWidth] -> ShowS
Show, UnicodeWidth -> UnicodeWidth -> Bool
(UnicodeWidth -> UnicodeWidth -> Bool)
-> (UnicodeWidth -> UnicodeWidth -> Bool) -> Eq UnicodeWidth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnicodeWidth -> UnicodeWidth -> Bool
== :: UnicodeWidth -> UnicodeWidth -> Bool
$c/= :: UnicodeWidth -> UnicodeWidth -> Bool
/= :: UnicodeWidth -> UnicodeWidth -> Bool
Eq)

-- | Checks whether a character is a skin tone modifier.
isSkinToneModifier :: Char -> Bool
isSkinToneModifier :: Char -> Bool
isSkinToneModifier Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1F3FB' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1F3FF'

-- | Checks whether a character is an emoji variation modifier.
isEmojiVariation :: Char -> Bool
isEmojiVariation :: Char -> Bool
isEmojiVariation Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFE0E' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFE0F'

-- | Checks whether a character is a zero-width joiner.
isZWJ :: Char -> Bool
isZWJ :: Char -> Bool
isZWJ Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x200D'

data EmojiInfo = EmojiInfo
    { EmojiInfo -> Bool
acceptsVariation :: !Bool
    , EmojiInfo -> Bool
acceptsSkinTones :: !Bool
    } deriving (EmojiInfo -> EmojiInfo -> Bool
(EmojiInfo -> EmojiInfo -> Bool)
-> (EmojiInfo -> EmojiInfo -> Bool) -> Eq EmojiInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EmojiInfo -> EmojiInfo -> Bool
== :: EmojiInfo -> EmojiInfo -> Bool
$c/= :: EmojiInfo -> EmojiInfo -> Bool
/= :: EmojiInfo -> EmojiInfo -> Bool
Eq, Int -> EmojiInfo -> ShowS
[EmojiInfo] -> ShowS
EmojiInfo -> String
(Int -> EmojiInfo -> ShowS)
-> (EmojiInfo -> String)
-> ([EmojiInfo] -> ShowS)
-> Show EmojiInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EmojiInfo -> ShowS
showsPrec :: Int -> EmojiInfo -> ShowS
$cshow :: EmojiInfo -> String
show :: EmojiInfo -> String
$cshowList :: [EmojiInfo] -> ShowS
showList :: [EmojiInfo] -> ShowS
Show)

instance Semigroup EmojiInfo where
    EmojiInfo Bool
v1 Bool
s1 <> :: EmojiInfo -> EmojiInfo -> EmojiInfo
<> EmojiInfo Bool
v2 Bool
s2 = Bool -> Bool -> EmojiInfo
EmojiInfo (Bool
v1 Bool -> Bool -> Bool
|| Bool
v2) (Bool
s1 Bool -> Bool -> Bool
|| Bool
s2)

-- | Check a character to see how it modifies emoji.
variationState :: Char -> EmojiInfo
variationState :: Char -> EmojiInfo
variationState Char
y = Bool -> Bool -> EmojiInfo
EmojiInfo (Char -> Bool
isEmojiVariation Char
y) (Char -> Bool
isSkinToneModifier Char
y)

-- | A map of all emoji start characters and the modifiers they take.
emojiMap :: IM.IntMap EmojiInfo
emojiMap :: IntMap EmojiInfo
emojiMap = (IntMap EmojiInfo -> (Char, Text) -> IntMap EmojiInfo)
-> IntMap EmojiInfo -> [(Char, Text)] -> IntMap EmojiInfo
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((Char, Text) -> IntMap EmojiInfo -> IntMap EmojiInfo)
-> IntMap EmojiInfo -> (Char, Text) -> IntMap EmojiInfo
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Char, Text) -> IntMap EmojiInfo -> IntMap EmojiInfo
addEmoji) IntMap EmojiInfo
forall a. Monoid a => a
mempty ([(Char, Text)] -> IntMap EmojiInfo)
-> [(Char, Text)] -> IntMap EmojiInfo
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe (Char, Text)) -> [Text] -> [(Char, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe (Char, Text)
T.uncons [Text]
baseEmojis
  where
    addEmoji :: (Char, Text) -> IntMap EmojiInfo -> IntMap EmojiInfo
addEmoji (Char
x, Text
xs) = (EmojiInfo -> EmojiInfo -> EmojiInfo)
-> Int -> EmojiInfo -> IntMap EmojiInfo -> IntMap EmojiInfo
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith EmojiInfo -> EmojiInfo -> EmojiInfo
forall a. Semigroup a => a -> a -> a
(<>) (Char -> Int
ord Char
x) (Text -> EmojiInfo
emojiInfo Text
xs)
    emojiInfo :: Text -> EmojiInfo
emojiInfo = EmojiInfo
-> ((Char, Text) -> EmojiInfo) -> Maybe (Char, Text) -> EmojiInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> Bool -> EmojiInfo
EmojiInfo Bool
False Bool
False) (Char -> EmojiInfo
variationState (Char -> EmojiInfo)
-> ((Char, Text) -> Char) -> (Char, Text) -> EmojiInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Text) -> Char
forall a b. (a, b) -> a
fst) (Maybe (Char, Text) -> EmojiInfo)
-> (Text -> Maybe (Char, Text)) -> Text -> EmojiInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
T.uncons

-- | Denotes the contiguous ranges of Unicode characters which have a given
-- width: 1 for a regular character, 2 for an East Asian wide character.
-- Ambiguous characters are resolved in the specified way.
unicodeRangeMap :: UnicodeWidth -> UnicodeMap
unicodeRangeMap :: UnicodeWidth -> UnicodeMap
unicodeRangeMap UnicodeWidth
ambiguous =
    Map Char UnicodeWidth -> UnicodeMap
repack (Map Char UnicodeWidth -> UnicodeMap)
-> ([(Char, UnicodeWidth)] -> Map Char UnicodeWidth)
-> [(Char, UnicodeWidth)]
-> UnicodeMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Char UnicodeWidth -> Map Char UnicodeWidth
addEmojiClasses (Map Char UnicodeWidth -> Map Char UnicodeWidth)
-> ([(Char, UnicodeWidth)] -> Map Char UnicodeWidth)
-> [(Char, UnicodeWidth)]
-> Map Char UnicodeWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, UnicodeWidth)] -> Map Char UnicodeWidth
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Char, UnicodeWidth)] -> Map Char UnicodeWidth)
-> ([(Char, UnicodeWidth)] -> [(Char, UnicodeWidth)])
-> [(Char, UnicodeWidth)]
-> Map Char UnicodeWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, UnicodeWidth)] -> [(Char, UnicodeWidth)]
forall b a. Eq b => [(a, b)] -> [(a, b)]
mergeRanges ([(Char, UnicodeWidth)] -> UnicodeMap)
-> [(Char, UnicodeWidth)] -> UnicodeMap
forall a b. (a -> b) -> a -> b
$
    ((Char, UnicodeWidth) -> (Char, UnicodeWidth))
-> [(Char, UnicodeWidth)] -> [(Char, UnicodeWidth)]
forall a b. (a -> b) -> [a] -> [b]
map ((UnicodeWidth -> UnicodeWidth)
-> (Char, UnicodeWidth) -> (Char, UnicodeWidth)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second UnicodeWidth -> UnicodeWidth
resolve) [(Char, UnicodeWidth)]
unicodeSpec
  where
    resolve :: UnicodeWidth -> UnicodeWidth
resolve UnicodeWidth
Ambiguous = UnicodeWidth
ambiguous
    resolve UnicodeWidth
x         = UnicodeWidth
x

-- | Add zero-width joiner and emoji modifiers to a Map.
addEmojiClasses :: M.Map Char UnicodeWidth -> M.Map Char UnicodeWidth
addEmojiClasses :: Map Char UnicodeWidth -> Map Char UnicodeWidth
addEmojiClasses =
    Char
-> Char
-> UnicodeWidth
-> Map Char UnicodeWidth
-> Map Char UnicodeWidth
forall {p} {a}.
(Ord p, Enum p) =>
p -> p -> a -> Map p a -> Map p a
addAndRestoreBoundary Char
'\x200D' Char
'\x200D' UnicodeWidth
ZWJ
    (Map Char UnicodeWidth -> Map Char UnicodeWidth)
-> (Map Char UnicodeWidth -> Map Char UnicodeWidth)
-> Map Char UnicodeWidth
-> Map Char UnicodeWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char
-> Char
-> UnicodeWidth
-> Map Char UnicodeWidth
-> Map Char UnicodeWidth
forall {p} {a}.
(Ord p, Enum p) =>
p -> p -> a -> Map p a -> Map p a
addAndRestoreBoundary Char
'\xFE0F' Char
'\xFE0F' UnicodeWidth
EmojiPresentationMod
    (Map Char UnicodeWidth -> Map Char UnicodeWidth)
-> (Map Char UnicodeWidth -> Map Char UnicodeWidth)
-> Map Char UnicodeWidth
-> Map Char UnicodeWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char
-> Char
-> UnicodeWidth
-> Map Char UnicodeWidth
-> Map Char UnicodeWidth
forall {p} {a}.
(Ord p, Enum p) =>
p -> p -> a -> Map p a -> Map p a
addAndRestoreBoundary Char
'\x1F3FB' Char
'\x1F3FF' UnicodeWidth
EmojiSkinToneMod
  where
    addAndRestoreBoundary :: p -> p -> a -> Map p a -> Map p a
addAndRestoreBoundary p
k1 p
k2 a
v Map p a
m = Map p a -> Map p a
insertAfter (Map p a -> Map p a) -> Map p a -> Map p a
forall a b. (a -> b) -> a -> b
$ p -> a -> Map p a -> Map p a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert p
k1 a
v Map p a
m
      where
        insertAfter :: Map p a -> Map p a
insertAfter = case p -> Map p a -> Maybe (p, a)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
M.lookupLE p
k1 Map p a
m of
          Just (p
_, a
prev) -> (a -> a -> a) -> p -> a -> Map p a -> Map p a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (\a
_ a
old -> a
old) (p -> p
forall a. Enum a => a -> a
succ p
k2) a
prev
          Maybe (p, a)
Nothing        -> Map p a -> Map p a
forall a. a -> a
id

-- | Collapse unicode character ranges if the general category doesn't make a
-- difference for width.
mergeRanges :: Eq b => [(a, b)] -> [(a, b)]
mergeRanges :: forall b a. Eq b => [(a, b)] -> [(a, b)]
mergeRanges []  = []
mergeRanges [(a, b)
x] = [(a, b)
x]
mergeRanges (x :: (a, b)
x@(a
_,b
xw):y :: (a, b)
y@(a
_,b
yw):[(a, b)]
xs)
    | b
xw b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
yw  = [(a, b)] -> [(a, b)]
forall b a. Eq b => [(a, b)] -> [(a, b)]
mergeRanges ((a, b)
x(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
xs)
    | Bool
otherwise = (a, b)
x (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)]
forall b a. Eq b => [(a, b)] -> [(a, b)]
mergeRanges ((a, b)
y(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
xs)


data UnicodeMap
    = Bin {-# UNPACK #-} !Char !UnicodeWidth !UnicodeMap !UnicodeMap
    | Tip

-- | Find the width of a unicode character
unicodeWidth :: UnicodeMap -> Char -> UnicodeWidth
unicodeWidth :: UnicodeMap -> Char -> UnicodeWidth
unicodeWidth = UnicodeMap -> Char -> UnicodeWidth
goNothing
  where
    goNothing :: UnicodeMap -> Char -> UnicodeWidth
goNothing UnicodeMap
Tip !Char
_ = UnicodeWidth
Control
    goNothing (Bin Char
kx UnicodeWidth
x UnicodeMap
l UnicodeMap
r) Char
k = case Char -> Char -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Char
k Char
kx of
        Ordering
LT -> UnicodeMap -> Char -> UnicodeWidth
goNothing UnicodeMap
l Char
k
        Ordering
EQ -> UnicodeWidth
x
        Ordering
GT -> UnicodeMap -> Char -> Char -> UnicodeWidth -> UnicodeWidth
goJust UnicodeMap
r Char
k Char
kx UnicodeWidth
x

    goJust :: UnicodeMap -> Char -> Char -> UnicodeWidth -> UnicodeWidth
goJust UnicodeMap
Tip !Char
_ !Char
_ UnicodeWidth
x' = UnicodeWidth
x'
    goJust (Bin Char
kx UnicodeWidth
x UnicodeMap
l UnicodeMap
r) Char
k Char
kx' UnicodeWidth
x' = case Char -> Char -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Char
k Char
kx of
        Ordering
LT -> UnicodeMap -> Char -> Char -> UnicodeWidth -> UnicodeWidth
goJust UnicodeMap
l Char
k Char
kx' UnicodeWidth
x'
        Ordering
EQ -> UnicodeWidth
x
        Ordering
GT -> UnicodeMap -> Char -> Char -> UnicodeWidth -> UnicodeWidth
goJust UnicodeMap
r Char
k Char
kx UnicodeWidth
x
{-# INLINABLE unicodeWidth #-}

-- | Convert a Map to a UnicodeMap for faster code.
repack :: M.Map Char UnicodeWidth -> UnicodeMap
repack :: Map Char UnicodeWidth -> UnicodeMap
repack Map Char UnicodeWidth
MInt.Tip = UnicodeMap
Tip
repack (MInt.Bin Int
_ Char
k UnicodeWidth
v Map Char UnicodeWidth
l Map Char UnicodeWidth
r) = Char -> UnicodeWidth -> UnicodeMap -> UnicodeMap -> UnicodeMap
Bin Char
k UnicodeWidth
v (Map Char UnicodeWidth -> UnicodeMap
repack Map Char UnicodeWidth
l) (Map Char UnicodeWidth -> UnicodeMap
repack Map Char UnicodeWidth
r)

-- | A list of Unicode ranges and the width assigned to them
unicodeSpec :: [(Char, UnicodeWidth)]
#include "unicodeWidth.inc"