{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, ScopedTypeVariables #-}
{-|
Module      : Data.Spreadsheet
Description : Least common denominator of spreadsheet formats
Copyright   : (c) Olaf Klinke
License     : GPL-3
Maintainer  : olaf.klinke@phymetric.de
Stability   : experimental

Various formats for spreadsheet exist, e.g. 
the open office (xlsx) format, 
the Microsoft SpreadsheetML format, 
the binary Microsoft xls format 
and CSV. 

This module defines the least common denominator of static cell data. 
The intention is to use chunks of rows as alternative representation type 
in your ProvenienceT transformer. 
After performing the computation, extract all the spreasheet chunks 
and combine into a worksheet using 'chunksToSheet'. 

For example, in order to use the types of the <http://hackage.haskell.org/package/xlsx xlsx> package 
which exports the @Cell@ and @CellMap@ types, you should provide the following instances. 

@
instance ToCell Cell where
instance ToSheet 'StaticRow' CellMap where
   rowMap = Data.Map.fromList . foldMap (\\(rowidx,row) -> map (\\(colidx,val) -> ((fromIntegral rowidx,fromIntegral colidx),'staticCell' val)) row)
@

where the first instance aids in writing the second instance. 
Then you can use 'SheetChunk' as alternative representation and 
produce a @CellMap@ using 'chunksToSheet'.
-}
module Data.Spreadsheet (
    -- * Speadsheet type classes
    ToCell(..),ToRow(..),ToSheet(..),
    -- * Concrete spreadsheet types
    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)

-- | A static cell value, the initial object of the 'ToCell' class.
data StaticCellValue = CellBool Bool 
    | CellNumber Rational
    | CellText String
    | CellTime ZonedTime deriving (Int -> StaticCellValue -> ShowS
[StaticCellValue] -> ShowS
StaticCellValue -> String
(Int -> StaticCellValue -> ShowS)
-> (StaticCellValue -> String)
-> ([StaticCellValue] -> ShowS)
-> Show StaticCellValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaticCellValue] -> ShowS
$cshowList :: [StaticCellValue] -> ShowS
show :: StaticCellValue -> String
$cshow :: StaticCellValue -> String
showsPrec :: Int -> StaticCellValue -> ShowS
$cshowsPrec :: Int -> StaticCellValue -> ShowS
Show)

-- | generic row type: list of cells with column numbers
type StaticRow = [(Word64,StaticCellValue)]
-- | generic sheet type: list of rows with row numbers
type StaticSheet = [(Word64,StaticRow)]
-- | Part of a spreadsheet which does not yet know 
-- its absolute row numbers. 
type SheetChunk = Seq StaticRow
-- | Combine several chunks into a worksheet, e.g. 
-- 
-- @
-- 'chunksToSheet' :: ['SheetChunk'] -> 'StaticSheet'
-- @
chunksToSheet :: (Traversable f, Traversable chunk, Monoid (chunk (Word64,row)), ToSheet row sheet) => 
    f (chunk row) -> sheet
chunksToSheet :: f (chunk row) -> sheet
chunksToSheet = chunk (Word64, row) -> sheet
forall row sheet (f :: * -> *).
(ToSheet row sheet, Traversable f) =>
f (Word64, row) -> sheet
rowMap (chunk (Word64, row) -> sheet)
-> (f (chunk row) -> chunk (Word64, row)) -> f (chunk row) -> sheet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (chunk (Word64, row) -> chunk (Word64, row))
-> f (chunk (Word64, row)) -> chunk (Word64, row)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap chunk (Word64, row) -> chunk (Word64, row)
forall a. a -> a
id (f (chunk (Word64, row)) -> chunk (Word64, row))
-> (f (chunk row) -> f (chunk (Word64, row)))
-> f (chunk row)
-> chunk (Word64, row)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, f (chunk (Word64, row))) -> f (chunk (Word64, row))
forall a b. (a, b) -> b
snd ((Word64, f (chunk (Word64, row))) -> f (chunk (Word64, row)))
-> (f (chunk row) -> (Word64, f (chunk (Word64, row))))
-> f (chunk row)
-> f (chunk (Word64, row))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> chunk row -> (Word64, chunk (Word64, row)))
-> Word64 -> f (chunk row) -> (Word64, f (chunk (Word64, row)))
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (\Word64
n chunk row
chunk -> Word64 -> chunk row -> (Word64, chunk (Word64, row))
forall (f :: * -> *) b.
Traversable f =>
Word64 -> f b -> (Word64, f (Word64, b))
addIndexFrom Word64
n chunk row
chunk) Word64
1

