{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE BangPatterns #-}
{-# 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 Data.List (foldl')
import Data.Maybe (fromMaybe)
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
foldlChar :: (b -> Char -> 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
foldlChar :: (b -> Char -> b) -> b -> Text -> b
foldlChar = (b -> Char -> b) -> b -> Text -> b
forall b. (b -> Char -> b) -> b -> Text -> b
T.foldl'
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
foldlChar :: (b -> Char -> b) -> b -> String -> b
foldlChar = (b -> Char -> b) -> b -> String -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
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
foldlChar :: (b -> Char -> b) -> b -> Text -> b
foldlChar = (b -> Char -> b) -> b -> Text -> b
forall b. (b -> Char -> b) -> b -> Text -> b
TL.foldl'
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
isBreakable) [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 = (Int -> Doc a -> Int) -> Int -> [Doc a] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\tot :: Int
tot t :: Doc a
t -> Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Doc a -> Int
forall a. Doc a -> Int
offsetOf Doc a
t) 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
isBreakable :: HasChars a => Doc a -> Bool
isBreakable :: Doc a -> Bool
isBreakable BreakingSpace = Bool
True
isBreakable CarriageReturn = Bool
True
isBreakable NewLine = Bool
True
isBreakable (BlankLines _) = Bool
True
isBreakable (Concat Empty y :: Doc a
y) = Doc a -> Bool
forall a. HasChars a => Doc a -> Bool
isBreakable Doc a
y
isBreakable (Concat x :: Doc a
x _) = Doc a -> Bool
forall a. HasChars a => Doc a -> Bool
isBreakable Doc a
x
isBreakable _ = Bool
False
startsBlank' :: HasChars a => a -> Bool
startsBlank' :: a -> Bool
startsBlank' t :: 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
foldlChar Maybe Bool -> Char -> Maybe Bool
go Maybe Bool
forall a. Maybe a
Nothing a
t
where
go :: Maybe Bool -> Char -> Maybe Bool
go Nothing c :: Char
c = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Char -> Bool
isSpace Char
c)
go (Just b :: Bool
b) _ = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b
startsBlank :: HasChars a => Doc a -> Bool
startsBlank :: Doc a -> Bool
startsBlank (Text _ t :: a
t) = a -> Bool
forall a. HasChars a => a -> Bool
startsBlank' a
t
startsBlank (Block n :: Int
n ls :: [a]
ls) = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all a -> Bool
forall a. HasChars a => a -> Bool
startsBlank' [a]
ls
startsBlank (VFill n :: Int
n t :: a
t) = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& a -> Bool
forall a. HasChars a => a -> Bool
startsBlank' a
t
startsBlank (BeforeNonBlank x :: Doc a
x) = Doc a -> Bool
forall a. HasChars a => Doc a -> Bool
startsBlank Doc a
x
startsBlank (Prefixed _ x :: Doc a
x) = Doc a -> Bool
forall a. HasChars a => Doc a -> Bool
startsBlank Doc a
x
startsBlank (Flush x :: Doc a
x) = Doc a -> Bool
forall a. HasChars a => Doc a -> Bool
startsBlank Doc a
x
startsBlank BreakingSpace = Bool
True
startsBlank (AfterBreak t :: Text
t) = Doc Text -> Bool
forall a. HasChars a => Doc a -> Bool
startsBlank (Int -> Text -> Doc Text
forall a. Int -> a -> Doc a
Text 0 Text
t)
startsBlank CarriageReturn = Bool
True
startsBlank NewLine = Bool
True
startsBlank (BlankLines _) = Bool
True
startsBlank (Concat Empty y :: Doc a
y) = Doc a -> Bool
forall a. HasChars a => Doc a -> Bool
startsBlank Doc a
y
startsBlank (Concat x :: Doc a
x _) = Doc a -> Bool
forall a. HasChars a => Doc a -> Bool
startsBlank Doc a
x
startsBlank Empty = Bool
True
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 !Int
n _) !Int
k = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
updateColumn (Block !Int
n _) !Int
k = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
updateColumn (VFill !Int
n _) !Int
k = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
updateColumn Empty _ = 0
updateColumn CarriageReturn _ = 0
updateColumn NewLine _ = 0
updateColumn (BlankLines _) _ = 0
updateColumn d :: Doc a
d !Int
k =
case 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
k
[t :: a
t] -> Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. HasChars a => a -> Int
realLength a
t
ts :: [a]
ts -> a -> Int
forall a. HasChars a => a -> Int
realLength (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. [a] -> a
last [a]
ts
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 = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (Maybe Int -> Char -> Maybe Int) -> Maybe Int -> a -> Maybe Int
forall a b. HasChars a => (b -> Char -> b) -> b -> a -> b
foldlChar Maybe Int -> Char -> Maybe Int
go Maybe Int
forall a. Maybe a
Nothing a
s
where
go :: Maybe Int -> Char -> Maybe Int
go Nothing !Char
c =
case Char -> Int
charWidth Char
c of
0 -> Int -> Maybe Int
forall a. a -> Maybe a
Just 1
!Int
n -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
go (Just !Int
tot) !Char
c = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
charWidth Char
c)