{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
module Data.Representation where
import Data.Spreadsheet
import Data.Time
import Data.Sequence
import Data.Ratio
import Data.Aeson.Types (Value,ToJSON(..))
import Text.Blaze (Markup,ToMarkup(..))
class Representation a b where
representation :: a -> b
instance Show a => Representation a String where
representation = show
instance ToJSON a => Representation a Value where
representation = toJSON
instance ToMarkup a => Representation a Markup where
representation = toMarkup
instance Representation a () where
representation = const ()
instance (ToRow StaticCellValue row) => Representation (Ratio Integer) (Seq row) where
representation x = pure (cellList [CellNumber x])
instance {-# OVERLAPPABLE #-} (ToRow StaticCellValue row, Real a) => Representation a (Seq row) where
representation x = pure (cellList [CellNumber (toRational x)])
instance ToRow StaticCellValue row => Representation String (Seq row) where
representation txt = pure (cellList [CellText txt])
instance ToRow StaticCellValue row => Representation Bool (Seq row) where
representation b = pure (cellList [CellBool b])
instance ToRow StaticCellValue row => Representation ZonedTime (Seq row) where
representation t = pure (cellList [CellTime t])
instance {-# OVERLAPPABLE #-} (Foldable f, ToRow StaticCellValue row, Real a) => Representation (f a) (Seq row) where
representation = foldr (\x rows -> (cellList [CellNumber (toRational x)]) <| rows) empty
instance (Foldable f, ToRow StaticCellValue row) => Representation (f String) (Seq row) where
representation = foldr (\t rows -> (cellList [CellText t]) <| rows) empty
instance (Foldable f, ToRow StaticCellValue row) => Representation (f Bool) (Seq row) where
representation = foldr (\b rows -> (cellList [CellBool b]) <| rows) empty
instance (Foldable f, ToRow StaticCellValue row) => Representation (f ZonedTime) (Seq row) where
representation = foldr (\t rows -> (cellList [CellTime t]) <| rows) empty
instance {-# OVERLAPPABLE #-} (Foldable r, ToRow StaticCellValue row, Traversable c, Real a) => Representation (r (c a)) (Seq row) where
representation = foldr (\xs rows -> cellList (fmap (CellNumber . toRational) xs) <| rows) empty
instance (Foldable r, ToRow StaticCellValue row, Traversable c) => Representation (r (c String)) (Seq row) where
representation = foldr (\xs rows -> cellList (fmap CellText xs) <| rows) empty
instance (Foldable r, ToRow StaticCellValue row, Traversable c) => Representation (r (c Bool)) (Seq row) where
representation = foldr (\xs rows -> cellList (fmap CellBool xs) <| rows) empty
instance (Foldable r, ToRow StaticCellValue row, Traversable c) => Representation (r (c ZonedTime)) (Seq row) where
representation = foldr (\xs rows -> cellList (fmap CellTime xs) <| rows) empty