{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Composite.Csv where

import Composite.Record
import Data.Csv
import Data.HashMap.Strict as HM
import Data.Text.Encoding as T
import GHC.TypeLits

instance FromNamedRecord (Rec f '[]) where
  parseNamedRecord :: NamedRecord -> Parser (Rec f '[])
parseNamedRecord NamedRecord
m = Rec f '[] -> Parser (Rec f '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rec f '[]
forall u (a :: u -> *). Rec a '[]
RNil

instance ToNamedRecord (Rec f '[]) where
  toNamedRecord :: Rec f '[] -> NamedRecord
toNamedRecord Rec f '[]
m = NamedRecord
forall a. Monoid a => a
mempty

instance (Functor f, KnownSymbol s, FromField (f x), FromNamedRecord (Rec f xs)) => FromNamedRecord (Rec f ((s :-> x) ': xs)) where
  parseNamedRecord :: NamedRecord -> Parser (Rec f ((s :-> x) : xs))
parseNamedRecord NamedRecord
m = do
    let nL :: (s :-> x)
        nL :: s :-> x
nL = s :-> x
forall a. HasCallStack => a
undefined
    f x
x <- NamedRecord
m NamedRecord -> ByteString -> Parser (f x)
forall a. FromField a => NamedRecord -> ByteString -> Parser a
.: Text -> ByteString
T.encodeUtf8 ((s :-> x) -> Text
forall (s :: Symbol) a. KnownSymbol s => (s :-> a) -> Text
valName s :-> x
nL)
    Rec f xs
f <- NamedRecord -> Parser (Rec f xs)
forall a. FromNamedRecord a => NamedRecord -> Parser a
parseNamedRecord @(Rec f xs) NamedRecord
m
    Rec f ((s :-> x) : xs) -> Parser (Rec f ((s :-> x) : xs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rec f ((s :-> x) : xs) -> Parser (Rec f ((s :-> x) : xs)))
-> Rec f ((s :-> x) : xs) -> Parser (Rec f ((s :-> x) : xs))
forall a b. (a -> b) -> a -> b
$ f x
x f x -> Rec f xs -> Rec f ((s :-> x) : xs)
forall (f :: * -> *) a (rs :: [*]) (s :: Symbol).
Functor f =>
f a -> Rec f rs -> Rec f ((s :-> a) : rs)
:^: Rec f xs
f

instance (Functor f, KnownSymbol s, ToField (f x), ToNamedRecord (Rec f xs)) => ToNamedRecord (Rec f ((s :-> x) ': xs)) where
  toNamedRecord :: Rec f ((s :-> x) : xs) -> NamedRecord
toNamedRecord (f x
x :^: Rec f xs
xs) =
    let nL :: (s :-> x)
        nL :: s :-> x
nL = s :-> x
forall a. HasCallStack => a
undefined
     in ByteString -> ByteString -> NamedRecord
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton (Text -> ByteString
T.encodeUtf8 ((s :-> x) -> Text
forall (s :: Symbol) a. KnownSymbol s => (s :-> a) -> Text
valName s :-> x
nL)) (f x -> ByteString
forall a. ToField a => a -> ByteString
toField f x
x)