{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, ScopedTypeVariables #-}
module Data.Spreadsheet (
ToCell(..),ToRow(..),ToSheet(..),
StaticCellValue(..),
cellBool,cellNumber,cellText,cellTime,
StaticRow,StaticSheet,SheetChunk,
chunksToSheet) where
import Data.Time
import Data.Traversable
import Data.Foldable
import Data.Word
import Data.Sequence (Seq)
import qualified Data.Text as T
import Control.Arrow (second)
data StaticCellValue = CellBool Bool
| CellNumber Rational
| CellText String
| CellTime ZonedTime deriving (Show)
type StaticRow = [(Word64,StaticCellValue)]
type StaticSheet = [(Word64,StaticRow)]
type SheetChunk = Seq StaticRow
chunksToSheet :: (Traversable f, Traversable chunk, Monoid (chunk (Word64,row)), ToSheet row sheet) =>
f (chunk row) -> sheet
chunksToSheet = rowMap . foldMap id . snd . mapAccumL (\n chunk -> addIndexFrom n chunk) 1
class ToCell cell where
staticCell :: StaticCellValue -> cell
instance ToCell StaticCellValue where
staticCell = id
instance ToCell T.Text where
staticCell (CellBool b) = T.pack . quote . show $ b
staticCell (CellNumber n) = T.pack . show . (fromRational :: Rational -> Double) $ n
staticCell (CellText s) = T.pack . quote . escapeSemicolon $ s
staticCell (CellTime t) = T.pack . quote . show $ t
escapeSemicolon :: String -> String
escapeSemicolon = (=<<) e where
e ';' = "\\;"
e '\\' = "\\\\"
e c = [c]
quote :: String -> String
quote = (flip (++) "\"").('"':)
cellBool :: ToCell cell => Bool -> cell
cellBool = staticCell . CellBool
cellNumber :: ToCell cell => Rational -> cell
cellNumber = staticCell . CellNumber
cellText :: ToCell cell => String -> cell
cellText = staticCell . CellText
cellTime :: ToCell cell => ZonedTime -> cell
cellTime = staticCell . CellTime
class ToRow cell row where
cellList :: Traversable f => f cell -> row
cellList = cellMap . snd . addIndexFrom 1
cellMap :: Traversable f => f (Word64,cell) -> row
instance ToRow cell [(Word64,cell)] where
cellMap = Data.Foldable.toList
instance ToRow T.Text T.Text where
cellMap = concatWithFrom (T.pack ";") 1
instance ToRow StaticCellValue T.Text where
cellMap = concatWithFrom (T.pack ";") 1 . fmap (second staticCell)
class ToSheet row sheet where
rowList :: Traversable f => f row -> sheet
rowList = rowMap . snd . addIndexFrom 1
rowMap :: Traversable f => f (Word64,row) -> sheet
instance ToSheet row [(Word64,row)] where
rowMap = Data.Foldable.toList
instance ToSheet T.Text T.Text where
rowMap = concatWithFrom (T.pack "\n") 1
addIndexFrom :: Traversable f => Word64 -> f b -> (Word64, f (Word64,b))
addIndexFrom i = mapAccumL (\n x -> (n+1,(n,x))) i
concatWithFrom :: (Traversable t, Monoid a) => a -> Int -> t (Word64,a) -> a
concatWithFrom sep i = foldMap id . snd . mapAccumL f i where
f i (j,x) = let j' = fromIntegral j in (j',mconcat (replicate (j'-i) sep) `mappend` x)