{-# LANGUAGE FlexibleContexts #-}
module Text.Tabular where
import Data.List (intersperse)
import Control.Monad.State (evalState, State, get, put)
data Properties = NoLine | SingleLine | DoubleLine
deriving (Int -> Properties -> ShowS
[Properties] -> ShowS
Properties -> String
(Int -> Properties -> ShowS)
-> (Properties -> String)
-> ([Properties] -> ShowS)
-> Show Properties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Properties -> ShowS
showsPrec :: Int -> Properties -> ShowS
$cshow :: Properties -> String
show :: Properties -> String
$cshowList :: [Properties] -> ShowS
showList :: [Properties] -> ShowS
Show)
data h = h | Group Properties [Header h]
deriving (Int -> Header h -> ShowS
[Header h] -> ShowS
Header h -> String
(Int -> Header h -> ShowS)
-> (Header h -> String) -> ([Header h] -> ShowS) -> Show (Header h)
forall h. Show h => Int -> Header h -> ShowS
forall h. Show h => [Header h] -> ShowS
forall h. Show h => Header h -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall h. Show h => Int -> Header h -> ShowS
showsPrec :: Int -> Header h -> ShowS
$cshow :: forall h. Show h => Header h -> String
show :: Header h -> String
$cshowList :: forall h. Show h => [Header h] -> ShowS
showList :: [Header h] -> ShowS
Show)
data Table rh ch a = Table (Header rh) (Header ch) [[a]]
deriving (Int -> Table rh ch a -> ShowS
[Table rh ch a] -> ShowS
Table rh ch a -> String
(Int -> Table rh ch a -> ShowS)
-> (Table rh ch a -> String)
-> ([Table rh ch a] -> ShowS)
-> Show (Table rh ch a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall rh ch a.
(Show rh, Show ch, Show a) =>
Int -> Table rh ch a -> ShowS
forall rh ch a.
(Show rh, Show ch, Show a) =>
[Table rh ch a] -> ShowS
forall rh ch a.
(Show rh, Show ch, Show a) =>
Table rh ch a -> String
$cshowsPrec :: forall rh ch a.
(Show rh, Show ch, Show a) =>
Int -> Table rh ch a -> ShowS
showsPrec :: Int -> Table rh ch a -> ShowS
$cshow :: forall rh ch a.
(Show rh, Show ch, Show a) =>
Table rh ch a -> String
show :: Table rh ch a -> String
$cshowList :: forall rh ch a.
(Show rh, Show ch, Show a) =>
[Table rh ch a] -> ShowS
showList :: [Table rh ch a] -> ShowS
Show)
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 :: forall a b. (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 a b. (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 cells <- m [h]
forall s (m :: * -> *). MonadState s m => m s
get
string <- case cells of
[] -> (h, b) -> m (h, b)
forall a. a -> m a
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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (h, b) -> m (h, b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (h
s,b
x)
return $ Header 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 a b. (a -> b) -> m a -> m 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 :: forall b h. (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]
deriving (Int -> SemiTable h a -> ShowS
[SemiTable h a] -> ShowS
SemiTable h a -> String
(Int -> SemiTable h a -> ShowS)
-> (SemiTable h a -> String)
-> ([SemiTable h a] -> ShowS)
-> Show (SemiTable h a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall h a. (Show h, Show a) => Int -> SemiTable h a -> ShowS
forall h a. (Show h, Show a) => [SemiTable h a] -> ShowS
forall h a. (Show h, Show a) => SemiTable h a -> String
$cshowsPrec :: forall h a. (Show h, Show a) => Int -> SemiTable h a -> ShowS
showsPrec :: Int -> SemiTable h a -> ShowS
$cshow :: forall h a. (Show h, Show a) => SemiTable h a -> String
show :: SemiTable h a -> String
$cshowList :: forall h a. (Show h, Show a) => [SemiTable h a] -> ShowS
showList :: [SemiTable h a] -> ShowS
Show)
empty :: Table rh ch a
empty :: forall rh ch a. 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 :: forall ch a. 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 :: forall ch a. 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 :: forall ch a. ch -> [a] -> SemiTable ch a
row = rh -> [a] -> SemiTable rh a
forall ch a. ch -> [a] -> SemiTable ch a
col
rowH :: rh -> SemiTable rh a
rowH :: forall ch a. ch -> SemiTable ch 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 :: forall rh ch a.
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]
xs a
x -> [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x]) [[a]]
data1 [a]
data2)
below :: Properties -> Table rh ch a -> SemiTable rh a -> Table rh ch a
below :: forall rh ch a.
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
^..^ :: forall 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
^|^ :: forall 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
^||^ :: forall 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
+.+ :: forall 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
+----+ :: forall 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
+====+ :: forall 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