{-# LANGUAGE FlexibleContexts #-}
module Text.Tabular where
import Data.List (intersperse)
import Control.Monad.State (evalState, State, get, put)
data Properties = NoLine | SingleLine | DoubleLine
data h = h | Group Properties [Header h]
data Table rh ch a = Table (Header rh) (Header ch) [[a]]
headerContents :: Header h -> [h]
(Header h
s) = [h
s]
headerContents (Group Properties
_ [Header h]
hs) = (Header h -> [h]) -> [Header h] -> [h]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Header h -> [h]
forall h. Header h -> [h]
headerContents [Header h]
hs
instance Functor Header where
fmap :: (a -> b) -> Header a -> Header b
fmap a -> b
f (Header a
s) = b -> Header b
forall h. h -> Header h
Header (a -> b
f a
s)
fmap a -> b
f (Group Properties
p [Header a]
hs) = Properties -> [Header b] -> Header b
forall h. Properties -> [Header h] -> Header h
Group Properties
p ((Header a -> Header b) -> [Header a] -> [Header b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Header a -> Header b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Header a]
hs)
zipHeader :: h -> [h] -> Header a -> Header (h,a)
h
e [h]
ss Header a
h = State [h] (Header (h, a)) -> [h] -> Header (h, a)
forall s a. State s a -> s -> a
evalState (Header a -> State [h] (Header (h, a))
forall (m :: * -> *) b.
MonadState [h] m =>
Header b -> m (Header (h, b))
helper Header a
h) [h]
ss
where
helper :: Header b -> m (Header (h, b))
helper (Header b
x) =
do [h]
cells <- m [h]
forall s (m :: * -> *). MonadState s m => m s
get
(h, b)
string <- case [h]
cells of
[] -> (h, b) -> m (h, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (h
e,b
x)
(h
s:[h]
ss) -> [h] -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [h]
ss m () -> m (h, b) -> m (h, b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (h, b) -> m (h, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (h
s,b
x)
Header (h, b) -> m (Header (h, b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Header (h, b) -> m (Header (h, b)))
-> Header (h, b) -> m (Header (h, b))
forall a b. (a -> b) -> a -> b
$ (h, b) -> Header (h, b)
forall h. h -> Header h
Header (h, b)
string
helper (Group Properties
s [Header b]
hs) =
Properties -> [Header (h, b)] -> Header (h, b)
forall h. Properties -> [Header h] -> Header h
Group Properties
s ([Header (h, b)] -> Header (h, b))
-> m [Header (h, b)] -> m (Header (h, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Header b -> m (Header (h, b))) -> [Header b] -> m [Header (h, b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Header b -> m (Header (h, b))
helper [Header b]
hs
flattenHeader :: Header h -> [Either Properties h]
(Header h
s) = [h -> Either Properties h
forall a b. b -> Either a b
Right h
s]
flattenHeader (Group Properties
l [Header h]
s) =
[[Either Properties h]] -> [Either Properties h]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Either Properties h]] -> [Either Properties h])
-> ([Header h] -> [[Either Properties h]])
-> [Header h]
-> [Either Properties h]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either Properties h]
-> [[Either Properties h]] -> [[Either Properties h]]
forall a. a -> [a] -> [a]
intersperse [Properties -> Either Properties h
forall a b. a -> Either a b
Left Properties
l] ([[Either Properties h]] -> [[Either Properties h]])
-> ([Header h] -> [[Either Properties h]])
-> [Header h]
-> [[Either Properties h]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header h -> [Either Properties h])
-> [Header h] -> [[Either Properties h]]
forall a b. (a -> b) -> [a] -> [b]
map Header h -> [Either Properties h]
forall h. Header h -> [Either Properties h]
flattenHeader ([Header h] -> [Either Properties h])
-> [Header h] -> [Either Properties h]
forall a b. (a -> b) -> a -> b
$ [Header h]
s
squish :: (Properties -> b -> b)
-> (h -> b)
-> Header h
-> [b]
squish :: (Properties -> b -> b) -> (h -> b) -> Header h -> [b]
squish Properties -> b -> b
decorator h -> b
f Header h
h = [Either Properties h] -> [b]
helper ([Either Properties h] -> [b]) -> [Either Properties h] -> [b]
forall a b. (a -> b) -> a -> b
$ Header h -> [Either Properties h]
forall h. Header h -> [Either Properties h]
flattenHeader Header h
h
where
helper :: [Either Properties h] -> [b]
helper [] = []
helper (Left Properties
p:[Either Properties h]
es) = [Either Properties h] -> [b]
helper [Either Properties h]
es
helper (Right h
x:[Either Properties h]
es) =
case [Either Properties h]
es of
(Left Properties
p:[Either Properties h]
es2) -> Properties -> b -> b
decorator Properties
p (h -> b
f h
x) b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [Either Properties h] -> [b]
helper [Either Properties h]
es2
[Either Properties h]
_ -> h -> b
f h
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [Either Properties h] -> [b]
helper [Either Properties h]
es
data SemiTable h a = SemiTable (Header h) [a]
empty :: Table rh ch a
empty :: Table rh ch a
empty = Header rh -> Header ch -> [[a]] -> Table rh ch a
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table (Properties -> [Header rh] -> Header rh
forall h. Properties -> [Header h] -> Header h
Group Properties
NoLine []) (Properties -> [Header ch] -> Header ch
forall h. Properties -> [Header h] -> Header h
Group Properties
NoLine []) []
col :: ch -> [a] -> SemiTable ch a
col :: ch -> [a] -> SemiTable ch a
col ch
header [a]
cells = Header ch -> [a] -> SemiTable ch a
forall h a. Header h -> [a] -> SemiTable h a
SemiTable (ch -> Header ch
forall h. h -> Header h
Header ch
header) [a]
cells
colH :: ch -> SemiTable ch a
colH :: ch -> SemiTable ch a
colH ch
header = ch -> [a] -> SemiTable ch a
forall ch a. ch -> [a] -> SemiTable ch a
col ch
header []
row :: rh -> [a] -> SemiTable rh a
row :: rh -> [a] -> SemiTable rh a
row = rh -> [a] -> SemiTable rh a
forall ch a. ch -> [a] -> SemiTable ch a
col
rowH :: rh -> SemiTable rh a
rowH :: rh -> SemiTable rh a
rowH = rh -> SemiTable rh a
forall ch a. ch -> SemiTable ch a
colH
beside :: Properties -> Table rh ch a -> SemiTable ch a -> Table rh ch a
beside :: Properties -> Table rh ch a -> SemiTable ch a -> Table rh ch a
beside Properties
prop (Table Header rh
rows Header ch
cols1 [[a]]
data1)
(SemiTable Header ch
cols2 [a]
data2) =
Header rh -> Header ch -> [[a]] -> Table rh ch a
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table Header rh
rows (Properties -> [Header ch] -> Header ch
forall h. Properties -> [Header h] -> Header h
Group Properties
prop [Header ch
cols1, Header ch
cols2])
(([a] -> [a] -> [a]) -> [[a]] -> [[a]] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) [[a]]
data1 [[a]
data2])
below :: Properties -> Table rh ch a -> SemiTable rh a -> Table rh ch a
below :: Properties -> Table rh ch a -> SemiTable rh a -> Table rh ch a
below Properties
prop (Table Header rh
rows1 Header ch
cols [[a]]
data1)
(SemiTable Header rh
rows2 [a]
data2) =
Header rh -> Header ch -> [[a]] -> Table rh ch a
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table (Properties -> [Header rh] -> Header rh
forall h. Properties -> [Header h] -> Header h
Group Properties
prop [Header rh
rows1, Header rh
rows2]) Header ch
cols ([[a]]
data1 [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]
data2])
(^..^) :: Table rh ch a -> SemiTable ch a -> Table rh ch a
^..^ :: Table rh ch a -> SemiTable ch a -> Table rh ch a
(^..^) = Properties -> Table rh ch a -> SemiTable ch a -> Table rh ch a
forall rh ch a.
Properties -> Table rh ch a -> SemiTable ch a -> Table rh ch a
beside Properties
NoLine
(^|^) :: Table rh ch a -> SemiTable ch a -> Table rh ch a
^|^ :: Table rh ch a -> SemiTable ch a -> Table rh ch a
(^|^) = Properties -> Table rh ch a -> SemiTable ch a -> Table rh ch a
forall rh ch a.
Properties -> Table rh ch a -> SemiTable ch a -> Table rh ch a
beside Properties
SingleLine
(^||^) :: Table rh ch a -> SemiTable ch a -> Table rh ch a
^||^ :: Table rh ch a -> SemiTable ch a -> Table rh ch a
(^||^) = Properties -> Table rh ch a -> SemiTable ch a -> Table rh ch a
forall rh ch a.
Properties -> Table rh ch a -> SemiTable ch a -> Table rh ch a
beside Properties
DoubleLine
(+.+) :: Table rh ch a -> SemiTable rh a -> Table rh ch a
+.+ :: Table rh ch a -> SemiTable rh a -> Table rh ch a
(+.+) = Properties -> Table rh ch a -> SemiTable rh a -> Table rh ch a
forall rh ch a.
Properties -> Table rh ch a -> SemiTable rh a -> Table rh ch a
below Properties
NoLine
(+----+) :: Table rh ch a -> SemiTable rh a -> Table rh ch a
+----+ :: Table rh ch a -> SemiTable rh a -> Table rh ch a
(+----+) = Properties -> Table rh ch a -> SemiTable rh a -> Table rh ch a
forall rh ch a.
Properties -> Table rh ch a -> SemiTable rh a -> Table rh ch a
below Properties
SingleLine
(+====+) :: Table rh ch a -> SemiTable rh a -> Table rh ch a
+====+ :: Table rh ch a -> SemiTable rh a -> Table rh ch a
(+====+) = Properties -> Table rh ch a -> SemiTable rh a -> Table rh ch a
forall rh ch a.
Properties -> Table rh ch a -> SemiTable rh a -> Table rh ch a
below Properties
DoubleLine