{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Text.DocLayout (
render
, 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
, empty
, (<+>)
, ($$)
, ($+$)
, hcat
, hsep
, vcat
, vsep
, isEmpty
, offset
, minOffset
, updateColumn
, height
, charWidth
, realLength
, Doc(..)
, HasChars(..)
)
where
import Prelude
import Safe (lastMay, initSafe)
import Control.Monad
import Control.Monad.State.Strict
import GHC.Generics
import Data.Char (isSpace)
import Data.List (intersperse)
import Data.Data (Data, Typeable)
import Data.String
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Text (Text)
#if MIN_VERSION_base(4,11,0)
#else
import Data.Semigroup
#endif
class (IsString a, Semigroup a, Monoid a, Show a) => HasChars a where
foldrChar :: (Char -> b -> b) -> b -> a -> b
replicateChar :: Int -> Char -> a
replicateChar n :: Int
n c :: Char
c = String -> a
forall a. IsString a => String -> a
fromString (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
c)
isNull :: a -> Bool
isNull = (Char -> Bool -> Bool) -> Bool -> a -> Bool
forall a b. HasChars a => (Char -> b -> b) -> b -> a -> b
foldrChar (\_ _ -> Bool
False) Bool
True
splitLines :: a -> [a]
splitLines s :: a
s = (String -> a
forall a. IsString a => String -> a
fromString String
firstline a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
otherlines)
where
(firstline :: String
firstline, otherlines :: [a]
otherlines) = (Char -> (String, [a]) -> (String, [a]))
-> (String, [a]) -> a -> (String, [a])
forall a b. HasChars a => (Char -> b -> b) -> b -> a -> b
foldrChar Char -> (String, [a]) -> (String, [a])
forall a. IsString a => Char -> (String, [a]) -> (String, [a])
go ([],[]) a
s
go :: Char -> (String, [a]) -> (String, [a])
go '\n' (cur :: String
cur,lns :: [a]
lns) = ([], String -> a
forall a. IsString a => String -> a
fromString String
cur a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
lns)
go c :: Char
c (cur :: String
cur,lns :: [a]
lns) = (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cur, [a]
lns)
instance HasChars Text where
foldrChar :: (Char -> b -> b) -> b -> Text -> b
foldrChar = (Char -> b -> b) -> b -> Text -> b
forall b. (Char -> b -> b) -> b -> Text -> b
T.foldr
splitLines :: Text -> [Text]
splitLines = Text -> Text -> [Text]
T.splitOn "\n"
replicateChar :: Int -> Char -> Text
replicateChar n :: Int
n c :: Char
c = Int -> Text -> Text
T.replicate Int
n (Char -> Text
T.singleton Char
c)
isNull :: Text -> Bool
isNull = Text -> Bool
T.null
instance HasChars String where
foldrChar :: (Char -> b -> b) -> b -> String -> b
foldrChar = (Char -> b -> b) -> b -> String -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
splitLines :: String -> [String]
splitLines = String -> [String]
lines (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++"\n")
replicateChar :: Int -> Char -> String
replicateChar = Int -> Char -> String
forall a. Int -> a -> [a]
replicate
isNull :: String -> Bool
isNull = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
instance HasChars TL.Text where
foldrChar :: (Char -> b -> b) -> b -> Text -> b
foldrChar = (Char -> b -> b) -> b -> Text -> b
forall b. (Char -> b -> b) -> b -> Text -> b
TL.foldr
splitLines :: Text -> [Text]
splitLines = Text -> Text -> [Text]
TL.splitOn "\n"
replicateChar :: Int -> Char -> Text
replicateChar n :: Int
n c :: Char
c = Int64 -> Text -> Text
TL.replicate (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Char -> Text
TL.singleton Char
c)
isNull :: Text -> Bool
isNull = Text -> Bool
TL.null
data Doc a = Text Int a
| Block Int [a]
| VFill Int a
| Prefixed Text (Doc a)
| BeforeNonBlank (Doc a)
| Flush (Doc a)
| BreakingSpace
| AfterBreak Text
| CarriageReturn
| NewLine
| BlankLines Int
| Concat (Doc a) (Doc a)
| Empty
deriving (Int -> Doc a -> String -> String
[Doc a] -> String -> String
Doc a -> String
(Int -> Doc a -> String -> String)
-> (Doc a -> String)
-> ([Doc a] -> String -> String)
-> Show (Doc a)
forall a. Show a => Int -> Doc a -> String -> String
forall a. Show a => [Doc a] -> String -> String
forall a. Show a => Doc a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Doc a] -> String -> String
$cshowList :: forall a. Show a => [Doc a] -> String -> String
show :: Doc a -> String
$cshow :: forall a. Show a => Doc a -> String
showsPrec :: Int -> Doc a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Doc a -> String -> String
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
readListPrec :: ReadPrec [Doc a]
$creadListPrec :: forall a. Read a => ReadPrec [Doc a]
readPrec :: ReadPrec (Doc a)
$creadPrec :: forall a. Read a => ReadPrec (Doc a)
readList :: ReadS [Doc a]
$creadList :: forall a. Read a => ReadS [Doc a]
readsPrec :: Int -> ReadS (Doc a)
$creadsPrec :: forall a. Read a => Int -> ReadS (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
/= :: Doc a -> Doc a -> Bool
$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
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
min :: Doc a -> Doc a -> Doc a
$cmin :: forall a. Ord a => Doc a -> Doc a -> Doc a
max :: Doc a -> Doc a -> Doc a
$cmax :: forall a. Ord a => Doc a -> Doc a -> Doc a
>= :: 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
$c< :: forall a. Ord a => Doc a -> Doc a -> Bool
compare :: Doc a -> Doc a -> Ordering
$ccompare :: forall a. Ord a => Doc a -> Doc a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Doc a)
Ord, a -> Doc b -> Doc a
(a -> b) -> Doc a -> Doc b
(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
<$ :: a -> Doc b -> Doc a
$c<$ :: forall a b. a -> Doc b -> Doc a
fmap :: (a -> b) -> Doc a -> Doc b
$cfmap :: forall a b. (a -> b) -> Doc a -> Doc b
Functor, Doc a -> Bool
(a -> m) -> Doc a -> m
(a -> b -> b) -> b -> Doc a -> b
(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
product :: Doc a -> a
$cproduct :: forall a. Num a => Doc a -> a
sum :: Doc a -> a
$csum :: forall a. Num a => Doc a -> a
minimum :: Doc a -> a
$cminimum :: forall a. Ord a => Doc a -> a
maximum :: Doc a -> a
$cmaximum :: forall a. Ord a => Doc a -> a
elem :: a -> Doc a -> Bool
$celem :: forall a. Eq a => a -> Doc a -> Bool
length :: Doc a -> Int
$clength :: forall a. Doc a -> Int
null :: Doc a -> Bool
$cnull :: forall a. Doc a -> Bool
toList :: Doc a -> [a]
$ctoList :: forall a. Doc a -> [a]
foldl1 :: (a -> a -> a) -> Doc a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Doc a -> a
foldr1 :: (a -> a -> a) -> Doc a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Doc a -> a
foldl' :: (b -> a -> b) -> b -> Doc a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Doc a -> b
foldl :: (b -> a -> b) -> b -> Doc a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Doc a -> b
foldr' :: (a -> b -> b) -> b -> Doc a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Doc a -> b
foldr :: (a -> b -> b) -> b -> Doc a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Doc a -> b
foldMap' :: (a -> m) -> Doc a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Doc a -> m
foldMap :: (a -> m) -> Doc a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Doc a -> m
fold :: Doc m -> m
$cfold :: forall m. Monoid m => Doc m -> m
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
(a -> f b) -> Doc a -> f (Doc b)
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)
sequence :: Doc (m a) -> m (Doc a)
$csequence :: forall (m :: * -> *) a. Monad m => Doc (m a) -> m (Doc a)
mapM :: (a -> m b) -> Doc a -> m (Doc b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Doc a -> m (Doc b)
sequenceA :: Doc (f a) -> f (Doc a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Doc (f a) -> f (Doc a)
traverse :: (a -> f b) -> Doc a -> f (Doc b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Doc a -> f (Doc b)
$cp2Traversable :: Foldable Doc
$cp1Traversable :: Functor Doc
Traversable,
Typeable (Doc a)
Constr
DataType
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 d. Data d => c (t d)) -> Maybe (c (Doc a))
(forall b. Data b => b -> b) -> Doc a -> Doc a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doc a -> c (Doc a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (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))
$cEmpty :: Constr
$cConcat :: Constr
$cBlankLines :: Constr
$cNewLine :: Constr
$cCarriageReturn :: Constr
$cAfterBreak :: Constr
$cBreakingSpace :: Constr
$cFlush :: Constr
$cBeforeNonBlank :: Constr
$cPrefixed :: Constr
$cVFill :: Constr
$cBlock :: Constr
$cText :: Constr
$tDoc :: DataType
gmapMo :: (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)
gmapMp :: (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)
gmapM :: (forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
gmapQi :: Int -> (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
gmapQ :: (forall d. Data d => d -> u) -> Doc a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Doc a -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
gmapT :: (forall b. Data b => b -> b) -> Doc a -> Doc a
$cgmapT :: forall a. Data a => (forall b. Data b => b -> b) -> Doc a -> Doc a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> 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))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Doc a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Doc a))
dataTypeOf :: Doc a -> DataType
$cdataTypeOf :: forall a. Data a => Doc a -> DataType
toConstr :: Doc a -> Constr
$ctoConstr :: forall a. Data a => Doc a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> 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)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doc a -> 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)
$cp1Data :: forall a. Data a => Typeable (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
$cto :: forall a x. Rep (Doc a) x -> Doc a
$cfrom :: forall a x. Doc a -> Rep (Doc a) x
Generic)
instance Semigroup (Doc a) where
x :: Doc a
x <> :: Doc a -> Doc a -> Doc a
<> Empty = Doc a
x
Empty <> x :: Doc a
x = Doc a
x
x :: Doc a
x <> y :: 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
unfoldD :: Doc a -> [Doc a]
unfoldD :: Doc a -> [Doc a]
unfoldD Empty = []
unfoldD (Concat x :: Doc a
x@Concat{} y :: 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 x :: Doc a
x y :: 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 x :: Doc a
x = [Doc a
x]
isEmpty :: Doc a -> Bool
isEmpty :: Doc a -> Bool
isEmpty Empty = Bool
True
isEmpty _ = Bool
False
empty :: Doc a
empty :: Doc a
empty = Doc a
forall a. Monoid a => a
mempty
hcat :: [Doc a] -> Doc a
hcat :: [Doc a] -> Doc a
hcat = [Doc a] -> Doc a
forall a. Monoid a => [a] -> a
mconcat
infixr 6 <+>
(<+>) :: Doc a -> Doc a -> Doc a
<+> :: Doc a -> Doc a -> Doc a
(<+>) x :: Doc a
x y :: 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
hsep :: [Doc a] -> Doc a
hsep :: [Doc a] -> Doc a
hsep = (Doc a -> Doc a -> Doc a) -> Doc a -> [Doc a] -> Doc a
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 $$
($$) :: Doc a -> Doc a -> Doc a
$$ :: Doc a -> Doc a -> Doc a
($$) x :: Doc a
x y :: 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 $+$
($+$) :: Doc a -> Doc a -> Doc a
$+$ :: Doc a -> Doc a -> Doc a
($+$) x :: Doc a
x y :: 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
vcat :: [Doc a] -> Doc a
vcat :: [Doc a] -> Doc a
vcat = (Doc a -> Doc a -> Doc a) -> Doc a -> [Doc a] -> Doc a
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
vsep :: [Doc a] -> Doc a
vsep :: [Doc a] -> Doc a
vsep = (Doc a -> Doc a -> Doc a) -> Doc a -> [Doc a] -> Doc a
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
nestle :: Doc a -> Doc a
nestle :: Doc a -> Doc a
nestle d :: Doc a
d =
case Doc a
d of
BlankLines _ -> Doc a
forall a. Doc a
Empty
NewLine -> Doc a
forall a. Doc a
Empty
Concat (Concat x :: Doc a
x y :: Doc a
y) z :: 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{} x :: Doc a
x -> Doc a -> Doc a
forall a. Doc a -> Doc a
nestle Doc a
x
Concat NewLine x :: Doc a
x -> Doc a -> Doc a
forall a. Doc a -> Doc a
nestle Doc a
x
_ -> Doc a
d
chomp :: Doc a -> Doc a
chomp :: Doc a -> Doc a
chomp d :: Doc a
d =
case Doc a
d of
BlankLines _ -> Doc a
forall a. Doc a
Empty
NewLine -> Doc a
forall a. Doc a
Empty
CarriageReturn -> Doc a
forall a. Doc a
Empty
BreakingSpace -> Doc a
forall a. Doc a
Empty
Prefixed s :: Text
s d' :: 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 x :: Doc a
x y :: Doc a
y) z :: 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 x :: Doc a
x y :: Doc a
y ->
case Doc a -> Doc a
forall a. Doc a -> Doc a
chomp Doc a
y of
Empty -> Doc a -> Doc a
forall a. Doc a -> Doc a
chomp Doc a
x
z :: Doc a
z -> Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
z
_ -> Doc a
d
type DocState a = State (RenderState a) ()
data RenderState a = RenderState{
RenderState a -> [a]
output :: [a]
, RenderState a -> Text
prefix :: Text
, RenderState a -> Bool
usePrefix :: Bool
, RenderState a -> Maybe Int
lineLength :: Maybe Int
, RenderState a -> Int
column :: Int
, RenderState a -> Int
newlines :: Int
}
newline :: HasChars a => DocState a
newline :: 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
== 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
$ \st :: RenderState a
st -> RenderState a
st{ output :: [a]
output = a
pref a -> [a] -> [a]
forall a. a -> [a] -> [a]
: RenderState a -> [a]
forall a. RenderState a -> [a]
output RenderState a
st
, column :: Int
column = RenderState a -> Int
forall a. RenderState a -> Int
column RenderState a
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. HasChars a => a -> Int
realLength a
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
$ \st :: RenderState a
st -> RenderState a
st { output :: [a]
output = "\n" a -> [a] -> [a]
forall a. a -> [a] -> [a]
: RenderState a -> [a]
forall a. RenderState a -> [a]
output RenderState a
st
, column :: Int
column = 0
, newlines :: Int
newlines = RenderState a -> Int
forall a. RenderState a -> Int
newlines RenderState a
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
}
outp :: HasChars a => Int -> a -> DocState a
outp :: Int -> a -> DocState a
outp off :: Int
off s :: a
s = do
RenderState a
st' <- StateT (RenderState a) Identity (RenderState a)
forall s (m :: * -> *). MonadState s m => m s
get
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
$ 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
== 0 Bool -> Bool -> Bool
&& RenderState a -> Bool
forall a. RenderState a -> Bool
usePrefix RenderState a
st' Bool -> Bool -> Bool
&& Bool -> Bool
not (a -> Bool
forall a. HasChars a => a -> Bool
isNull a
pref)) (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
$ \st :: RenderState a
st -> RenderState a
st{ output :: [a]
output = a
pref a -> [a] -> [a]
forall a. a -> [a] -> [a]
: RenderState a -> [a]
forall a. RenderState a -> [a]
output RenderState a
st
, column :: Int
column = RenderState a -> Int
forall a. RenderState a -> Int
column RenderState a
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. HasChars a => a -> Int
realLength a
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
$ \st :: RenderState a
st -> RenderState a
st{ output :: [a]
output = a
s a -> [a] -> [a]
forall a. a -> [a] -> [a]
: RenderState a -> [a]
forall a. RenderState a -> [a]
output RenderState a
st
, column :: Int
column = RenderState a -> Int
forall a. RenderState a -> Int
column RenderState a
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off
, newlines :: Int
newlines = 0 }
render :: HasChars a => Maybe Int -> Doc a -> a
render :: Maybe Int -> Doc a -> a
render linelen :: Maybe Int
linelen doc :: Doc a
doc = [a] -> a
forall a. Monoid a => [a] -> a
mconcat ([a] -> a) -> (RenderState a -> [a]) -> RenderState a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> (RenderState a -> [a]) -> RenderState a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderState a -> [a]
forall a. RenderState a -> [a]
output (RenderState a -> a) -> RenderState a -> 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 :: forall a.
[a] -> Text -> Bool -> Maybe Int -> Int -> Int -> RenderState a
RenderState{
output :: [a]
output = [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 = 0
, newlines :: Int
newlines = 2 }
renderDoc :: HasChars a => Doc a -> DocState a
renderDoc :: Doc a -> DocState a
renderDoc = [Doc a] -> DocState a
forall a. HasChars a => [Doc a] -> DocState a
renderList ([Doc a] -> DocState a)
-> (Doc a -> [Doc a]) -> Doc a -> DocState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize ([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
normalize :: HasChars a => [Doc a] -> [Doc a]
normalize :: [Doc a] -> [Doc a]
normalize [] = []
normalize (Concat{} : xs :: [Doc a]
xs) = [Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize [Doc a]
xs
normalize (Empty : xs :: [Doc a]
xs) = [Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize [Doc a]
xs
normalize [NewLine] = [Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize [Doc a
forall a. Doc a
CarriageReturn]
normalize [BlankLines _] = [Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize [Doc a
forall a. Doc a
CarriageReturn]
normalize [BreakingSpace] = []
normalize (BlankLines m :: Int
m : BlankLines n :: Int
n : xs :: [Doc a]
xs) =
[Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize (Int -> Doc a
forall a. Int -> Doc a
BlankLines (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
m Int
n) Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: [Doc a]
xs)
normalize (BlankLines num :: Int
num : BreakingSpace : xs :: [Doc a]
xs) =
[Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize (Int -> Doc a
forall a. Int -> Doc a
BlankLines Int
num Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: [Doc a]
xs)
normalize (BlankLines m :: Int
m : CarriageReturn : xs :: [Doc a]
xs) = [Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize (Int -> Doc a
forall a. Int -> Doc a
BlankLines Int
m Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: [Doc a]
xs)
normalize (BlankLines m :: Int
m : NewLine : xs :: [Doc a]
xs) = [Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize (Int -> Doc a
forall a. Int -> Doc a
BlankLines Int
m Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: [Doc a]
xs)
normalize (NewLine : BlankLines m :: Int
m : xs :: [Doc a]
xs) = [Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize (Int -> Doc a
forall a. Int -> Doc a
BlankLines Int
m Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: [Doc a]
xs)
normalize (NewLine : BreakingSpace : xs :: [Doc a]
xs) = [Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize (Doc a
forall a. Doc a
NewLine Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: [Doc a]
xs)
normalize (NewLine : CarriageReturn : xs :: [Doc a]
xs) = [Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize (Doc a
forall a. Doc a
NewLine Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: [Doc a]
xs)
normalize (CarriageReturn : CarriageReturn : xs :: [Doc a]
xs) =
[Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize (Doc a
forall a. Doc a
CarriageReturn Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: [Doc a]
xs)
normalize (CarriageReturn : NewLine : xs :: [Doc a]
xs) = [Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize (Doc a
forall a. Doc a
NewLine Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: [Doc a]
xs)
normalize (CarriageReturn : BlankLines m :: Int
m : xs :: [Doc a]
xs) = [Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize (Int -> Doc a
forall a. Int -> Doc a
BlankLines Int
m Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: [Doc a]
xs)
normalize (CarriageReturn : BreakingSpace : xs :: [Doc a]
xs) =
[Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize (Doc a
forall a. Doc a
CarriageReturn Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: [Doc a]
xs)
normalize (BreakingSpace : CarriageReturn : xs :: [Doc a]
xs) =
[Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize (Doc a
forall a. Doc a
CarriageReturnDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
xs)
normalize (BreakingSpace : NewLine : xs :: [Doc a]
xs) = [Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize (Doc a
forall a. Doc a
NewLineDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
xs)
normalize (BreakingSpace : BlankLines n :: Int
n : xs :: [Doc a]
xs) = [Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize (Int -> Doc a
forall a. Int -> Doc a
BlankLines Int
nDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
xs)
normalize (BreakingSpace : BreakingSpace : xs :: [Doc a]
xs) = [Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize (Doc a
forall a. Doc a
BreakingSpaceDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
xs)
normalize (x :: Doc a
x:xs :: [Doc a]
xs) = Doc a
x Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: [Doc a] -> [Doc a]
forall a. HasChars a => [Doc a] -> [Doc a]
normalize [Doc a]
xs
mergeBlocks :: HasChars a => Int -> (Int, [a]) -> (Int, [a]) -> (Int, [a])
mergeBlocks :: Int -> (Int, [a]) -> (Int, [a]) -> (Int, [a])
mergeBlocks h :: Int
h (w1 :: Int
w1,lns1 :: [a]
lns1) (w2 :: Int
w2,lns2 :: [a]
lns2) =
(Int
w, (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\l1 :: a
l1 l2 :: 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 (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
len2 :: Int
len2 = [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 n :: Int
n s :: 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) ' '
renderList :: HasChars a => [Doc a] -> DocState a
renderList :: [Doc a] -> DocState a
renderList [] = () -> DocState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
renderList (Text off :: Int
off s :: a
s : xs :: [Doc a]
xs) = do
Int -> a -> DocState a
forall a. HasChars a => Int -> a -> DocState a
outp Int
off a
s
[Doc a] -> DocState a
forall a. HasChars a => [Doc a] -> DocState a
renderList [Doc a]
xs
renderList (Prefixed pref :: Text
pref d :: Doc a
d : xs :: [Doc 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 -> DocState a
forall s (m :: * -> *). MonadState s m => s -> m ()
put RenderState a
st{ prefix :: Text
prefix = RenderState a -> Text
forall a. RenderState a -> Text
prefix RenderState a
st Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pref }
Doc a -> DocState a
forall a. HasChars a => Doc a -> DocState a
renderDoc Doc a
d
(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
$ \s :: RenderState a
s -> RenderState a
s{ prefix :: Text
prefix = Text
oldPref }
[Doc a] -> DocState a
forall a. HasChars a => [Doc a] -> DocState a
renderList [Doc a]
xs
renderList (Flush d :: Doc a
d : xs :: [Doc 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 -> DocState a
forall s (m :: * -> *). MonadState s m => s -> m ()
put RenderState a
st{ usePrefix :: Bool
usePrefix = Bool
False }
Doc a -> DocState a
forall a. HasChars a => Doc a -> DocState a
renderDoc Doc a
d
(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
$ \s :: RenderState a
s -> RenderState a
s{ usePrefix :: Bool
usePrefix = Bool
oldUsePrefix }
[Doc a] -> DocState a
forall a. HasChars a => [Doc a] -> DocState a
renderList [Doc a]
xs
renderList (BeforeNonBlank d :: Doc a
d : xs :: [Doc a]
xs) =
case [Doc a]
xs of
(x :: Doc a
x:_) | Doc a -> Bool
forall a. HasChars a => Doc a -> Bool
startsBlank Doc a
x -> [Doc a] -> DocState a
forall a. HasChars a => [Doc a] -> DocState a
renderList [Doc a]
xs
| Bool
otherwise -> Doc a -> DocState a
forall a. HasChars a => Doc a -> DocState a
renderDoc Doc a
d DocState a -> DocState a -> DocState a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Doc a] -> DocState a
forall a. HasChars a => [Doc a] -> DocState a
renderList [Doc a]
xs
[] -> [Doc a] -> DocState a
forall a. HasChars a => [Doc a] -> DocState a
renderList [Doc a]
xs
renderList (BlankLines num :: Int
num : xs :: [Doc a]
xs) = do
RenderState a
st <- StateT (RenderState a) Identity (RenderState a)
forall s (m :: * -> *). MonadState s m => m s
get
case RenderState a -> [a]
forall a. RenderState a -> [a]
output RenderState a
st of
_ | RenderState a -> Int
forall a. RenderState a -> Int
newlines RenderState a
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
num -> () -> DocState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise -> Int -> DocState a -> DocState a
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (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) DocState a
forall a. HasChars a => DocState a
newline
[Doc a] -> DocState a
forall a. HasChars a => [Doc a] -> DocState a
renderList [Doc a]
xs
renderList (CarriageReturn : xs :: [Doc 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
> 0
then [Doc a] -> DocState a
forall a. HasChars a => [Doc a] -> DocState a
renderList [Doc a]
xs
else do
DocState a
forall a. HasChars a => DocState a
newline
[Doc a] -> DocState a
forall a. HasChars a => [Doc a] -> DocState a
renderList [Doc a]
xs
renderList (NewLine : xs :: [Doc a]
xs) = do
DocState a
forall a. HasChars a => DocState a
newline
[Doc a] -> DocState a
forall a. HasChars a => [Doc a] -> DocState a
renderList [Doc a]
xs
renderList (BreakingSpace : xs :: [Doc a]
xs) = do
let isBreakingSpace :: Doc a -> Bool
isBreakingSpace BreakingSpace = Bool
True
isBreakingSpace _ = Bool
False
let xs' :: [Doc a]
xs' = (Doc a -> Bool) -> [Doc a] -> [Doc a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Doc a -> Bool
forall a. Doc a -> Bool
isBreakingSpace [Doc a]
xs
let next :: [Doc a]
next = (Doc a -> Bool) -> [Doc a] -> [Doc a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Doc a -> Bool) -> Doc a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> Bool
forall a. HasChars a => Doc a -> Bool
isBlank) [Doc a]
xs'
RenderState a
st <- StateT (RenderState a) Identity (RenderState a)
forall s (m :: * -> *). MonadState s m => m s
get
let off :: Int
off = (Doc a -> Int -> Int) -> Int -> [Doc a] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> (Doc a -> Int) -> Doc a -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc a -> Int
forall a. Doc a -> Int
offsetOf) 0 [Doc a]
next
case RenderState a -> Maybe Int
forall a. RenderState a -> Maybe Int
lineLength RenderState a
st of
Just l :: Int
l | RenderState a -> Int
forall a. RenderState a -> Int
column RenderState a
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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 -> DocState a
forall a. HasChars a => DocState a
newline
_ -> 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. Ord a => a -> a -> Bool
> 0) (DocState a -> DocState a) -> DocState a -> DocState a
forall a b. (a -> b) -> a -> b
$ Int -> a -> DocState a
forall a. HasChars a => Int -> a -> DocState a
outp 1 " "
[Doc a] -> DocState a
forall a. HasChars a => [Doc a] -> DocState a
renderList [Doc a]
xs'
renderList (AfterBreak t :: Text
t : xs :: [Doc 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
> 0
then [Doc a] -> DocState a
forall a. HasChars a => [Doc a] -> DocState a
renderList (String -> Doc a
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
t) Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
: [Doc a]
xs)
else [Doc a] -> DocState a
forall a. HasChars a => [Doc a] -> DocState a
renderList [Doc a]
xs
renderList (b :: Doc a
b : xs :: [Doc a]
xs) | Doc a -> Bool
forall a. Doc a -> Bool
isBlock Doc a
b = do
let (bs :: [Doc a]
bs, rest :: [Doc a]
rest) = (Doc a -> Bool) -> [Doc a] -> ([Doc a], [Doc a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Doc a -> Bool
forall a. Doc a -> Bool
isBlock [Doc a]
xs
let heightOf :: Doc a -> Int
heightOf (Block _ ls :: [a]
ls) = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls
heightOf _ = 1
let maxheight :: Int
maxheight = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Doc a -> Int) -> [Doc a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Doc a -> Int
forall a. Doc a -> Int
heightOf (Doc a
bDoc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:[Doc a]
bs)
let toBlockSpec :: Doc a -> (Int, [a])
toBlockSpec (Block w :: Int
w ls :: [a]
ls) = (Int
w, [a]
ls)
toBlockSpec (VFill w :: Int
w t :: a
t) = (Int
w, 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 _ = (0, [])
let (_, lns' :: [a]
lns') = ((Int, [a]) -> (Int, [a]) -> (Int, [a]))
-> (Int, [a]) -> [(Int, [a])] -> (Int, [a])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Int -> (Int, [a]) -> (Int, [a]) -> (Int, [a])
forall a.
HasChars a =>
Int -> (Int, [a]) -> (Int, [a]) -> (Int, [a])
mergeBlocks Int
maxheight) (Doc a -> (Int, [a])
forall a. Doc a -> (Int, [a])
toBlockSpec Doc a
b)
((Doc a -> (Int, [a])) -> [Doc a] -> [(Int, [a])]
forall a b. (a -> b) -> [a] -> [b]
map Doc a -> (Int, [a])
forall a. Doc a -> (Int, [a])
toBlockSpec [Doc a]
bs)
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
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
n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> (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
$ \s :: RenderState a
s -> RenderState a
s{ prefix :: Text
prefix = Text
oldPref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
n " " }
_ -> () -> DocState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[Doc a] -> DocState a
forall a. HasChars a => [Doc a] -> DocState a
renderList ([Doc a] -> DocState a) -> [Doc a] -> DocState 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
CarriageReturn ((a -> Doc a) -> [a] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc a
forall a. HasChars a => a -> Doc a
literal [a]
lns')
(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
$ \s :: RenderState a
s -> RenderState a
s{ prefix :: Text
prefix = Text
oldPref }
[Doc a] -> DocState a
forall a. HasChars a => [Doc a] -> DocState a
renderList [Doc a]
rest
renderList (x :: Doc a
x:_) = String -> DocState a
forall a. HasCallStack => String -> a
error (String -> DocState a) -> String -> DocState a
forall a b. (a -> b) -> a -> b
$ "renderList encountered " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc a -> String
forall a. Show a => a -> String
show Doc a
x
isBlank :: HasChars a => Doc a -> Bool
isBlank :: Doc a -> Bool
isBlank (Text _ t :: a
t) = a -> Bool
forall a. HasChars a => a -> Bool
isAllSpace a
t
isBlank (Block _ ls :: [a]
ls) = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all a -> Bool
forall a. HasChars a => a -> Bool
isAllSpace [a]
ls
isBlank (VFill _ t :: a
t) = a -> Bool
forall a. HasChars a => a -> Bool
isAllSpace a
t
isBlank (Prefixed _ x :: Doc a
x) = Doc a -> Bool
forall a. HasChars a => Doc a -> Bool
isBlank Doc a
x
isBlank (BeforeNonBlank x :: Doc a
x) = Doc a -> Bool
forall a. HasChars a => Doc a -> Bool
isBlank Doc a
x
isBlank (Flush x :: Doc a
x) = Doc a -> Bool
forall a. HasChars a => Doc a -> Bool
isBlank Doc a
x
isBlank BreakingSpace = Bool
True
isBlank (AfterBreak t :: Text
t) = Text -> Bool
forall a. HasChars a => a -> Bool
isAllSpace Text
t
isBlank CarriageReturn = Bool
True
isBlank NewLine = Bool
True
isBlank (BlankLines _) = Bool
True
isBlank (Concat x :: Doc a
x y :: Doc a
y) = Doc a -> Bool
forall a. HasChars a => Doc a -> Bool
isBlank Doc a
x Bool -> Bool -> Bool
&& Doc a -> Bool
forall a. HasChars a => Doc a -> Bool
isBlank Doc a
y
isBlank Empty = Bool
True
startsBlank :: HasChars a => Doc a -> Bool
startsBlank :: Doc a -> Bool
startsBlank (Text _ t :: a
t) = (Char -> Bool -> Bool) -> Bool -> a -> Bool
forall a b. HasChars a => (Char -> b -> b) -> b -> a -> b
foldrChar (Bool -> Bool -> Bool
forall a b. a -> b -> a
const (Bool -> Bool -> Bool) -> (Char -> Bool) -> Char -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) Bool
False a
t
startsBlank x :: Doc a
x = Doc a -> Bool
forall a. HasChars a => Doc a -> Bool
isBlank Doc a
x
isAllSpace :: HasChars a => a -> Bool
isAllSpace :: a -> Bool
isAllSpace = (Char -> Bool -> Bool) -> Bool -> a -> Bool
forall a b. HasChars a => (Char -> b -> b) -> b -> a -> b
foldrChar (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> (Char -> Bool) -> Char -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) Bool
False
isBlock :: Doc a -> Bool
isBlock :: Doc a -> Bool
isBlock Block{} = Bool
True
isBlock VFill{} = Bool
True
isBlock _ = Bool
False
offsetOf :: Doc a -> Int
offsetOf :: Doc a -> Int
offsetOf (Text o :: Int
o _) = Int
o
offsetOf (Block w :: Int
w _) = Int
w
offsetOf (VFill w :: Int
w _) = Int
w
offsetOf BreakingSpace = 1
offsetOf _ = 0
literal :: HasChars a => a -> Doc a
literal :: a -> Doc a
literal x :: 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 (\s :: a
s -> if a -> Bool
forall a. HasChars a => a -> Bool
isNull a
s
then Doc a
forall a. Doc a
Empty
else Int -> a -> Doc a
forall a. Int -> a -> Doc a
Text (a -> Int
forall a. HasChars a => a -> Int
realLength a
s) 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
text :: HasChars a => String -> Doc a
text :: 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
char :: HasChars a => Char -> Doc a
char :: Char -> Doc a
char c :: 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
$ String -> String
forall a. IsString a => String -> a
fromString [Char
c]
space :: Doc a
space :: Doc a
space = Doc a
forall a. Doc a
BreakingSpace
cr :: Doc a
cr :: Doc a
cr = Doc a
forall a. Doc a
CarriageReturn
blankline :: Doc a
blankline :: Doc a
blankline = Int -> Doc a
forall a. Int -> Doc a
BlankLines 1
blanklines :: Int -> Doc a
blanklines :: Int -> Doc a
blanklines = Int -> Doc a
forall a. Int -> Doc a
BlankLines
prefixed :: IsString a => String -> Doc a -> Doc a
prefixed :: String -> Doc a -> Doc a
prefixed pref :: String
pref doc :: 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
flush :: Doc a -> Doc a
flush :: Doc a -> Doc a
flush doc :: 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
nest :: IsString a => Int -> Doc a -> Doc a
nest :: Int -> Doc a -> Doc a
nest ind :: 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 ' ')
hang :: IsString a => Int -> Doc a -> Doc a -> Doc a
hang :: Int -> Doc a -> Doc a -> Doc a
hang ind :: Int
ind start :: Doc a
start doc :: 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 :: Doc a -> Doc a
beforeNonBlank :: Doc a -> Doc a
beforeNonBlank = Doc a -> Doc a
forall a. Doc a -> Doc a
BeforeNonBlank
nowrap :: IsString a => Doc a -> Doc a
nowrap :: 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 BreakingSpace = Int -> a -> Doc a
forall a. Int -> a -> Doc a
Text 1 (a -> Doc a) -> a -> Doc a
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. IsString a => String -> a
fromString " "
replaceSpace x :: Doc a
x = Doc a
x
afterBreak :: Text -> Doc a
afterBreak :: Text -> Doc a
afterBreak = Text -> Doc a
forall a. Text -> Doc a
AfterBreak
offset :: (IsString a, HasChars a) => Doc a -> Int
offset :: Doc a -> Int
offset (Text n :: Int
n _) = Int
n
offset (Block n :: Int
n _) = Int
n
offset (VFill n :: Int
n _) = Int
n
offset Empty = 0
offset CarriageReturn = 0
offset NewLine = 0
offset (BlankLines _) = 0
offset d :: Doc a
d = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map a -> Int
forall a. HasChars a => a -> Int
realLength (a -> [a]
forall a. HasChars a => a -> [a]
splitLines (Maybe Int -> Doc a -> a
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc a
d)))
minOffset :: HasChars a => Doc a -> Int
minOffset :: Doc a -> Int
minOffset (Text n :: Int
n _) = Int
n
minOffset (Block n :: Int
n _) = Int
n
minOffset (VFill n :: Int
n _) = Int
n
minOffset Empty = 0
minOffset CarriageReturn = 0
minOffset NewLine = 0
minOffset (BlankLines _) = 0
minOffset d :: Doc a
d = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map a -> Int
forall a. HasChars a => a -> Int
realLength (a -> [a]
forall a. HasChars a => a -> [a]
splitLines (Maybe Int -> Doc a -> a
forall a. HasChars a => Maybe Int -> Doc a -> a
render (Int -> Maybe Int
forall a. a -> Maybe a
Just 0) Doc a
d)))
updateColumn :: HasChars a => Doc a -> Int -> Int
updateColumn :: Doc a -> Int -> Int
updateColumn (Text n :: Int
n _) = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
updateColumn (Block n :: Int
n _) = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
updateColumn (VFill n :: Int
n _) = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
updateColumn Empty = Int -> Int -> Int
forall a b. a -> b -> a
const 0
updateColumn CarriageReturn = Int -> Int -> Int
forall a b. a -> b -> a
const 0
updateColumn NewLine = Int -> Int -> Int
forall a b. a -> b -> a
const 0
updateColumn (BlankLines _) = Int -> Int -> Int
forall a b. a -> b -> a
const 0
updateColumn d :: Doc a
d =
case (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map a -> Int
forall a. HasChars a => a -> Int
realLength (a -> [a]
forall a. HasChars a => a -> [a]
splitLines (Maybe Int -> Doc a -> a
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc a
d)) of
[] -> Int -> Int
forall a. a -> a
id
[n :: Int
n] -> (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
xs :: [Int]
xs -> Int -> Int -> Int
forall a b. a -> b -> a
const ([Int] -> Int
forall a. [a] -> a
last [Int]
xs)
lblock :: HasChars a => Int -> Doc a -> Doc a
lblock :: Int -> Doc a -> Doc a
lblock = (a -> a) -> Int -> Doc a -> Doc a
forall a. HasChars a => (a -> a) -> Int -> Doc a -> Doc a
block a -> a
forall a. a -> a
id
rblock :: HasChars a => Int -> Doc a -> Doc a
rblock :: Int -> Doc a -> Doc a
rblock w :: Int
w = (a -> a) -> Int -> Doc a -> Doc a
forall a. HasChars a => (a -> a) -> Int -> Doc a -> Doc a
block (\s :: a
s -> Int -> Char -> a
forall a. HasChars a => Int -> Char -> a
replicateChar (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. HasChars a => a -> Int
realLength a
s) ' ' a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s) Int
w
cblock :: HasChars a => Int -> Doc a -> Doc a
cblock :: Int -> Doc a -> Doc a
cblock w :: Int
w = (a -> a) -> Int -> Doc a -> Doc a
forall a. HasChars a => (a -> a) -> Int -> Doc a -> Doc a
block (\s :: a
s -> Int -> Char -> a
forall a. HasChars a => Int -> Char -> a
replicateChar ((Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. HasChars a => a -> Int
realLength a
s) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2) ' ' a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s) Int
w
height :: HasChars a => Doc a -> Int
height :: Doc a -> Int
height = [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 => (a -> a) -> Int -> Doc a -> Doc a
block :: (a -> a) -> Int -> Doc a -> Doc a
block filler :: a -> a
filler width :: Int
width d :: Doc a
d
| Int
width Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 Bool -> Bool -> Bool
&& Bool -> Bool
not (Doc a -> Bool
forall a. Doc a -> Bool
isEmpty Doc a
d) = (a -> a) -> Int -> Doc a -> Doc a
forall a. HasChars a => (a -> a) -> Int -> Doc a -> Doc a
block a -> a
filler 1 Doc a
d
| Bool
otherwise = Int -> [a] -> Doc a
forall a. Int -> [a] -> Doc a
Block Int
width [a]
ls
where
ls :: [a]
ls = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
filler ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> a -> [a]
forall a. HasChars a => Int -> a -> [a]
chop Int
width (a -> [a]) -> a -> [a]
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc a -> a
forall a. HasChars a => Maybe Int -> Doc a -> a
render (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
width) Doc a
d
vfill :: HasChars a => a -> Doc a
vfill :: a -> Doc a
vfill t :: 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 :: Int -> a -> [a]
chop n :: 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 xs :: [(a, b)]
xs = case [(a, b)] -> Maybe (a, b)
forall a. [a] -> Maybe a
lastMay [(a, b)]
xs of
Just (0, _) -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a]
initSafe [(a, b)]
xs
_ -> [(a, b)]
xs
addRealLength :: b -> (Int, b)
addRealLength l :: b
l = (b -> Int
forall a. HasChars a => a -> Int
realLength b
l, b
l)
chopLine :: (Int, a) -> [a]
chopLine (len :: Int
len, l :: 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
foldrChar
(\c :: Char
c ls :: [(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 1 Char
c
in case [(Int, a)]
ls of
(len' :: Int
len', l' :: a
l'):rest :: [(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
inside :: Doc a -> Doc a -> Doc a -> Doc a
inside :: Doc a -> Doc a -> Doc a -> Doc a
inside start :: Doc a
start end :: Doc a
end contents :: 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
braces :: HasChars a => Doc a -> Doc a
braces :: 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 -> Doc a
forall a. HasChars a => Char -> Doc a
char '}')
brackets :: HasChars a => Doc a -> Doc a
brackets :: 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 -> Doc a
forall a. HasChars a => Char -> Doc a
char ']')
parens :: HasChars a => Doc a -> Doc a
parens :: 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 -> Doc a
forall a. HasChars a => Char -> Doc a
char ')')
quotes :: HasChars a => Doc a -> Doc a
quotes :: 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 -> Doc a
forall a. HasChars a => Char -> Doc a
char '\'')
doubleQuotes :: HasChars a => Doc a -> Doc a
doubleQuotes :: 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 -> Doc a
forall a. HasChars a => Char -> Doc a
char '"')
charWidth :: Char -> Int
charWidth :: Char -> Int
charWidth c :: Char
c =
case Char
c of
_ | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< '\x0300' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x0300' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x036F' -> 0
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x0370' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x10FC' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x1100' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x115F' -> 2
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x1160' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x11A2' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x11A3' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x11A7' -> 2
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x11A8' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x11F9' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x11FA' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x11FF' -> 2
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x1200' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x2328' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x2329' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x232A' -> 2
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x232B' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x2E31' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x2E80' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x303E' -> 2
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\x303F' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x3041' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x3247' -> 2
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x3248' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x324F' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x3250' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x4DBF' -> 2
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x4DC0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x4DFF' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x4E00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xA4C6' -> 2
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xA4D0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xA95F' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xA960' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xA97C' -> 2
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xA980' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xABF9' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xAC00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xD7FB' -> 2
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xD800' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xDFFF' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xE000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xF8FF' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xF900' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xFAFF' -> 2
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xFB00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xFDFD' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xFE00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xFE0F' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xFE10' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xFE19' -> 2
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xFE20' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xFE26' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xFE30' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xFE6B' -> 2
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xFE70' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xFEFF' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xFF01' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xFF60' -> 2
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xFF61' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x16A38' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x1B000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x1B001' -> 2
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x1D000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x1F1FF' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x1F200' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x1F251' -> 2
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x1F300' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x1F773' -> 1
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x20000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x3FFFD' -> 2
| Bool
otherwise -> 1
realLength :: HasChars a => a -> Int
realLength :: a -> Int
realLength s :: a
s = case (Char -> (Int, Bool) -> (Int, Bool))
-> (Int, Bool) -> a -> (Int, Bool)
forall a b. HasChars a => (Char -> b -> b) -> b -> a -> b
foldrChar Char -> (Int, Bool) -> (Int, Bool)
forall b. Char -> (Int, b) -> (Int, Bool)
go (0, Bool
False) a
s of
(n :: Int
n, True) -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
(n :: Int
n, False) -> Int
n
where
go :: Char -> (Int, b) -> (Int, Bool)
go c :: Char
c (tot :: Int
tot, _combiningChar :: b
_combiningChar) =
case Char -> Int
charWidth Char
c of
0 -> (Int
tot, Bool
True)
n :: Int
n -> (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n, Bool
False)