-- | Cell type supporting static values: Booleans, Numbers, Text and Time. 
class ToCell cell where
    staticCell :: StaticCellValue -> cell
instance ToCell StaticCellValue where
    staticCell :: StaticCellValue -> StaticCellValue
staticCell = StaticCellValue -> StaticCellValue
forall a. a -> a
id
-- | for building CSV data
instance ToCell T.Text where
    staticCell :: StaticCellValue -> Text
staticCell (CellBool Bool
b)   = String -> Text
T.pack (String -> Text) -> (Bool -> String) -> Bool -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
quote ShowS -> (Bool -> String) -> Bool -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
forall a. Show a => a -> String
show (Bool -> Text) -> Bool -> Text
forall a b. (a -> b) -> a -> b
$ Bool
b
    staticCell (CellNumber Rational
n) = String -> Text
T.pack (String -> Text) -> (Rational -> String) -> Rational -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show (Double -> String) -> (Rational -> Double) -> Rational -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational :: Rational -> Double) (Rational -> Text) -> Rational -> Text
forall a b. (a -> b) -> a -> b
$ Rational
n
    staticCell (CellText String
s)   = String -> Text
T.pack (String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
quote ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
escapeSemicolon (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
s
    staticCell (CellTime ZonedTime
t)   = String -> Text
T.pack (String -> Text) -> (ZonedTime -> String) -> ZonedTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
quote ShowS -> (ZonedTime -> String) -> ZonedTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> String
forall a. Show a => a -> String
show (ZonedTime -> Text) -> ZonedTime -> Text
forall a b. (a -> b) -> a -> b
$ ZonedTime
t

escapeSemicolon :: String -> String
escapeSemicolon :: ShowS
escapeSemicolon = (Char -> String) -> ShowS
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) Char -> String
e where
    e :: Char -> String
e Char
';' = String
"\\;"
    e Char
'\\' = String
"\\\\"
    e Char
c = [Char
c]
quote :: String -> String
quote :: ShowS
quote = ((String -> ShowS) -> String -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> ShowS
forall a. [a] -> [a] -> [a]
(++) String
"\"")ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Char
'"'Char -> ShowS
forall a. a -> [a] -> [a]
:)

cellBool :: ToCell cell => Bool -> cell
cellBool :: Bool -> cell
cellBool = StaticCellValue -> cell
forall cell. ToCell cell => StaticCellValue -> cell
staticCell (StaticCellValue -> cell)
-> (Bool -> StaticCellValue) -> Bool -> cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> StaticCellValue
CellBool
cellNumber :: ToCell cell => Rational -> cell
cellNumber :: Rational -> cell
cellNumber = StaticCellValue -> cell
forall cell. ToCell cell => StaticCellValue -> cell
staticCell (StaticCellValue -> cell)
-> (Rational -> StaticCellValue) -> Rational -> cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> StaticCellValue
CellNumber
cellText :: ToCell cell => String -> cell
cellText :: String -> cell
cellText = StaticCellValue -> cell
forall cell. ToCell cell => StaticCellValue -> cell
staticCell (StaticCellValue -> cell)
-> (String -> StaticCellValue) -> String -> cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StaticCellValue
CellText
cellTime :: ToCell cell => ZonedTime -> cell
cellTime :: ZonedTime -> cell
cellTime = StaticCellValue -> cell
forall cell. ToCell cell => StaticCellValue -> cell
staticCell (StaticCellValue -> cell)
-> (ZonedTime -> StaticCellValue) -> ZonedTime -> cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> StaticCellValue
CellTime

-- | A @row@ holding several @cell@s
class ToRow cell row where
    cellList :: Traversable f => f cell -> row
    -- ^ default is to number consecutively from 1
    cellList = f (Word64, cell) -> row
forall cell row (f :: * -> *).
(ToRow cell row, Traversable f) =>
f (Word64, cell) -> row
cellMap (f (Word64, cell) -> row)
-> (f cell -> f (Word64, cell)) -> f cell -> row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, f (Word64, cell)) -> f (Word64, cell)
forall a b. (a, b) -> b
snd ((Word64, f (Word64, cell)) -> f (Word64, cell))
-> (f cell -> (Word64, f (Word64, cell)))
-> f cell
-> f (Word64, cell)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> f cell -> (Word64, f (Word64, cell))
forall (f :: * -> *) b.
Traversable f =>
Word64 -> f b -> (Word64, f (Word64, b))
addIndexFrom Word64
1
    cellMap :: Traversable f => f (Word64,cell) -> row
instance ToRow cell [(Word64,cell)] where
    cellMap :: f (Word64, cell) -> [(Word64, cell)]
