{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
{-|
Module      : Data.Representation
Description : Represent various data in a common type, such as text or tables
Copyright   : (c) Olaf Klinke
License     : GPL-3
Maintainer  : olaf.klinke@phymetric.de
Stability   : experimental

Haskell has no dependent types, whence we can store only one type of value 
at each node of the data dependency graph. If in addition to Pandoc 
you want to extract the data in a machine-readable format, 
then set the @alt@ type parameter of your Provenience actions accordingly 
and provide 'Representation' instances for all your variable values. 
Each call to @render@ or @renderWith@ automatically invokes a call to 'representation'. 

In order to keep the dependency list of this package small 
beyond the dependencies of pandoc, we have omitted 
many useful instances. 
Add your own instances as you see fit, for example 

@
instance Serializable a => Representation a ByteString where
    representation = toByteString
@

For spreadsheet-like representations, 

- basic values become single cells in a single row,
- foldable structures of basic values become single columns,
- doubly-nested structures of basic values become proper tables. 

-}
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(..))

-- | A representation of type @a@ as type @b@, not necessarily invertible.  
class Representation a b where
    representation :: a -> b

-- | The Prelude provides a 'String' representation
instance Show a => Representation a String where
    representation :: a -> String
representation = a -> String
forall a. Show a => a -> String
show

-- | Representation as JSON 'Value's
instance ToJSON a => Representation a Value where
    representation :: a -> Value
representation = a -> Value
forall a. ToJSON a => a -> Value
toJSON

-- | Representation via blaze
instance ToMarkup a => Representation a Markup where
    representation :: a -> Markup
representation = a -> Markup
forall a. ToMarkup a => a -> Markup
toMarkup

-- | Dummy instance when no alternative representation is required. 
-- @'representation' = 'const' ()@
instance Representation a () where
    representation :: a -> ()
representation = () -> a -> ()
forall a b. a -> b -> a
const ()
-- @()@ is the terminal object of the category @Hask@

-- single values are single cells in a single row
instance (ToRow StaticCellValue row) => Representation (Ratio Integer) (Seq row) where  -- needed to resolve overlap because Ratio could be Foldable
    representation :: Ratio Integer -> Seq row
representation Ratio Integer
x = row -> Seq row
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([StaticCellValue] -> row
forall cell row (f :: * -> *).
(ToRow cell row, Traversable f) =>
f cell -> row
cellList [Ratio Integer -> StaticCellValue
CellNumber Ratio Integer
x])
instance {-# OVERLAPPABLE #-} (ToRow StaticCellValue row, Real a) => Representation a (Seq row) where
    representation :: a -> Seq row
representation a
x = row -> Seq row
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([StaticCellValue] -> row
forall cell row (f :: * -> *).
(ToRow cell row, Traversable f) =>
f cell -> row
cellList [Ratio Integer -> StaticCellValue
CellNumber (a -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational a
x)])
instance ToRow StaticCellValue row => Representation String (Seq row) where
    representation :: String -> Seq row
representation String
txt = row -> Seq row
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([StaticCellValue] -> row
forall cell row (f :: * -> *).
(ToRow cell row, Traversable f) =>
f cell -> row
cellList [String -> StaticCellValue
CellText String
txt])
instance ToRow StaticCellValue row => Representation Bool (Seq row) where
    representation :: Bool -> Seq row
representation Bool
b = row -> Seq row
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([StaticCellValue] -> row
forall cell row (f :: * -> *).
(ToRow cell row, Traversable f) =>
f cell -> row
cellList [Bool -> StaticCellValue
CellBool Bool
b])
instance ToRow StaticCellValue row => Representation ZonedTime (Seq row) where
    representation :: ZonedTime -> Seq row
representation ZonedTime
t = row -> Seq row
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([StaticCellValue] -> row
forall cell row (f :: * -> *).
(ToRow cell row, Traversable f) =>
f cell -> row
cellList [ZonedTime -> StaticCellValue
CellTime ZonedTime
t]) 

-- lists are single columns
instance {-# OVERLAPPABLE #-} (Foldable f, ToRow StaticCellValue row, Real a) => Representation (f a) (Seq row) where
    representation :: f a -> Seq row
representation = (a -> Seq row -> Seq row) -> Seq row -> f a -> Seq row
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x Seq row
rows ->  ([StaticCellValue] -> row
forall cell row (f :: * -> *).
(ToRow cell row, Traversable f) =>
f cell -> row
cellList [Ratio Integer -> StaticCellValue
CellNumber (a -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational a
x)]) row -> Seq row -> Seq row
forall a. a -> Seq a -> Seq a
<| Seq row
rows) Seq row
forall a. Seq a
empty
instance (Foldable f, ToRow StaticCellValue row) =>  Representation (f String) (Seq row) where
    representation :: f String -> Seq row
representation = (String -> Seq row -> Seq row) -> Seq row -> f String -> Seq row
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\String
t Seq row
rows ->  ([StaticCellValue] -> row
forall cell row (f :: * -> *).
(ToRow cell row, Traversable f) =>
f cell -> row
cellList [String -> StaticCellValue
CellText String
t]) row -> Seq row -> Seq row
forall a. a -> Seq a -> Seq a
<| Seq row
rows) Seq row
forall a. Seq a
empty
instance (Foldable f, ToRow StaticCellValue row) =>  Representation (f Bool) (Seq row) where
    representation :: f Bool -> Seq row
