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

module Composite.Csv where

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

instance FromNamedRecord (F f '[]) where
  parseNamedRecord m = pure $ F RNil

instance ToNamedRecord (F f '[]) where
  toNamedRecord m = mempty

instance FromNamedRecord (TF f '[]) where
  parseNamedRecord m = pure $ TF RNil

instance ToNamedRecord (TF f '[]) where
  toNamedRecord m = mempty

newtype F f xs = F {unF :: Rec f xs}

instance (Functor f, KnownSymbol s, FromField (f x), FromNamedRecord (F f xs)) => FromNamedRecord (F f ((s :-> x) ': xs)) where
  parseNamedRecord m = do
    x <- m .: T.encodeUtf8 (valName @s undefined)
    F f <- parseNamedRecord @(F f xs) m
    pure $ F $ x :^: f

instance (Functor f, KnownSymbol s, ToField (f x), ToNamedRecord (F f xs)) => ToNamedRecord (F f ((s :-> x) ': xs)) where
  toNamedRecord (F (x :^: xs)) = HM.singleton (T.encodeUtf8 (valName @s undefined)) (toField x) <> toNamedRecord (F xs)

newtype TF f xs = TF {unTF :: Rec f xs}

instance (Functor f, KnownSymbol s, FromField (f (s :-> x)), FromNamedRecord (TF f xs)) => FromNamedRecord (TF f ((s :-> x) ': xs)) where
  parseNamedRecord m = do
    x <- m .: T.encodeUtf8 (valName @s undefined)
    TF f <- parseNamedRecord @(TF f xs) m
    pure $ TF $ x :& f

instance (Functor f, KnownSymbol s, ToField (f (s :-> x)), ToNamedRecord (TF f xs)) => ToNamedRecord (TF f ((s :-> x) ': xs)) where
  toNamedRecord (TF (x :& xs)) = HM.singleton (T.encodeUtf8 (valName @s undefined)) (toField x) <> toNamedRecord (TF xs)

class ToHeader x where
  extractRecHeader :: Proxy x -> Vector Name

instance ToHeader (Rec f '[]) where
  extractRecHeader _ = Data.Vector.fromList []

instance (KnownSymbol s, ToHeader (Rec f xs)) => ToHeader (Rec f (s :-> x ': xs)) where
  extractRecHeader Proxy = pure (encodeUtf8 $ valName @s undefined) <> extractRecHeader (Proxy @(Rec f xs))