{- |
Module      :  ./Common/Lib/Tabular.hs
Description :  parts of the tabular package
Copyright   :  (c) Eric Kow <E.Y.Kow@brighton.ac.uk>
License     :  BSD3

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

-}

module Common.Lib.Tabular where

import Data.List (intercalate, transpose)
import Common.Lib.State (evalState, get, put)

data Properties = NoLine | SingleLine | DoubleLine
data Header h = Header h | Group Properties [Header h]

{- |
> example = Table
>   (Group SingleLine
>      [ Group NoLine [Header "A 1", Header "A 2"]
>      , Group NoLine [Header "B 1", Header "B 2", Header "B 3"]
>      ])
>   (Group DoubleLine
>      [ Group SingleLine [Header "memtest 1", Header "memtest 2"]
>      , Group SingleLine [Header "time test 1", Header "time test 2"]
>      ])
>   [ ["hog", "terrible", "slow", "slower"]
>   , ["pig", "not bad",  "fast", "slowest"]
>   , ["good", "awful" ,  "intolerable", "bearable"]
>   , ["better", "no chance", "crawling", "amazing"]
>   , ["meh",  "well...", "worst ever", "ok"]
>   ]
> > putStr $ render id id id example
> +-----++-----------+-----------++-------------+-------------+
> |     || memtest 1 | memtest 2 || time test 1 | time test 2 |
> +=====++===========+===========++=============+=============+
> | A 1 ||       hog |  terrible ||        slow |      slower |
> | A 2 ||       pig |   not bad ||        fast |     slowest |
> +-----++-----------+-----------++-------------+-------------+
> | B 1 ||      good |     awful || intolerable |    bearable |
> | B 2 ||    better | no chance ||    crawling |     amazing |
> | B 3 ||       meh |   well... ||  worst ever |          ok |
> +-----++-----------+-----------++-------------+-------------+
-}
data Table rh ch a = Table (Header rh) (Header ch) [[a]]

-- * Helper functions for rendering

