{-# 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 (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)
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 :: 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
class ToCell cell where
staticCell :: StaticCellValue -> cell
instance ToCell StaticCellValue where
staticCell :: StaticCellValue -> StaticCellValue
staticCell = StaticCellValue -> StaticCellValue
forall a. a -> a
id
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
class ToRow cell row where
cellList :: Traversable f => f cell -> row
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
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)
class ToSheet row sheet where
rowList :: Traversable f => f row -> sheet
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
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
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)