module Util.TableData
( Table(Table)
, fromList
, toTable
, toTableFromRows
, toTableFromCols
, empty
, get
, colHeaders
, rowHeaders
, addRow
, addCol
, addCell
, htmlTable
, csvTable ) where
import Data.List (foldl', nub, intercalate)
import qualified Data.Map as M
import Ideas.Text.XML (tag, string)
import Ideas.Text.HTML (HTMLBuilder)
import qualified Ideas.Text.HTML.W3CSS as W3
newtype Table row col cell = Table
{ mapping :: M.Map (row, col) cell }
fromList :: (Ord row, Ord col)
=> [((row, col), cell)]
-> Table row col cell
fromList = Table . M.fromList
empty :: Table row col cell
empty = Table M.empty
rowHeaders :: (Eq row) => Table row col cell -> [row]
rowHeaders = nub . map fst . M.keys . mapping
colHeaders :: (Eq col) => Table row col cell -> [col]
colHeaders = nub . map snd . M.keys . mapping
toTable :: (Foldable t, Ord row, Ord col)
=> (a -> row)
-> (a -> col)
-> (a -> cell)
-> t a
-> Table row col cell
toTable extractRow extractCol extractCell =
let f xs x = addCell (extractCell x) (extractRow x) (extractCol x) xs
in foldl' f empty
toTableFromRows :: (Foldable t, Foldable t', Ord row, Ord col)
=> (a -> row)
-> (a -> t' (col, cell))
-> t a
-> Table row col cell
toTableFromRows extractRow extractCols =
let f xs x = addRow (extractRow x) (extractCols x) xs
in foldl' f empty
toTableFromCols :: (Foldable t, Foldable t', Ord row, Ord col)
=> (a -> col)
-> (a -> t' (row, cell))
-> t a
-> Table row col cell
toTableFromCols extractCol extractRows =
let f xs x = addCol (extractCol x) (extractRows x) xs
in foldl' f empty
addRow :: (Foldable t, Ord row, Ord col)
=> row
-> t (col, cell)
-> Table row col cell
-> Table row col cell
addRow row = flip $ foldl' (\t (col, cell) -> addCell cell row col t)
addCol :: (Foldable t, Ord row, Ord col)
=> col
-> t (row, cell)
-> Table row col cell
-> Table row col cell
addCol col = flip $ foldl' (\t (row, cell) -> addCell cell row col t)
addCell :: (Ord row, Ord col)
=> cell -> row -> col
-> Table row col cell
-> Table row col cell
addCell cell row col = Table . M.insert (row, col) cell . mapping
get :: (Ord row, Ord col) => row -> col -> Table row col cell -> Maybe cell
get row col = M.lookup (row,col) . mapping
htmlTable :: (Ord row, Ord col)
=> (row -> HTMLBuilder)
-> (col -> HTMLBuilder)
-> (cell -> HTMLBuilder)
-> Table row col cell
-> HTMLBuilder
htmlTable buildRow buildCol buildCell table' = W3.tableAll . mconcat $
( tag "th" . mconcat . map (tag "td" . buildCol) $ colHeaders table' )
:
[ tag "tr" . mconcat $
tag "td" (buildRow row')
:
[ tag "td" (maybe (W3.textColor W3.Gray $ string "x") buildCell $ get row' col' table')
| col' <- colHeaders table'
]
| row' <- rowHeaders table'
]
csvTable :: (Ord row, Ord col)
=> (row -> String)
-> (col -> String)
-> (cell -> String)
-> Table row col cell
-> String
csvTable buildRow buildCol buildCell table' = intercalate "\r\n" . map (intercalate ",") $
( "" : map buildCol (colHeaders table'))
:
[ buildRow row'
:
[ maybe "" buildCell $ get row' col' table'
| col' <- colHeaders table'
]
| row' <- rowHeaders table'
]