----------------------------------------------------------------------------- -- Copyright 2019, Advise-Me project team. This file is distributed under -- the terms of the Apache License 2.0. For more information, see the files -- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution. ----------------------------------------------------------------------------- -- | -- Maintainer : bastiaan.heeren@ou.nl -- Stability : provisional -- Portability : portable (depends on ghc) -- -- This module produces tabular data in HTML or CSV format. -- ----------------------------------------------------------------------------- -- Makes things hard to read, please eliminate it if you have the chance. 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 -- | A 'Table' is simply a 'M.Map' representing a tabular structure. newtype Table row col cell = Table { mapping :: M.Map (row, col) cell } -- | Create a 'Table' from a list. fromList :: (Ord row, Ord col) => [((row, col), cell)] -> Table row col cell fromList = Table . M.fromList -- | Obtain an empty 'Table'. empty :: Table row col cell empty = Table M.empty -- | Get a list of all row headers. rowHeaders :: (Eq row) => Table row col cell -> [row] rowHeaders = nub . map fst . M.keys . mapping -- | Get a list of all column headers. colHeaders :: (Eq col) => Table row col cell -> [col] colHeaders = nub . map snd . M.keys . mapping -- | Turn a foldable collection of data into a tabular structure. 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 -- | Turn a foldable collection of data into a tabular structure, where every -- element of the collection contains multiple columns. 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 -- | Turn a foldable collection of data into a tabular structure, where every -- element of the collection contains multiple rows. 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 -- | Add a row to a 'Table'. 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) -- | Add a column to a 'Table'. 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) -- | Add a cell to a 'Table'. 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 -- | Obtain the cell at (row, col). get :: (Ord row, Ord col) => row -> col -> Table row col cell -> Maybe cell get row col = M.lookup (row,col) . mapping -- | Format a 'Table' as HTML. 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' ] -- | Format a 'Table' as CSV. 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' ]