module Penny.Cabin.Row (
Justification(LeftJustify, RightJustify),
ColumnSpec(ColumnSpec, justification, width, padSpec, bits),
Width(Width, unWidth),
row ) where
import Data.List (transpose)
import Data.Monoid (mempty)
import qualified Data.Text as X
import qualified Penny.Cabin.Scheme as E
import qualified System.Console.Rainbow as R
data Justification =
LeftJustify
| RightJustify
deriving Show
data ColumnSpec =
ColumnSpec { justification :: Justification
, width :: Width
, padSpec :: (E.Label, E.EvenOdd)
, bits :: [R.Chunk] }
newtype JustifiedCell = JustifiedCell (R.Chunk, R.Chunk)
data JustifiedColumn = JustifiedColumn {
justifiedCells :: [JustifiedCell]
, _justifiedWidth :: Width
, _justifiedPadSpec :: (E.Label, E.EvenOdd) }
newtype PaddedColumns = PaddedColumns [[JustifiedCell]]
newtype CellsByRow = CellsByRow [[JustifiedCell]]
newtype CellRowsWithNewlines = CellRowsWithNewlines [[JustifiedCell]]
newtype Width = Width { unWidth :: Int }
deriving (Eq, Ord, Show)
justify
:: Width
-> Justification
-> E.Label
-> E.EvenOdd
-> E.Changers
-> R.Chunk
-> JustifiedCell
justify (Width w) j l eo chgrs pc = JustifiedCell (left, right)
where
origWidth = X.length . R.text $ pc
pad = E.getEvenOddLabelValue l eo chgrs . R.Chunk mempty $ t
t = X.replicate (max 0 (w origWidth)) (X.singleton ' ')
(left, right) = case j of
LeftJustify -> (pc, pad)
RightJustify -> (pad, pc)
newtype Height = Height Int
deriving (Show, Eq, Ord)
height :: [[a]] -> Height
height xs = case xs of
[] -> Height 0
ls -> Height . maximum . map length $ ls
row :: E.Changers -> [ColumnSpec] -> [R.Chunk]
row chgrs =
concat
. concat
. toBits
. toCellRowsWithNewlines
. toCellsByRow
. bottomPad chgrs
. map (justifiedColumn chgrs)
justifiedColumn :: E.Changers -> ColumnSpec -> JustifiedColumn
justifiedColumn chgrs (ColumnSpec j w (l, eo) bs)
= JustifiedColumn cs w (l, eo)
where
cs = map (justify w j l eo chgrs) bs
bottomPad :: E.Changers -> [JustifiedColumn] -> PaddedColumns
bottomPad chgrs jcs = PaddedColumns pcs where
justCells = map justifiedCells jcs
(Height h) = height justCells
pcs = map toPaddedColumn jcs
toPaddedColumn (JustifiedColumn cs (Width w) (lbl, eo)) =
let l = length cs
nPads = max 0 $ h l
pad = E.getEvenOddLabelValue lbl eo chgrs . R.Chunk mempty $ t
t = X.replicate w (X.singleton ' ')
pads = replicate nPads $ JustifiedCell (mempty, pad)
in cs ++ pads
toCellsByRow :: PaddedColumns -> CellsByRow
toCellsByRow (PaddedColumns cs) = CellsByRow (transpose cs)
toCellRowsWithNewlines :: CellsByRow -> CellRowsWithNewlines
toCellRowsWithNewlines (CellsByRow bs) =
CellRowsWithNewlines bs' where
bs' = foldr f [] bs
newline = JustifiedCell (mempty, "\n")
f cells acc = (cells ++ [newline]) : acc
toBits :: CellRowsWithNewlines -> [[[R.Chunk]]]
toBits (CellRowsWithNewlines cs) = map (map toB) cs where
toB (JustifiedCell (c1, c2)) = [c1, c2]