cellMap = f (Word64, cell) -> [(Word64, cell)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList
-- | separates cells with semicolons
instance ToRow T.Text T.Text where
    cellMap :: f (Word64, Text) -> Text
cellMap = Text -> Int -> f (Word64, Text) -> Text
forall (t :: * -> *) a.
(Traversable t, Monoid a) =>
a -> Int -> t (Word64, a) -> a
concatWithFrom (String -> Text
T.pack String
";") Int
1 
instance ToRow StaticCellValue T.Text where
    cellMap :: f (Word64, StaticCellValue) -> Text
cellMap = Text -> Int -> f (Word64, Text) -> Text
forall (t :: * -> *) a.
(Traversable t, Monoid a) =>
a -> Int -> t (Word64, a) -> a
concatWithFrom (String -> Text
T.pack String
";") Int
1 (f (Word64, Text) -> Text)
-> (f (Word64, StaticCellValue) -> f (Word64, Text))
-> f (Word64, StaticCellValue)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, StaticCellValue) -> (Word64, Text))
-> f (Word64, StaticCellValue) -> f (Word64, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((StaticCellValue -> Text)
-> (Word64, StaticCellValue) -> (Word64, Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second StaticCellValue -> Text
forall cell. ToCell cell => StaticCellValue -> cell
staticCell)

-- | A worksheet @sheet@ holding several @row@s. 
-- Assemble a worksheet from cells using e.g. either of 
-- 
-- @
-- import Control.Arrow (second)
-- 'rowMap'  . 'fmap' (second 'cellMap')
-- 'rowList' . 'fmap' 'cellList'
-- @
class ToSheet row sheet where
    rowList :: Traversable f => f row -> sheet
    -- ^ default is to number consecutively from 1
    rowList = f (Word64, row) -> sheet
forall row sheet (f :: * -> *).
(ToSheet row sheet, Traversable f) =>
f (Word64, row) -> sheet
rowMap (f (Word64, row) -> sheet)
-> (f row -> f (Word64, row)) -> f row -> sheet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64, f (Word64, row)) -> f (Word64, row)
forall a b. (a, b) -> b
snd ((Word64, f (Word64, row)) -> f (Word64, row))
-> (f row -> (Word64, f (Word64, row))) -> f row -> f (Word64, row)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> f row -> (Word64, f (Word64, row))
forall (f :: * -> *) b.
Traversable f =>
Word64 -> f b -> (Word64, f (Word64, b))
addIndexFrom Word64
1 
    rowMap :: Traversable f => f (Word64,row) -> sheet
instance ToSheet row [(Word64,row)] where
    rowMap :: f (Word64, row) -> [(Word64, row)]
rowMap = f (Word64, row) -> [(Word64, row)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList
-- | separates rows by newlines
instance ToSheet T.Text T.Text where
    rowMap :: f (Word64, Text) -> Text
rowMap = Text -> Int -> f (Word64, Text) -> Text
forall (t :: * -> *) a.
(Traversable t, Monoid a) =>
a -> Int -> t (Word64, a) -> a
concatWithFrom (String -> Text
T.pack String
"\n") Int
1

addIndexFrom :: Traversable f => Word64 -> f b -> (Word64, f (Word64,b))
addIndexFrom :: Word64 -> f b -> (Word64, f (Word64, b))
addIndexFrom Word64
i = (Word64 -> b -> (Word64, (Word64, b)))
-> Word64 -> f b -> (Word64, f (Word64, b))
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (\Word64
n b
x -> (Word64
nWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+Word64
1,(Word64
n,b
x))) Word64
i

-- concat with the right number of separators
concatWithFrom :: (Traversable t, Monoid a) => a -> Int -> t (Word64,a) -> a
concatWithFrom :: a -> Int -> t (Word64, a) -> a
concatWithFrom a
sep Int
i = (a -> a) -> t a -> a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> a
forall a. a -> a
id (t a -> a) -> (t (Word64, a) -> t a) -> t (Word64, a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, t a) -> t a
forall a b. (a, b) -> b
snd ((Int, t a) -> t a)
-> (t (Word64, a) -> (Int, t a)) -> t (Word64, a) -> t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (Word64, a) -> (Int, a))
-> Int -> t (Word64, a) -> (Int, t a)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Int -> (Word64, a) -> (Int, a)
forall a. Integral a => Int -> (a, a) -> (Int, a)
f Int
i where
    f :: Int -> (a, a) -> (Int, a)
f Int
i (a
j,a
x) = let j' :: Int
j' = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
j in (Int
j',[a] -> a
forall a. Monoid a => [a] -> a
mconcat (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
j'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) a
sep) a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
x)