{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE LambdaCase #-}
module Text.Layout.Table.Cell.Formatted
( Formatted
, plain
, formatted
, mapAffix
, cataFormatted
) where
import Data.List (foldl', mapAccumL, mapAccumR)
import Data.String
import Text.Layout.Table.Primitives.AlignInfo
import Text.Layout.Table.Cell
import Text.Layout.Table.StringBuilder
data Formatted a
= Empty
| Concat [Formatted a]
| Plain a
| Format String (Formatted a) String
deriving (Formatted a -> Formatted a -> Bool
(Formatted a -> Formatted a -> Bool)
-> (Formatted a -> Formatted a -> Bool) -> Eq (Formatted a)
forall a. Eq a => Formatted a -> Formatted a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Formatted a -> Formatted a -> Bool
$c/= :: forall a. Eq a => Formatted a -> Formatted a -> Bool
== :: Formatted a -> Formatted a -> Bool
$c== :: forall a. Eq a => Formatted a -> Formatted a -> Bool
Eq, Int -> Formatted a -> ShowS
[Formatted a] -> ShowS
Formatted a -> String
(Int -> Formatted a -> ShowS)
-> (Formatted a -> String)
-> ([Formatted a] -> ShowS)
-> Show (Formatted a)
forall a. Show a => Int -> Formatted a -> ShowS
forall a. Show a => [Formatted a] -> ShowS
forall a. Show a => Formatted a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Formatted a] -> ShowS
$cshowList :: forall a. Show a => [Formatted a] -> ShowS
show :: Formatted a -> String
$cshow :: forall a. Show a => Formatted a -> String
showsPrec :: Int -> Formatted a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Formatted a -> ShowS
Show, (forall a b. (a -> b) -> Formatted a -> Formatted b)
-> (forall a b. a -> Formatted b -> Formatted a)
-> Functor Formatted
forall a b. a -> Formatted b -> Formatted a
forall a b. (a -> b) -> Formatted a -> Formatted b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Formatted b -> Formatted a
$c<$ :: forall a b. a -> Formatted b -> Formatted a
fmap :: forall a b. (a -> b) -> Formatted a -> Formatted b
$cfmap :: forall a b. (a -> b) -> Formatted a -> Formatted b
Functor, (forall m. Monoid m => Formatted m -> m)
-> (forall m a. Monoid m => (a -> m) -> Formatted a -> m)
-> (forall m a. Monoid m => (a -> m) -> Formatted a -> m)
-> (forall a b. (a -> b -> b) -> b -> Formatted a -> b)
-> (forall a b. (a -> b -> b) -> b -> Formatted a -> b)
-> (forall b a. (b -> a -> b) -> b -> Formatted a -> b)
-> (forall b a. (b -> a -> b) -> b -> Formatted a -> b)
-> (forall a. (a -> a -> a) -> Formatted a -> a)
-> (forall a. (a -> a -> a) -> Formatted a -> a)
-> (forall a. Formatted a -> [a])
-> (forall a. Formatted a -> Bool)
-> (forall a. Formatted a -> Int)
-> (forall a. Eq a => a -> Formatted a -> Bool)
-> (forall a. Ord a => Formatted a -> a)
-> (forall a. Ord a => Formatted a -> a)
-> (forall a. Num a => Formatted a -> a)
-> (forall a. Num a => Formatted a -> a)
-> Foldable Formatted
forall a. Eq a => a -> Formatted a -> Bool
forall a. Num a => Formatted a -> a
forall a. Ord a => Formatted a -> a
forall m. Monoid m => Formatted m -> m
forall a. Formatted a -> Bool
forall a. Formatted a -> Int
forall a. Formatted a -> [a]
forall a. (a -> a -> a) -> Formatted a -> a
forall m a. Monoid m => (a -> m) -> Formatted a -> m
forall b a. (b -> a -> b) -> b -> Formatted a -> b
forall a b. (a -> b -> b) -> b -> Formatted 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 :: forall a. Num a => Formatted a -> a
$cproduct :: forall a. Num a => Formatted a -> a
sum :: forall a. Num a => Formatted a -> a
$csum :: forall a. Num a => Formatted a -> a
minimum :: forall a. Ord a => Formatted a -> a
$cminimum :: forall a. Ord a => Formatted a -> a
maximum :: forall a. Ord a => Formatted a -> a
$cmaximum :: forall a. Ord a => Formatted a -> a
elem :: forall a. Eq a => a -> Formatted a -> Bool
$celem :: forall a. Eq a => a -> Formatted a -> Bool
length :: forall a. Formatted a -> Int
$clength :: forall a. Formatted a -> Int
null :: forall a. Formatted a -> Bool
$cnull :: forall a. Formatted a -> Bool
toList :: forall a. Formatted a -> [a]
$ctoList :: forall a. Formatted a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Formatted a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Formatted a -> a
foldr1 :: forall a. (a -> a -> a) -> Formatted a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Formatted a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Formatted a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Formatted a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Formatted a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Formatted a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Formatted a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Formatted a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Formatted a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Formatted a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Formatted a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Formatted a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Formatted a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Formatted a -> m
fold :: forall m. Monoid m => Formatted m -> m
$cfold :: forall m. Monoid m => Formatted m -> m
Foldable, Functor Formatted
Foldable Formatted
Functor Formatted
-> Foldable Formatted
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Formatted a -> f (Formatted b))
-> (forall (f :: * -> *) a.
Applicative f =>
Formatted (f a) -> f (Formatted a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Formatted a -> m (Formatted b))
-> (forall (m :: * -> *) a.
Monad m =>
Formatted (m a) -> m (Formatted a))
-> Traversable Formatted
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 =>
Formatted (m a) -> m (Formatted a)
forall (f :: * -> *) a.
Applicative f =>
Formatted (f a) -> f (Formatted a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Formatted a -> m (Formatted b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Formatted a -> f (Formatted b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Formatted (m a) -> m (Formatted a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Formatted (m a) -> m (Formatted a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Formatted a -> m (Formatted b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Formatted a -> m (Formatted b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Formatted (f a) -> f (Formatted a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Formatted (f a) -> f (Formatted a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Formatted a -> f (Formatted b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Formatted a -> f (Formatted b)
Traversable)
plain :: a -> Formatted a
plain :: forall a. a -> Formatted a
plain = a -> Formatted a
forall a. a -> Formatted a
Plain
formatted
:: String
-> Formatted a
-> String
-> Formatted a
formatted :: forall a. String -> Formatted a -> String -> Formatted a
formatted = String -> Formatted a -> String -> Formatted a
forall a. String -> Formatted a -> String -> Formatted a
Format
mapAffix :: (String -> String)
-> (String -> String)
-> Formatted a
-> Formatted a
mapAffix :: forall a. ShowS -> ShowS -> Formatted a -> Formatted a
mapAffix ShowS
preF ShowS
sufF = Formatted a
-> ([Formatted a] -> Formatted a)
-> (a -> Formatted a)
-> (String -> Formatted a -> String -> Formatted a)
-> Formatted a
-> Formatted a
forall b a.
b
-> ([b] -> b)
-> (a -> b)
-> (String -> b -> String -> b)
-> Formatted a
-> b
cataFormatted Formatted a
forall a. Formatted a
Empty [Formatted a] -> Formatted a
forall a. [Formatted a] -> Formatted a
Concat a -> Formatted a
forall a. a -> Formatted a
Plain (\String
p Formatted a
x String
s -> String -> Formatted a -> String -> Formatted a
forall a. String -> Formatted a -> String -> Formatted a
Format (ShowS
preF String
p) Formatted a
x (ShowS
sufF String
s))
cataFormatted :: b
-> ([b] -> b)
-> (a -> b)
-> (String -> b -> String -> b)
-> Formatted a
-> b
cataFormatted :: forall b a.
b
-> ([b] -> b)
-> (a -> b)
-> (String -> b -> String -> b)
-> Formatted a
-> b
cataFormatted b
emptyF [b] -> b
concatF a -> b
plainF String -> b -> String -> b
formatF = \case
Formatted a
Empty -> b
emptyF
Concat [Formatted a]
xs -> [b] -> b
concatF ([b] -> b) -> [b] -> b
forall a b. (a -> b) -> a -> b
$ (Formatted a -> b) -> [Formatted a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Formatted a -> b
cataFormatted' [Formatted a]
xs
Plain a
x -> a -> b
plainF a
x
Format String
p Formatted a
x String
s -> String -> b -> String -> b
formatF String
p (Formatted a -> b
cataFormatted' Formatted a
x) String
s
where
cataFormatted' :: Formatted a -> b
cataFormatted' = b
-> ([b] -> b)
-> (a -> b)
-> (String -> b -> String -> b)
-> Formatted a
-> b
forall b a.
b
-> ([b] -> b)
-> (a -> b)
-> (String -> b -> String -> b)
-> Formatted a
-> b
cataFormatted b
emptyF [b] -> b
concatF a -> b
plainF String -> b -> String -> b
formatF
instance IsString a => IsString (Formatted a) where
fromString :: String -> Formatted a
fromString = a -> Formatted a
forall a. a -> Formatted a
plain (a -> Formatted a) -> (String -> a) -> String -> Formatted a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. IsString a => String -> a
fromString
instance Semigroup (Formatted a) where
Formatted a
Empty <> :: Formatted a -> Formatted a -> Formatted a
<> Formatted a
b = Formatted a
b
Formatted a
a <> Formatted a
Empty = Formatted a
a
Formatted a
a <> Formatted a
b = [Formatted a] -> Formatted a
forall a. [Formatted a] -> Formatted a
Concat ([Formatted a] -> Formatted a) -> [Formatted a] -> Formatted a
forall a b. (a -> b) -> a -> b
$ Formatted a -> [Formatted a]
forall {a}. Formatted a -> [Formatted a]
elements Formatted a
a [Formatted a] -> [Formatted a] -> [Formatted a]
forall a. [a] -> [a] -> [a]
++ Formatted a -> [Formatted a]
forall {a}. Formatted a -> [Formatted a]
elements Formatted a
b
where
elements :: Formatted a -> [Formatted a]
elements (Concat [Formatted a]
es) = [Formatted a]
es
elements Formatted a
e = [Formatted a
e]
instance Monoid (Formatted a) where
mempty :: Formatted a
mempty = Formatted a
forall a. Formatted a
Empty
instance Cell a => Cell (Formatted a) where
visibleLength :: Formatted a -> Int
visibleLength = Formatted Int -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Formatted Int -> Int)
-> (Formatted a -> Formatted Int) -> Formatted a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Int) -> Formatted a -> Formatted Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Int
forall a. Cell a => a -> Int
visibleLength
measureAlignment :: (Char -> Bool) -> Formatted a -> AlignInfo
measureAlignment Char -> Bool
p = (AlignInfo -> a -> AlignInfo)
-> AlignInfo -> Formatted a -> AlignInfo
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Char -> Bool) -> AlignInfo -> a -> AlignInfo
forall a. Cell a => (Char -> Bool) -> AlignInfo -> a -> AlignInfo
mergeAlign Char -> Bool
p) AlignInfo
forall a. Monoid a => a
mempty
buildCell :: forall b. StringBuilder b => Formatted a -> b
buildCell = (a -> b) -> Formatted a -> b
forall b a. StringBuilder b => (a -> b) -> Formatted a -> b
buildFormatted a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell
buildCellView :: forall b. StringBuilder b => CellView (Formatted a) -> b
buildCellView = (Formatted a -> b)
-> (Int -> Formatted a -> b)
-> (Int -> Formatted a -> b)
-> (Int -> Int -> Formatted a -> b)
-> CellView (Formatted a)
-> b
forall b a.
StringBuilder b =>
(a -> b)
-> (Int -> a -> b)
-> (Int -> a -> b)
-> (Int -> Int -> a -> b)
-> CellView a
-> b
buildCellViewHelper
((a -> b) -> Formatted a -> b
forall b a. StringBuilder b => (a -> b) -> Formatted a -> b
buildFormatted a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell)
(\Int
i -> (CellView a -> b) -> Formatted (CellView a) -> b
forall b a. StringBuilder b => (a -> b) -> Formatted a -> b
buildFormatted CellView a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (Formatted (CellView a) -> b)
-> (Formatted a -> Formatted (CellView a)) -> Formatted a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Formatted a -> Formatted (CellView a)
forall {t :: * -> *} {a}.
(Traversable t, Cell a) =>
Int -> t a -> t (CellView a)
trimLeft Int
i)
(\Int
i -> (CellView a -> b) -> Formatted (CellView a) -> b
forall b a. StringBuilder b => (a -> b) -> Formatted a -> b
buildFormatted CellView a -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (Formatted (CellView a) -> b)
-> (Formatted a -> Formatted (CellView a)) -> Formatted a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Formatted a -> Formatted (CellView a)
forall {t :: * -> *} {a}.
(Traversable t, Cell a) =>
Int -> t a -> t (CellView a)
trimRight Int
i)
(\Int
l Int
r -> (CellView (CellView a) -> b)
-> Formatted (CellView (CellView a)) -> b
forall b a. StringBuilder b => (a -> b) -> Formatted a -> b
buildFormatted CellView (CellView a) -> b
forall a b. (Cell a, StringBuilder b) => a -> b
buildCell (Formatted (CellView (CellView a)) -> b)
-> (Formatted a -> Formatted (CellView (CellView a)))
-> Formatted a
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Formatted (CellView a) -> Formatted (CellView (CellView a))
forall {t :: * -> *} {a}.
(Traversable t, Cell a) =>
Int -> t a -> t (CellView a)
trimLeft Int
l (Formatted (CellView a) -> Formatted (CellView (CellView a)))
-> (Formatted a -> Formatted (CellView a))
-> Formatted a
-> Formatted (CellView (CellView a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Formatted a -> Formatted (CellView a)
forall {t :: * -> *} {a}.
(Traversable t, Cell a) =>
Int -> t a -> t (CellView a)
trimRight Int
r)
where
trimLeft :: Int -> t a -> t (CellView a)
trimLeft Int
i = (Int, t (CellView a)) -> t (CellView a)
forall a b. (a, b) -> b
snd ((Int, t (CellView a)) -> t (CellView a))
-> (t a -> (Int, t (CellView a))) -> t a -> t (CellView a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> (Int, CellView a))
-> Int -> t a -> (Int, t (CellView a))
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL ((Int -> a -> CellView a) -> Int -> a -> (Int, CellView a)
forall a.
Cell a =>
(Int -> a -> CellView a) -> Int -> a -> (Int, CellView a)
dropTrackRemaining Int -> a -> CellView a
forall a. Int -> a -> CellView a
dropLeft) Int
i
trimRight :: Int -> t a -> t (CellView a)
trimRight Int
i = (Int, t (CellView a)) -> t (CellView a)
forall a b. (a, b) -> b
snd ((Int, t (CellView a)) -> t (CellView a))
-> (t a -> (Int, t (CellView a))) -> t a -> t (CellView a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> (Int, CellView a))
-> Int -> t a -> (Int, t (CellView a))
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumR ((Int -> a -> CellView a) -> Int -> a -> (Int, CellView a)
forall a.
Cell a =>
(Int -> a -> CellView a) -> Int -> a -> (Int, CellView a)
dropTrackRemaining Int -> a -> CellView a
forall a. Int -> a -> CellView a
dropRight) Int
i
buildFormatted :: StringBuilder b => (a -> b) -> Formatted a -> b
buildFormatted :: forall b a. StringBuilder b => (a -> b) -> Formatted a -> b
buildFormatted a -> b
build = b
-> ([b] -> b)
-> (a -> b)
-> (String -> b -> String -> b)
-> Formatted a
-> b
forall b a.
b
-> ([b] -> b)
-> (a -> b)
-> (String -> b -> String -> b)
-> Formatted a
-> b
cataFormatted b
forall a. Monoid a => a
mempty [b] -> b
forall a. Monoid a => [a] -> a
mconcat a -> b
build (\String
p b
a String
s -> String -> b
forall a. StringBuilder a => String -> a
stringB String
p b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
a b -> b -> b
forall a. Semigroup a => a -> a -> a
<> String -> b
forall a. StringBuilder a => String -> a
stringB String
s)
dropTrackRemaining :: Cell a => (Int -> a -> CellView a) -> Int -> a -> (Int, CellView a)
dropTrackRemaining :: forall a.
Cell a =>
(Int -> a -> CellView a) -> Int -> a -> (Int, CellView a)
dropTrackRemaining Int -> a -> CellView a
dropF Int
i a
a
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (Int
0, a -> CellView a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
| Bool
otherwise = let l :: Int
l = a -> Int
forall a. Cell a => a -> Int
visibleLength a
a in (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l, Int -> a -> CellView a
dropF Int
i a
a)
mergeAlign :: Cell a => (Char -> Bool) -> AlignInfo -> a -> AlignInfo
mergeAlign :: forall a. Cell a => (Char -> Bool) -> AlignInfo -> a -> AlignInfo
mergeAlign Char -> Bool
_ (AlignInfo Int
l (Just Int
r)) a
x = Int -> Maybe Int -> AlignInfo
AlignInfo Int
l (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. Cell a => a -> Int
visibleLength a
x)
mergeAlign Char -> Bool
p (AlignInfo Int
l Maybe Int
Nothing) a
x = let AlignInfo Int
l' Maybe Int
r = (Char -> Bool) -> a -> AlignInfo
forall a. Cell a => (Char -> Bool) -> a -> AlignInfo
measureAlignment Char -> Bool
p a
x in Int -> Maybe Int -> AlignInfo
AlignInfo (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l') Maybe Int
r