Tabular.hs

-----------------------------------------------------------------------------
--
-- Module      :  Data.Tabular
-- Copyright   :  (c) 2014-16 Brian W Bush
-- License     :  MIT
--
-- Maintainer  :  Brian W Bush <consult@brianwbush.info>
-- Stability   :  Experimental
-- Portability :  Portable
--
-- | Formatting and parsing data in tabular format.
--
-----------------------------------------------------------------------------


{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE Safe                 #-}
{-# LANGUAGE TupleSections        #-}
{-# LANGUAGE UndecidableInstances #-}


module Data.Tabular {-# DEPRECATED "This module will be replaced in a future release." #-} (
-- * Types
  Rows(..)
, Row(..)
, Cell(..)
, Tabular(..)
-- * Input/Output Functions
, readTabular
, writeTabular
) where


import Control.Monad (ap, liftM)
import Data.List (intercalate)
import Data.List.Split (splitOn)


-- | Rows of data.
newtype Rows = Rows {unRows :: [Row]}
  deriving Eq

instance Read Rows where
  readsPrec _ = return . (, "") . Rows . map read . lines

instance Show Rows where
  show = unlines . map show . unRows


-- | A row of data.
newtype Row = Row {unRow :: [String]}
  deriving Eq

instance Read Row where
  readsPrec _ = return . (, "") . Row . splitOn tab

instance Show Row where
  show = intercalate tab . unRow


-- | Tab character used for separating columns.
tab :: String
tab = "\t"


-- | Class for data in tabular format.
class Tabular a where

  -- | Encode a row of data.
  toRow :: a -> Row

  -- | Decode a row of data.
  fromRow :: Row -> a

  -- | Encode rows, prefixing with header.
  withHeader :: [a] -> Rows
  withHeader = Rows . (Row ["<<UNDEFINED HEADER>>"] :) . map toRow

  -- | Decode rows, stripping a prefixed header.
  checkHeader :: Rows -> [a]
  checkHeader = map fromRow . tail . unRows

instance (Cell a, Monad ((->) [[a]])) => Tabular [a] where
  toRow = Row . map toCell
  fromRow = map fromCell . unRow
  withHeader = Rows . ap ((:) . Row . map (const "<<UNDEFINED COLUMN>>") . head) (map toRow)

instance (Cell a, Cell b) => Tabular (a, b) where
  toRow (x, y) = Row [toCell x, toCell y]
  fromRow (Row [x, y]) = (fromCell x, fromCell y)
  fromRow (Row t) = error $ "not a doublet" ++ show t

instance (Cell a, Cell b, Cell c) => Tabular (a, b, c) where
  toRow (x, y, z) = Row [toCell x, toCell y, toCell z]
  fromRow (Row [x, y, z]) = (fromCell x, fromCell y, fromCell z)
  fromRow (Row t) = error $ "not a triplet: " ++ show t

instance (Cell a, Cell b, Cell c, Cell d) => Tabular (a, b, c, d) where
  toRow (x, y, z, w) = Row [toCell x, toCell y, toCell z, toCell w]
  fromRow (Row [x, y, z, w]) = (fromCell x, fromCell y, fromCell z, fromCell w)
  fromRow (Row t) = error $ "not a quadruplet: " ++ show t


-- | Class for formatting and parsing cells in a table.
class Cell a where
  -- | Encode a data cell.
  toCell :: a -> String
  -- | Decode a data cell.
  fromCell :: String -> a

instance (Read a, Show a) => Cell a where
  fromCell = read
  toCell = show


-- | Read tabular data.
readTabular :: Tabular a
  => FilePath -- ^ The filename.
  -> IO [a]   -- ^ Action to read the data.
readTabular = liftM (checkHeader . read) . readFile


-- | Write tabular data.
writeTabular :: Tabular a
  => FilePath -- ^ The filename.
  -> [a]      -- ^ The data.
  -> IO ()    -- ^ The action to write the data.
writeTabular = (. (show . withHeader)) . writeFile