-- | Retrieve the contents of a  header
headerContents :: Header h -> [h]
headerContents :: Header h -> [h]
headerContents (Header s :: h
s) = [h
s]
headerContents (Group _ hs :: [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 f :: a -> b
f (Header s :: a
s) = b -> Header b
forall h. h -> Header h
Header (a -> b
f a
s)
 fmap f :: a -> b
f (Group p :: Properties
p hs :: [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' @e@ @ss@ @h@ returns the same structure
  as @h@ except with all the text replaced by the contents
  of @ss@.

  If @ss@ has too many cells, the excess is ignored.
  If it has too few cells, the missing ones (at the end)
  and replaced with the empty contents @e@.
-}
zipHeader :: h -> [h] -> Header a -> Header (h, a)
zipHeader :: h -> [h] -> Header a -> Header (h, a)
zipHeader e :: h
e ss :: [h]
ss h :: 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 b. Header b -> State [h] (Header (h, b))
helper Header a
h) [h]
ss
 where
  helper :: Header b -> State [h] (Header (h, b))
helper (Header x :: b
x) =
   do [h]
cells <- State [h] [h]
forall s. State s s
get
      (h, b)
string <- case [h]
cells of
                  [] -> (h, b) -> State [h] (h, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (h
e, b
x)
                  s :: h
s : xs :: [h]
xs -> [h] -> State [h] ()
forall s. s -> State s ()
put [h]
xs State [h] () -> State [h] (h, b) -> State [h] (h, b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (h, b) -> State [h] (h, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (h
s, b
x)
      Header (h, b) -> State [h] (Header (h, b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Header (h, b) -> State [h] (Header (h, b)))
-> Header (h, b) -> State [h] (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 s :: Properties
s hs :: [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))
-> State [h] [Header (h, b)] -> State [h] (Header (h, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Header b -> State [h] (Header (h, b)))
-> [Header b] -> State [h] [Header (h, b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Header b -> State [h] (Header (h, b))
helper [Header b]
hs

flattenHeader :: Header h -> [Either Properties h]
flattenHeader :: Header h -> [Either Properties h]
flattenHeader (Header s :: h
s) = [h -> Either Properties h
forall a b. b -> Either a b
Right h
s]
flattenHeader (Group l :: Properties
l s :: [Header h]
s) = [Either Properties h]
-> [[Either Properties h]] -> [Either Properties h]
forall a. [a] -> [[a]] -> [a]
intercalate [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

{- | The idea is to deal with the fact that Properties
  (e.g. borders) are not standalone cells but attributes
  of a cell.  A border is just a CSS decoration of a
  TD element.

  squish @decorator f h@ applies @f@ to every item
  in the list represented by @h@ (see 'flattenHeader'),
  additionally applying @decorator@ if the item is
  followed by some kind of boundary

  So
    @
    o o o | o o o | o o
    @
  gets converted into
    @
    O O X   O O X   O O
    @
-}
squish :: (Properties -> b -> b)
       -> (h -> b)
       -> Header h
       -> [b]
squish :: (Properties -> b -> b) -> (h -> b) -> Header h -> [b]
squish decorator :: Properties -> b -> b
decorator f :: h -> b
f h :: 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 _ : es :: [Either Properties h]
es) = [Either Properties h] -> [b]
helper [Either Properties h]
es
  helper (Right x :: h
x : es :: [Either Properties h]
es) =
   case [Either Properties h]
es of
     (Left p :: Properties
p : es2 :: [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
     _ -> h -> b
f h
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [Either Properties h] -> [b]
helper [Either Properties h]
es

-- * Combinators

{- | Convenience type for just one row (or column).
  To be used with combinators as follows:

> example2 =
>   empty ^..^ col "memtest 1" [] ^|^ col "memtest 2"   []
>         ^||^ col "time test "[] ^|^ col "time test 2" []
>   +.+ row "A 1" ["hog", "terrible", "slow", "slower"]
>   +.+ row "A 2" ["pig", "not bad", "fast", "slowest"]
>   +----+
>       row "B 1" ["good", "awful", "intolerable", "bearable"]
>   +.+ row "B 2" ["better", "no chance", "crawling", "amazing"]
>   +.+ row "B 3" ["meh",  "well...", "worst ever", "ok"]
-}
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 = Header ch -> [a] -> SemiTable ch a
forall h a. Header h -> [a] -> SemiTable h a
SemiTable (Header ch -> [a] -> SemiTable ch a)
-> (ch -> Header ch) -> ch -> [a] -> SemiTable ch a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ch -> Header ch
forall h. h -> Header h
Header

-- | Column header
colH :: ch -> SemiTable ch a
colH :: ch -> SemiTable ch a
colH header :: 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 prop :: Properties
prop (Table rows :: Header rh
rows cols1 :: Header ch
cols1 data1 :: [[a]]
data1)
            (SemiTable cols2 :: Header ch
cols2 data2 :: [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 prop :: Properties
prop (Table rows1 :: Header rh
rows1 cols :: Header ch
cols data1 :: [[a]]
data1)
           (SemiTable rows2 :: Header rh
rows2 data2 :: [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])

-- | besides
(^..^) :: 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

-- | besides with a line
(^|^) :: 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

-- | besides with a double line
(^||^) :: 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

-- | below
(+.+) :: 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

-- | below with a line
(+----+) :: 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

-- | below with a double line
(+====+) :: 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

-- * ascii art

-- | for simplicity, we assume that each cell is rendered on a single line
render :: (rh -> String)
       -> (ch -> String)
       -> (a -> String)
       -> Table rh ch a
       -> String
render :: (rh -> String)
-> (ch -> String) -> (a -> String) -> Table rh ch a -> String
render fr :: rh -> String
fr fc :: ch -> String
fc f :: a -> String
f (Table rh :: Header rh
rh ch :: Header ch
ch cells :: [[a]]
cells) =
  [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [ Properties -> String
bar Properties
SingleLine   -- +--------------------------------------+
            , [Int] -> Header String -> String
renderColumns [Int]
sizes Header String
ch2
            , Properties -> String
bar Properties
DoubleLine   -- +======================================+
            ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
            Header String -> [String]
renderRs ((([a], String) -> String) -> Header ([a], String) -> Header String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a], String) -> String
renderR (Header ([a], String) -> Header String)
-> Header ([a], String) -> Header String
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]] -> Header String -> Header ([a], String)
forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader [] [[a]]
cells (Header String -> Header ([a], String))
-> Header String -> Header ([a], String)
forall a b. (a -> b) -> a -> b
$ (rh -> String) -> Header rh -> Header String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap rh -> String
fr Header rh
rh) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
            [ Properties -> String
bar Properties
SingleLine ] -- +--------------------------------------+
 where
  bar :: Properties -> String
bar = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> (Properties -> [String]) -> Properties -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Header String -> Properties -> [String]
renderHLine [Int]
sizes Header String
ch2
  -- ch2 and cell2 include the row and column labels
  ch2 :: Header String
ch2 = Properties -> [Header String] -> Header String
forall h. Properties -> [Header h] -> Header h
Group Properties
DoubleLine [String -> Header String
forall h. h -> Header h
Header "", (ch -> String) -> Header ch -> Header String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ch -> String
fc Header ch
ch]
  cells2 :: [[String]]
cells2 = Header String -> [String]
forall h. Header h -> [h]
headerContents Header String
ch2
         [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: (String -> [a] -> [String]) -> [String] -> [[a]] -> [[String]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ h :: String
h cs :: [a]
cs -> String
h String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
f [a]
cs) [String]
rhStrings [[a]]
cells
  renderR :: ([a], String) -> String
renderR (cs :: [a]
cs, h :: String
h) = [Int] -> Header String -> String
renderColumns [Int]
sizes (Header String -> String) -> Header String -> String
forall a b. (a -> b) -> a -> b
$ Properties -> [Header String] -> Header String
forall h. Properties -> [Header h] -> Header h
Group Properties
DoubleLine
                    [ String -> Header String
forall h. h -> Header h
Header String
h
                    , ((String, ch) -> String) -> Header (String, ch) -> Header String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, ch) -> String
forall a b. (a, b) -> a
fst (Header (String, ch) -> Header String)
-> Header (String, ch) -> Header String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Header ch -> Header (String, ch)
forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader "" ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
f [a]
cs) Header ch
ch]
  rhStrings :: [String]
rhStrings = (rh -> String) -> [rh] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map rh -> String
fr ([rh] -> [String]) -> [rh] -> [String]
forall a b. (a -> b) -> a -> b
$ Header rh -> [rh]
forall h. Header h -> [h]
headerContents Header rh
rh
  -- maximum width for each column
  sizes :: [Int]
sizes = ([String] -> Int) -> [[String]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([String] -> [Int]) -> [String] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[String]] -> [Int])
-> ([[String]] -> [[String]]) -> [[String]] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [[String]]
forall a. [[a]] -> [[a]]
transpose ([[String]] -> [Int]) -> [[String]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[String]]
cells2
  renderRs :: Header String -> [String]
renderRs (Header s :: String
s) = [String
s]
  renderRs (Group p :: Properties
p hs :: [Header String]
hs) = [String] -> [[String]] -> [String]
forall a. [a] -> [[a]] -> [a]
intercalate [String]
sep ([[String]] -> [String])
-> ([Header String] -> [[String]]) -> [Header String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header String -> [String]) -> [Header String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map Header String -> [String]
renderRs ([Header String] -> [String]) -> [Header String] -> [String]
forall a b. (a -> b) -> a -> b
$ [Header String]
hs
    where sep :: [String]
sep = [Int] -> Header String -> Properties -> [String]
renderHLine [Int]
sizes Header String
ch2 Properties
p

-- | We stop rendering on the shortest list!
renderColumns :: [Int] -- ^ max width for each column
              -> Header String
              -> String
renderColumns :: [Int] -> Header String -> String
renderColumns is :: [Int]
is h :: Header String
h = "| " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
coreLine String -> String -> String
forall a. [a] -> [a] -> [a]
++ " |"
 where
  coreLine :: String
coreLine = (Either Properties (Int, String) -> String)
-> [Either Properties (Int, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either Properties (Int, String) -> String
helper ([Either Properties (Int, String)] -> String)
-> [Either Properties (Int, String)] -> String
forall a b. (a -> b) -> a -> b
$ Header (Int, String) -> [Either Properties (Int, String)]
forall h. Header h -> [Either Properties h]
flattenHeader (Header (Int, String) -> [Either Properties (Int, String)])
-> Header (Int, String) -> [Either Properties (Int, String)]
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> Header String -> Header (Int, String)
forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader 0 [Int]
is Header String
h
  padLeft :: (Int, String) -> String
padLeft (l :: Int
l, s :: String
s) = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) ' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
  helper :: Either Properties (Int, String) -> String
helper = (Properties -> String)
-> ((Int, String) -> String)
-> Either Properties (Int, String)
-> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Properties -> String
hsep (Int, String) -> String
padLeft
  hsep :: Properties -> String
  hsep :: Properties -> String
hsep NoLine = " "
  hsep SingleLine = " | "
  hsep DoubleLine = " || "

renderHLine :: [Int] -- ^ width specifications
            -> Header String
            -> Properties
            -> [String]
renderHLine :: [Int] -> Header String -> Properties -> [String]
renderHLine _ _ NoLine = []
renderHLine w :: [Int]
w h :: Header String
h SingleLine = [[Int] -> Char -> Header String -> String
renderHLine' [Int]
w '-' Header String
h]
renderHLine w :: [Int]
w h :: Header String
h DoubleLine = [[Int] -> Char -> Header String -> String
renderHLine' [Int]
w '=' Header String
h]

renderHLine' :: [Int] -> Char -> Header String -> String
renderHLine' :: [Int] -> Char -> Header String -> String
renderHLine' is :: [Int]
is sep :: Char
sep h :: Header String
h = [ '+', Char
sep ] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
coreLine String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
sep, '+']
 where
  coreLine :: String
coreLine = (Either Properties (Int, String) -> String)
-> [Either Properties (Int, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either Properties (Int, String) -> String
forall b. Either Properties (Int, b) -> String
helper ([Either Properties (Int, String)] -> String)
-> [Either Properties (Int, String)] -> String
forall a b. (a -> b) -> a -> b
$ Header (Int, String) -> [Either Properties (Int, String)]
forall h. Header h -> [Either Properties h]
flattenHeader (Header (Int, String) -> [Either Properties (Int, String)])
-> Header (Int, String) -> [Either Properties (Int, String)]
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> Header String -> Header (Int, String)
forall h a. h -> [h] -> Header a -> Header (h, a)
zipHeader 0 [Int]
is Header String
h
  helper :: Either Properties (Int, b) -> String
helper = (Properties -> String)
-> ((Int, b) -> String) -> Either Properties (Int, b) -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Properties -> String
vsep (Int, b) -> String
forall b. (Int, b) -> String
dashes
  dashes :: (Int, b) -> String
dashes (i :: Int
i, _) = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
sep
  vsep :: Properties -> String
vsep NoLine = [Char
sep]
  vsep SingleLine = Char
sep Char -> String -> String
forall a. a -> [a] -> [a]
: '+' Char -> String -> String
forall a. a -> [a] -> [a]
: [Char
sep]
  vsep DoubleLine = Char
sep Char -> String -> String
forall a. a -> [a] -> [a]
: "++" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
sep]