TableData.hs

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