Skip to content
Snippets Groups Projects
  • Alice Brenon's avatar
    * Add unit tests · 7a005ff8
    Alice Brenon authored
    * Add optparse-applicative parsers for input / output parameters
    * Rework metadata types and the way they compose (splitting Article into
      PrimaryKey and Entry)
    7a005ff8
Header.hs 1.31 KiB
{-# LANGUAGE ExplicitNamespaces, ScopedTypeVariables, TypeOperators #-}
module GEODE.Metadata.TSV.Header
  ( DefaultFields(..)
  , HasDefaultHeader(..)
  , WithDefaultHeader(..)
  , for
  , getHeader
  , glue ) where

import Data.ByteString.Char8 as StrictByteString (pack)
import Data.Csv (Header, ToNamedRecord(..), ToRecord(..))
import Data.HashMap.Strict ((!))
import Data.Vector (fromList)
import GEODE.Metadata.Types (type (@)(..))

newtype WithDefaultHeader a = WithDefaultHeader a
newtype DefaultFields a = DefaultFields [String]
class HasDefaultHeader a where
  defaultFields :: DefaultFields a

instance (HasDefaultHeader a, HasDefaultHeader b) => HasDefaultHeader (a @ b) where
  defaultFields = DefaultFields (a ++ b)
    where
      DefaultFields a = (defaultFields :: DefaultFields a)
      DefaultFields b = (defaultFields :: DefaultFields b)

getHeader :: forall a. HasDefaultHeader a => a -> Header
getHeader _ = StrictByteString.pack <$> fromList fields
    where
      DefaultFields fields = (defaultFields :: DefaultFields a)

for :: HasDefaultHeader a => a
for = undefined

instance (HasDefaultHeader a, ToNamedRecord a) => ToRecord (WithDefaultHeader a) where
  toRecord (WithDefaultHeader a) = (toNamedRecord a !) <$> getHeader a

glue :: a -> b -> WithDefaultHeader (a @ b)
glue a b = WithDefaultHeader (a :@: b)