{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
module Composite.Sheet where

import qualified Composite.Csv          as Csv
import           Composite.Record
import           Control.Applicative
import           Data.Aeson             as A
import           Data.ByteString.Base64 as B64
import           Data.ByteString.Lazy   (fromStrict, toStrict)
import           Data.Csv               hiding (Record)
import           Data.Functor.Identity
import           Data.Proxy
import           Data.Text.Encoding
import qualified Data.Vector            as V
import           GHC.Generics

-- | The SheetT type. This is a functor of hetrogenous records.
-- A typical "SpreadSheet" might be something like `SheetT [] Identity`
-- This provides a convenient newtype for deriving instances.
newtype SheetT w f xs = SheetT { SheetT w f xs -> w (Rec f xs)
runSheetT :: w (Rec f xs) }

type Sheet f xs = SheetT f Identity xs

deriving stock instance Eq (w (Rec f xs)) => Eq (SheetT w f xs)
deriving stock instance Show (w (Rec f xs)) => Show (SheetT w f xs)
deriving stock instance Generic (SheetT w f xs)

instance (ToNamedRecord (Record ixs), Csv.ToHeader (Record ixs)) => ToJSON (Sheet [] ixs) where
  toJSON :: Sheet [] ixs -> Value
toJSON (SheetT [Record ixs]
xs) =
    let z :: ByteString
z = Header -> [Record ixs] -> ByteString
forall a. ToNamedRecord a => Header -> [a] -> ByteString
encodeByName (Proxy (Record ixs) -> Header
forall x. ToHeader x => Proxy x -> Header
Csv.extractRecHeader (Proxy (Record ixs)
forall k (t :: k). Proxy t
Proxy @(Record ixs))) [Record ixs]
xs
     in Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
z

instance FromNamedRecord (Record ixs) => FromJSON (Sheet [] ixs) where
  parseJSON :: Value -> Parser (Sheet [] ixs)
parseJSON (String Text
x) = do
   let k :: Either String (Header, Vector (Record ixs))
k = case ByteString -> Either String ByteString
B64.decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
x of
             Left String
e  -> String -> Either String (Header, Vector (Record ixs))
forall a b. a -> Either a b
Left String
e
             Right ByteString
a -> ByteString -> Either String (Header, Vector (Record ixs))
forall a.
FromNamedRecord a =>
ByteString -> Either String (Header, Vector a)
decodeByName (ByteString -> Either String (Header, Vector (Record ixs)))
-> (ByteString -> ByteString)
-> ByteString
-> Either String (Header, Vector (Record ixs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict (ByteString -> Either String (Header, Vector (Record ixs)))
-> ByteString -> Either String (Header, Vector (Record ixs))
forall a b. (a -> b) -> a -> b
$ ByteString
a
   case Either String (Header, Vector (Record ixs))
k of
     Left String
e  -> String -> Parser (Sheet [] ixs)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Sheet [] ixs))
-> String -> Parser (Sheet [] ixs)
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show String
e
     Right (Header, Vector (Record ixs))
a -> Sheet [] ixs -> Parser (Sheet [] ixs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sheet [] ixs -> Parser (Sheet [] ixs))
-> Sheet [] ixs -> Parser (Sheet [] ixs)
forall a b. (a -> b) -> a -> b
$ [Record ixs] -> Sheet [] ixs
forall (w :: * -> *) (f :: * -> *) (xs :: [*]).
w (Rec f xs) -> SheetT w f xs
SheetT ([Record ixs] -> Sheet [] ixs) -> [Record ixs] -> Sheet [] ixs
forall a b. (a -> b) -> a -> b
$ Vector (Record ixs) -> [Record ixs]
forall a. Vector a -> [a]
V.toList (Vector (Record ixs) -> [Record ixs])
-> Vector (Record ixs) -> [Record ixs]
forall a b. (a -> b) -> a -> b
$ (Header, Vector (Record ixs)) -> Vector (Record ixs)
forall a b. (a, b) -> b
snd (Header, Vector (Record ixs))
a
  parseJSON Value
_ = Parser (Sheet [] ixs)
forall (f :: * -> *) a. Alternative f => f a
empty