{-# LANGUAGE DeriveTraversable #-}

module Text.Layout.Table.Spec.HeaderSpec where

import Data.Bifunctor
import Data.Default.Class
import Data.List

import Text.Layout.Table.Spec.HeaderColSpec

-- | Specifies a header.
data HeaderSpec sep a
    -- | A grouping of subheaders separated by delimiters with the given label
    = GroupHS sep [HeaderSpec sep a]
    -- | A single header column with a given 'HeaderColSpec' and content.
    | HeaderHS HeaderColSpec a
    -- | Do not display the header, and determine the shape as a flat list
    -- sized to the table content with a given separator.
    | NoneHS sep
  deriving ((forall a b. (a -> b) -> HeaderSpec sep a -> HeaderSpec sep b)
-> (forall a b. a -> HeaderSpec sep b -> HeaderSpec sep a)
-> Functor (HeaderSpec sep)
forall a b. a -> HeaderSpec sep b -> HeaderSpec sep a
forall a b. (a -> b) -> HeaderSpec sep a -> HeaderSpec sep b
forall sep a b. a -> HeaderSpec sep b -> HeaderSpec sep a
forall sep a b. (a -> b) -> HeaderSpec sep a -> HeaderSpec sep 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 -> HeaderSpec sep b -> HeaderSpec sep a
$c<$ :: forall sep a b. a -> HeaderSpec sep b -> HeaderSpec sep a
fmap :: forall a b. (a -> b) -> HeaderSpec sep a -> HeaderSpec sep b
$cfmap :: forall sep a b. (a -> b) -> HeaderSpec sep a -> HeaderSpec sep b
Functor, (forall m. Monoid m => HeaderSpec sep m -> m)
-> (forall m a. Monoid m => (a -> m) -> HeaderSpec sep a -> m)
-> (forall m a. Monoid m => (a -> m) -> HeaderSpec sep a -> m)
-> (forall a b. (a -> b -> b) -> b -> HeaderSpec sep a -> b)
-> (forall a b. (a -> b -> b) -> b -> HeaderSpec sep a -> b)
-> (forall b a. (b -> a -> b) -> b -> HeaderSpec sep a -> b)
-> (forall b a. (b -> a -> b) -> b -> HeaderSpec sep a -> b)
-> (forall a. (a -> a -> a) -> HeaderSpec sep a -> a)
-> (forall a. (a -> a -> a) -> HeaderSpec sep a -> a)
-> (forall a. HeaderSpec sep a -> [a])
-> (forall a. HeaderSpec sep a -> Bool)
-> (forall a. HeaderSpec sep a -> Int)
-> (forall a. Eq a => a -> HeaderSpec sep a -> Bool)
-> (forall a. Ord a => HeaderSpec sep a -> a)
-> (forall a. Ord a => HeaderSpec sep a -> a)
-> (forall a. Num a => HeaderSpec sep a -> a)
-> (forall a. Num a => HeaderSpec sep a -> a)
-> Foldable (HeaderSpec sep)
forall a. Eq a => a -> HeaderSpec sep a -> Bool
forall a. Num a => HeaderSpec sep a -> a
forall a. Ord a => HeaderSpec sep a -> a
forall m. Monoid m => HeaderSpec sep m -> m
forall a. HeaderSpec sep a -> Bool
forall a. HeaderSpec sep a -> Int
forall a. HeaderSpec sep a -> [a]
forall a. (a -> a -> a) -> HeaderSpec sep a -> a
forall sep a. Eq a => a -> HeaderSpec sep a -> Bool
forall sep a. Num a => HeaderSpec sep a -> a
forall sep a. Ord a => HeaderSpec sep a -> a
forall m a. Monoid m => (a -> m) -> HeaderSpec sep a -> m
forall sep m. Monoid m => HeaderSpec sep m -> m
forall sep a. HeaderSpec sep a -> Bool
forall sep a. HeaderSpec sep a -> Int
forall sep a. HeaderSpec sep a -> [a]
forall b a. (b -> a -> b) -> b -> HeaderSpec sep a -> b
forall a b. (a -> b -> b) -> b -> HeaderSpec sep a -> b
forall sep a. (a -> a -> a) -> HeaderSpec sep a -> a
forall sep m a. Monoid m => (a -> m) -> HeaderSpec sep a -> m
forall sep b a. (b -> a -> b) -> b -> HeaderSpec sep a -> b
forall sep a b. (a -> b -> b) -> b -> HeaderSpec sep 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 => HeaderSpec sep a -> a
$cproduct :: forall sep a. Num a => HeaderSpec sep a -> a
sum :: forall a. Num a => HeaderSpec sep a -> a
$csum :: forall sep a. Num a => HeaderSpec sep a -> a
minimum :: forall a. Ord a => HeaderSpec sep a -> a
$cminimum :: forall sep a. Ord a => HeaderSpec sep a -> a
maximum :: forall a. Ord a => HeaderSpec sep a -> a
$cmaximum :: forall sep a. Ord a => HeaderSpec sep a -> a
elem :: forall a. Eq a => a -> HeaderSpec sep a -> Bool
$celem :: forall sep a. Eq a => a -> HeaderSpec sep a -> Bool
length :: forall a. HeaderSpec sep a -> Int
$clength :: forall sep a. HeaderSpec sep a -> Int
null :: forall a. HeaderSpec sep a -> Bool
$cnull :: forall sep a. HeaderSpec sep a -> Bool
toList :: forall a. HeaderSpec sep a -> [a]
$ctoList :: forall sep a. HeaderSpec sep a -> [a]
foldl1 :: forall a. (a -> a -> a) -> HeaderSpec sep a -> a
$cfoldl1 :: forall sep a. (a -> a -> a) -> HeaderSpec sep a -> a
foldr1 :: forall a. (a -> a -> a) -> HeaderSpec sep a -> a
$cfoldr1 :: forall sep a. (a -> a -> a) -> HeaderSpec sep a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> HeaderSpec sep a -> b
$cfoldl' :: forall sep b a. (b -> a -> b) -> b -> HeaderSpec sep a -> b
foldl :: forall b a. (b -> a -> b) -> b -> HeaderSpec sep a -> b
$cfoldl :: forall sep b a. (b -> a -> b) -> b -> HeaderSpec sep a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> HeaderSpec sep a -> b
$cfoldr' :: forall sep a b. (a -> b -> b) -> b -> HeaderSpec sep a -> b
foldr :: forall a b. (a -> b -> b) -> b -> HeaderSpec sep a -> b
$cfoldr :: forall sep a b. (a -> b -> b) -> b -> HeaderSpec sep a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> HeaderSpec sep a -> m
$cfoldMap' :: forall sep m a. Monoid m => (a -> m) -> HeaderSpec sep a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> HeaderSpec sep a -> m
$cfoldMap :: forall sep m a. Monoid m => (a -> m) -> HeaderSpec sep a -> m
fold :: forall m. Monoid m => HeaderSpec sep m -> m
$cfold :: forall sep m. Monoid m => HeaderSpec sep m -> m
Foldable, Functor (HeaderSpec sep)
Foldable (HeaderSpec sep)
Functor (HeaderSpec sep)
-> Foldable (HeaderSpec sep)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> HeaderSpec sep a -> f (HeaderSpec sep b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    HeaderSpec sep (f a) -> f (HeaderSpec sep a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> HeaderSpec sep a -> m (HeaderSpec sep b))
-> (forall (m :: * -> *) a.
    Monad m =>
    HeaderSpec sep (m a) -> m (HeaderSpec sep a))
-> Traversable (HeaderSpec sep)
forall sep. Functor (HeaderSpec sep)
forall sep. Foldable (HeaderSpec sep)
forall sep (m :: * -> *) a.
Monad m =>
HeaderSpec sep (m a) -> m (HeaderSpec sep a)
forall sep (f :: * -> *) a.
Applicative f =>
HeaderSpec sep (f a) -> f (HeaderSpec sep a)
forall sep (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HeaderSpec sep a -> m (HeaderSpec sep b)
forall sep (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HeaderSpec sep a -> f (HeaderSpec sep 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 =>
HeaderSpec sep (m a) -> m (HeaderSpec sep a)
forall (f :: * -> *) a.
Applicative f =>
HeaderSpec sep (f a) -> f (HeaderSpec sep a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HeaderSpec sep a -> m (HeaderSpec sep b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HeaderSpec sep a -> f (HeaderSpec sep b)
sequence :: forall (m :: * -> *) a.
Monad m =>
HeaderSpec sep (m a) -> m (HeaderSpec sep a)
$csequence :: forall sep (m :: * -> *) a.
Monad m =>
HeaderSpec sep (m a) -> m (HeaderSpec sep a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HeaderSpec sep a -> m (HeaderSpec sep b)
$cmapM :: forall sep (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HeaderSpec sep a -> m (HeaderSpec sep b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
HeaderSpec sep (f a) -> f (HeaderSpec sep a)
$csequenceA :: forall sep (f :: * -> *) a.
Applicative f =>
HeaderSpec sep (f a) -> f (HeaderSpec sep a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HeaderSpec sep a -> f (HeaderSpec sep b)
$ctraverse :: forall sep (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HeaderSpec sep a -> f (HeaderSpec sep b)
Traversable)

instance Bifunctor HeaderSpec where
    bimap :: forall a b c d.
(a -> b) -> (c -> d) -> HeaderSpec a c -> HeaderSpec b d
bimap a -> b
f c -> d
g (GroupHS a
sep [HeaderSpec a c]
hs)       = b -> [HeaderSpec b d] -> HeaderSpec b d
forall sep a. sep -> [HeaderSpec sep a] -> HeaderSpec sep a
GroupHS (a -> b
f a
sep) ((HeaderSpec a c -> HeaderSpec b d)
-> [HeaderSpec a c] -> [HeaderSpec b d]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> (c -> d) -> HeaderSpec a c -> HeaderSpec b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g) [HeaderSpec a c]
hs)
    bimap a -> b
_ c -> d
g (HeaderHS HeaderColSpec
spec c
title)  = HeaderColSpec -> d -> HeaderSpec b d
forall sep a. HeaderColSpec -> a -> HeaderSpec sep a
HeaderHS HeaderColSpec
spec (c -> d
g c
title)
    bimap a -> b
f c -> d
_ (NoneHS a
sep)           = b -> HeaderSpec b d
forall sep a. sep -> HeaderSpec sep a
NoneHS (a -> b
f a
sep)

-- | By the default the header is not shown.
instance Default sep => Default (HeaderSpec sep a) where
    def :: HeaderSpec sep a
def = HeaderSpec sep a
forall sep a. Default sep => HeaderSpec sep a
defHeaderSpec

-- | The default 'HeaderSpec' does not display the header and uses the default
-- separator.
defHeaderSpec :: Default sep => HeaderSpec sep a
defHeaderSpec :: forall sep a. Default sep => HeaderSpec sep a
defHeaderSpec = sep -> HeaderSpec sep a
forall sep a. sep -> HeaderSpec sep a
NoneHS sep
forall a. Default a => a
def

-- | Specify no header, with columns separated by a given separator.
noneSepH :: sep -> HeaderSpec sep String
noneSepH :: forall sep. sep -> HeaderSpec sep String
noneSepH = sep -> HeaderSpec sep String
forall sep a. sep -> HeaderSpec sep a
NoneHS

-- | Specify no header, with columns separated by a default separator.
noneH :: Default sep => HeaderSpec sep String
noneH :: forall sep. Default sep => HeaderSpec sep String
noneH = sep -> HeaderSpec sep String
forall sep. sep -> HeaderSpec sep String
noneSepH sep
forall a. Default a => a
def

-- | Specify every header column in detail and separate them by the given
-- separator.
fullSepH :: sep -> [HeaderColSpec] -> [a] -> HeaderSpec sep a
fullSepH :: forall sep a. sep -> [HeaderColSpec] -> [a] -> HeaderSpec sep a
fullSepH sep
sep [HeaderColSpec]
specs = sep -> [HeaderSpec sep a] -> HeaderSpec sep a
forall sep a. sep -> [HeaderSpec sep a] -> HeaderSpec sep a
GroupHS sep
sep ([HeaderSpec sep a] -> HeaderSpec sep a)
-> ([a] -> [HeaderSpec sep a]) -> [a] -> HeaderSpec sep a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderColSpec -> a -> HeaderSpec sep a)
-> [HeaderColSpec] -> [a] -> [HeaderSpec sep a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith HeaderColSpec -> a -> HeaderSpec sep a
forall sep a. HeaderColSpec -> a -> HeaderSpec sep a
HeaderHS [HeaderColSpec]
specs

-- | Specify every header column in detail and separate them with the default
-- separator.
fullH :: Default sep => [HeaderColSpec] -> [a] -> HeaderSpec sep a
fullH :: forall sep a.
Default sep =>
[HeaderColSpec] -> [a] -> HeaderSpec sep a
fullH = sep -> [HeaderColSpec] -> [a] -> HeaderSpec sep a
forall sep a. sep -> [HeaderColSpec] -> [a] -> HeaderSpec sep a
fullSepH sep
forall a. Default a => a
def

-- | Use titles with the default header column specification and separator.
titlesH :: Default sep => [a] -> HeaderSpec sep a
titlesH :: forall sep a. Default sep => [a] -> HeaderSpec sep a
titlesH = [HeaderColSpec] -> [a] -> HeaderSpec sep a
forall sep a.
Default sep =>
[HeaderColSpec] -> [a] -> HeaderSpec sep a
fullH (HeaderColSpec -> [HeaderColSpec]
forall a. a -> [a]
repeat HeaderColSpec
defHeaderColSpec)

-- | Combine the header specification for multiple columns by separating the
-- columns with a specific separator.
groupH :: sep -> [HeaderSpec sep a] -> HeaderSpec sep a
groupH :: forall sep a. sep -> [HeaderSpec sep a] -> HeaderSpec sep a
groupH = sep -> [HeaderSpec sep a] -> HeaderSpec sep a
forall sep a. sep -> [HeaderSpec sep a] -> HeaderSpec sep a
GroupHS

-- | Specify the header for a single column.
headerH :: HeaderColSpec -> a -> HeaderSpec sep a
headerH :: forall a sep. HeaderColSpec -> a -> HeaderSpec sep a
headerH = HeaderColSpec -> a -> HeaderSpec sep a
forall sep a. HeaderColSpec -> a -> HeaderSpec sep a
HeaderHS

-- | Zip a 'HeaderSpec' with a list.
zipHeader :: b -> [b] -> HeaderSpec sep a -> HeaderSpec sep (b, a)
zipHeader :: forall b sep a.
b -> [b] -> HeaderSpec sep a -> HeaderSpec sep (b, a)
zipHeader b
e [b]
bs = ([b], HeaderSpec sep (b, a)) -> HeaderSpec sep (b, a)
forall a b. (a, b) -> b
snd (([b], HeaderSpec sep (b, a)) -> HeaderSpec sep (b, a))
-> (HeaderSpec sep a -> ([b], HeaderSpec sep (b, a)))
-> HeaderSpec sep a
-> HeaderSpec sep (b, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([b] -> a -> ([b], (b, a)))
-> [b] -> HeaderSpec sep a -> ([b], HeaderSpec sep (b, a))
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL [b] -> a -> ([b], (b, a))
forall {b}. [b] -> b -> ([b], (b, b))
helper [b]
bs
  where
    helper :: [b] -> b -> ([b], (b, b))
helper (b
s : [b]
ss) b
title = ([b]
ss, (b
s, b
title))
    helper []       b
title = ([], (b
e, b
title))

-- | Flatten a header to produce a list of content and separators.
flattenHeader :: HeaderSpec sep a -> [Either sep a]
flattenHeader :: forall sep a. HeaderSpec sep a -> [Either sep a]
flattenHeader (GroupHS sep
sep [HeaderSpec sep a]
hs)   = [Either sep a] -> [[Either sep a]] -> [Either sep a]
forall a. [a] -> [[a]] -> [a]
intercalate [sep -> Either sep a
forall a b. a -> Either a b
Left sep
sep] ([[Either sep a]] -> [Either sep a])
-> [[Either sep a]] -> [Either sep a]
forall a b. (a -> b) -> a -> b
$ (HeaderSpec sep a -> [Either sep a])
-> [HeaderSpec sep a] -> [[Either sep a]]
forall a b. (a -> b) -> [a] -> [b]
map HeaderSpec sep a -> [Either sep a]
forall sep a. HeaderSpec sep a -> [Either sep a]
flattenHeader [HeaderSpec sep a]
hs
flattenHeader (HeaderHS HeaderColSpec
_ a
title) = [a -> Either sep a
forall a b. b -> Either a b
Right a
title]
flattenHeader (NoneHS sep
_)         = []

-- | Get the titles and column specifications from a header.
headerContents :: HeaderSpec sep a -> [(HeaderColSpec, a)]
headerContents :: forall sep a. HeaderSpec sep a -> [(HeaderColSpec, a)]
headerContents (GroupHS sep
_ [HeaderSpec sep a]
hs)        = (HeaderSpec sep a -> [(HeaderColSpec, a)])
-> [HeaderSpec sep a] -> [(HeaderColSpec, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap HeaderSpec sep a -> [(HeaderColSpec, a)]
forall sep a. HeaderSpec sep a -> [(HeaderColSpec, a)]
headerContents [HeaderSpec sep a]
hs
headerContents (HeaderHS HeaderColSpec
spec a
title) = [(HeaderColSpec
spec, a
title)]
headerContents (NoneHS sep
_)            = []