{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Properties] -> ShowS
$cshowList :: [Properties] -> ShowS
show :: Properties -> String
$cshow :: Properties -> String
showsPrec :: Int -> Properties -> ShowS
$cshowsPrec :: Int -> Properties -> ShowS
Show)
data h = h | Group Properties [Header h]
deriving (Int -> Header h -> ShowS
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
showList :: [Header h] -> ShowS
$cshowList :: forall h. Show h => [Header h] -> ShowS
show :: Header h -> String
$cshow :: forall h. Show h => Header h -> String
showsPrec :: Int -> Header h -> ShowS
$cshowsPrec :: forall h. Show h => Int -> Header h -> ShowS
Show)
data Table rh ch a = Table (Header rh) (Header ch) [[a]]
deriving (Int -> Table rh ch a -> ShowS
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
showList :: [Table rh ch a] -> ShowS
$cshowList :: forall rh ch a.
(Show rh, Show ch, Show a) =>
[Table rh ch a] -> ShowS
show :: Table rh ch a -> String
$cshow :: forall rh ch a.
(Show rh, Show ch, Show a) =>
Table rh ch a -> String
showsPrec :: Int -> Table rh ch a -> ShowS
$cshowsPrec :: forall rh ch a.
(Show rh, Show ch, Show a) =>
Int -> Table rh ch a -> ShowS
Show)
headerContents :: Header h -> [h]
(Header h
s) = [h
s]
headerContents (Group Properties
_ [Header h]
hs) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap 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) = forall h. h -> Header h
Header (a -> b
f a
s)
fmap a -> b
f (Group Properties
p [Header a]
hs) = forall h. Properties -> [Header h] -> Header h
Group Properties
p (forall a b. (a -> b) -> [a] -> [b]
map (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 = forall s a. State s a -> s -> a
evalState (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 <- forall s (m :: * -> *). MonadState s m => m s
get
(h, b)
string <- case [h]
cells of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return (h
e,b
x)
(h
s:[h]
ss) -> forall s (m :: * -> *). MonadState s m => s -> m ()
put [h]
ss forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (h
s,b
x)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall h. h -> Header h
Header (h, b)
string
helper (Group Properties
s [Header b]
hs) =
forall h. Properties -> [Header h] -> Header h
Group Properties
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` 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) = [forall a b. b -> Either a b
Right h
s]
flattenHeader (Group Properties
l [Header h]
s) =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse [forall a b. a -> Either a b
Left Properties
l] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall h. Header h -> [Either Properties h]
flattenHeader 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 forall a b. (a -> b) -> a -> b
$ 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) forall a. a -> [a] -> [a]
: [Either Properties h] -> [b]
helper [Either Properties h]
es2
[Either Properties h]
_ -> h -> b
f h
x 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
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
showList :: [SemiTable h a] -> ShowS
$cshowList :: forall h a. (Show h, Show a) => [SemiTable h a] -> ShowS
show :: SemiTable h a -> String
$cshow :: forall h a. (Show h, Show a) => SemiTable h a -> String
showsPrec :: Int -> SemiTable h a -> ShowS
$cshowsPrec :: forall h a. (Show h, Show a) => Int -> SemiTable h a -> ShowS
Show)
empty :: Table rh ch a
empty :: forall rh ch a. Table rh ch a
empty = forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table (forall h. Properties -> [Header h] -> Header h
Group Properties
NoLine []) (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 = forall h a. Header h -> [a] -> SemiTable h a
SemiTable (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 = 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 = forall ch a. ch -> [a] -> SemiTable ch a
col
rowH :: rh -> SemiTable rh a
rowH :: forall ch a. ch -> SemiTable ch a
rowH = 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) =
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table Header rh
rows (forall h. Properties -> [Header h] -> Header h
Group Properties
prop [Header ch
cols1, Header ch
cols2])
(forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[a]
xs a
x -> [a]
xs 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) =
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table (forall h. Properties -> [Header h] -> Header h
Group Properties
prop [Header rh
rows1, Header rh
rows2]) Header ch
cols ([[a]]
data1 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
(^..^) = 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
(^|^) = 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
(^||^) = 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
(+.+) = 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
(+----+) = 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
(+====+) = forall rh ch a.
Properties -> Table rh ch a -> SemiTable rh a -> Table rh ch a
below Properties
DoubleLine