representation = (Bool -> Seq row -> Seq row) -> Seq row -> f Bool -> Seq row
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Bool
b Seq row
rows ->  ([StaticCellValue] -> row
forall cell row (f :: * -> *).
(ToRow cell row, Traversable f) =>
f cell -> row
cellList [Bool -> StaticCellValue
CellBool Bool
b]) row -> Seq row -> Seq row
forall a. a -> Seq a -> Seq a
<| Seq row
rows) Seq row
forall a. Seq a
empty
instance (Foldable f, ToRow StaticCellValue row) =>  Representation (f ZonedTime) (Seq row) where
    representation :: f ZonedTime -> Seq row
representation = (ZonedTime -> Seq row -> Seq row)
-> Seq row -> f ZonedTime -> Seq row
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ZonedTime
t Seq row
rows ->  ([StaticCellValue] -> row
forall cell row (f :: * -> *).
(ToRow cell row, Traversable f) =>
f cell -> row
cellList [ZonedTime -> StaticCellValue
CellTime ZonedTime
t]) row -> Seq row -> Seq row
forall a. a -> Seq a -> Seq a
<| Seq row
rows) Seq row
forall a. Seq a
empty

-- nested lists become tables
instance {-# OVERLAPPABLE #-} (Foldable r, ToRow StaticCellValue row, Traversable c, Real a) => Representation (r (c a)) (Seq row) where
    representation :: r (c a) -> Seq row
representation = (c a -> Seq row -> Seq row) -> Seq row -> r (c a) -> Seq row
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\c a
xs Seq row
rows -> c StaticCellValue -> row
forall cell row (f :: * -> *).
(ToRow cell row, Traversable f) =>
f cell -> row
cellList ((a -> StaticCellValue) -> c a -> c StaticCellValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ratio Integer -> StaticCellValue
CellNumber (Ratio Integer -> StaticCellValue)
-> (a -> Ratio Integer) -> a -> StaticCellValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational) c a
xs) row -> Seq row -> Seq row
forall a. a -> Seq a -> Seq a
<| Seq row
rows) Seq row
forall a. Seq a
empty
instance (Foldable r, ToRow StaticCellValue row, Traversable c) => Representation (r (c String)) (Seq row) where
    representation :: r (c String) -> Seq row
representation = (c String -> Seq row -> Seq row)
-> Seq row -> r (c String) -> Seq row
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\c String
xs Seq row
rows -> c StaticCellValue -> row
forall cell row (f :: * -> *).
(ToRow cell row, Traversable f) =>
f cell -> row
cellList ((String -> StaticCellValue) -> c String -> c StaticCellValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> StaticCellValue
CellText c String
xs) row -> Seq row -> Seq row
forall a. a -> Seq a -> Seq a
<| Seq row
rows) Seq row
forall a. Seq a
empty
instance (Foldable r, ToRow StaticCellValue row, Traversable c) => Representation (r (c Bool)) (Seq row) where
    representation :: r (c Bool) -> Seq row
representation = (c Bool -> Seq row -> Seq row) -> Seq row -> r (c Bool) -> Seq row
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\c Bool
xs Seq row
rows -> c StaticCellValue -> row
forall cell row (f :: * -> *).
(ToRow cell row, Traversable f) =>
f cell -> row
cellList ((Bool -> StaticCellValue) -> c Bool -> c StaticCellValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> StaticCellValue
CellBool c Bool
xs) row -> Seq row -> Seq row
forall a. a -> Seq a -> Seq a
<| Seq row
rows) Seq row
forall a. Seq a
empty
instance (Foldable r, ToRow StaticCellValue row, Traversable c) => Representation (r (c ZonedTime)) (Seq row) where
    representation :: r (c ZonedTime) -> Seq row
representation = (c ZonedTime -> Seq row -> Seq row)
-> Seq row -> r (c ZonedTime) -> Seq row
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\c ZonedTime
xs Seq row
rows -> c StaticCellValue -> row
forall cell row (f :: * -> *).
(ToRow cell row, Traversable f) =>
f cell -> row
cellList ((ZonedTime -> StaticCellValue) -> c ZonedTime -> c StaticCellValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ZonedTime -> StaticCellValue
CellTime c ZonedTime
xs) row -> Seq row -> Seq row
forall a. a -> Seq a -> Seq a
<| Seq row
rows) Seq row
forall a. Seq a
empty