    -- | Note: the core types and comibnators
    --   from this module are from Toxaris in a #haskell
    --   conversation on 2008-08-24
    {-# 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 Header h = Header 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)

    -- |
    -- > 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"]
    -- >   ]
    --
    -- > -- Text.Tabular.AsciiArt.render id id id example
    -- > --
    -- > --     || memtest 1 | memtest 2 ||  time test  | 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]]
                       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)

    -- ----------------------------------------------------------------------
    -- * Helper functions for rendering
    -- ----------------------------------------------------------------------

    -- | Retrieve the contents of a  header
    headerContents :: Header h -> [h]
    headerContents :: forall h. Header h -> [h]
    headerContents (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' @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 :: forall h a. h -> [h] -> Header a -> Header (h, a)
    zipHeader 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]
    flattenHeader :: forall h. Header h -> [Either Properties h]
    flattenHeader (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

    -- | 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 :: 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

    -- ----------------------------------------------------------------------
    -- * 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]
                       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

    -- | Column header
    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])

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

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