-- | This module provides primitives for generating tables. Tables are generated
-- line by line thus the functions in this module produce 'StringBuilder's that
-- contain a line.
module Text.Layout.Table.Primitives.Table
    ( horizontalDetailLine
    , horizontalContentLine
    ) where

import           Text.Layout.Table.StringBuilder
import           Text.Layout.Table.Spec.Util


-- | Draw a horizontal line that will use the provided delimiters around
-- the content appropriately and visually separate by 'hSpace'.
horizontalDetailLine
    :: StringBuilder b
    => String                            -- ^ The space characters that are used as padding.
    -> String                            -- ^ The space characters that are used as padding in the row header.
    -> String                            -- ^ The delimiter that is used on the left side.
    -> String                            -- ^ The delimiter that is used on the right side.
    -> String                            -- ^ The delimiter that is used for the row header separator.
    -> (Maybe b, Row (Either String b))  -- ^ Optionally a row header, along with a row of builders and separators.
    -> b                                 -- ^ The formatted line as a 'StringBuilder'.
horizontalDetailLine :: forall b.
StringBuilder b =>
String
-> String
-> String
-> String
-> String
-> (Maybe b, Row (Either String b))
-> b
horizontalDetailLine String
hSpace String
hSepSpace String
delimL String
delimR String
delimSep (Maybe b
header, Row (Either String b)
cells) =
    String -> b
forall a. StringBuilder a => String -> a
stringB String
delimL b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
renderedHeader b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
renderedCells b -> b -> b
forall a. Semigroup a => a -> a -> a
<> String -> b
forall a. StringBuilder a => String -> a
stringB String
delimR
  where
    renderedHeader :: b
renderedHeader = case Maybe b
header of
      Maybe b
Nothing -> b
forall a. Monoid a => a
mempty
      Just b
r  -> String -> b
forall a. StringBuilder a => String -> a
stringB String
hSepSpace b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
r b -> b -> b
forall a. Semigroup a => a -> a -> a
<> String -> b
forall a. StringBuilder a => String -> a
stringB String
hSepSpace b -> b -> b
forall a. Semigroup a => a -> a -> a
<> String -> b
forall a. StringBuilder a => String -> a
stringB String
delimSep
    renderedCells :: b
renderedCells = (Either String b -> b) -> Row (Either String b) -> b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((String -> b
forall a. StringBuilder a => String -> a
stringB String
hSpace b -> b -> b
forall a. Semigroup a => a -> a -> a
<>) (b -> b) -> (Either String b -> b) -> Either String b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> b) -> (b -> b) -> Either String b -> b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> b
forall a. StringBuilder a => String -> a
stringB b -> b
forall a. a -> a
id) Row (Either String b)
cells b -> b -> b
forall a. Semigroup a => a -> a -> a
<> String -> b
forall a. StringBuilder a => String -> a
stringB String
hSpace

-- | Render a line with actual content.
horizontalContentLine
    :: StringBuilder b
    => String                            -- ^ The delimiter that is used on the left side.
    -> String                            -- ^ The delimiter that is used on the right side.
    -> String                            -- ^ The delimiter that is used on the row header separator.
    -> (Maybe b, Row (Either String b))  -- ^ A row of builders and separators.
    -> b
horizontalContentLine :: forall b.
StringBuilder b =>
String -> String -> String -> (Maybe b, Row (Either String b)) -> b
horizontalContentLine = String
-> String
-> String
-> String
-> String
-> (Maybe b, Row (Either String b))
-> b
forall b.
StringBuilder b =>
String
-> String
-> String
-> String
-> String
-> (Maybe b, Row (Either String b))
-> b
horizontalDetailLine String
" " String
" "