{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}

module Poseidon.ColumnTypesUtils where

import           Data.ByteString     as S
import qualified Data.Csv            as Csv
import qualified Data.Text           as T
import qualified Data.Text.Encoding  as T
import           Data.Typeable       (Typeable)
import           Language.Haskell.TH (Con (..), Dec (..), DecsQ, Info (..),
                                      Name, conE, conP, conT, mkName, reify,
                                      varE, varP)

-- a typeclass for types with smart constructors
class Makeable a where
    make :: MonadFail m => T.Text -> m a

-- helper functions
parseTypeCSV :: forall a m. (MonadFail m, Makeable a, Typeable a) => String -> S.ByteString -> m a
parseTypeCSV :: forall a (m :: * -> *).
(MonadFail m, Makeable a, Typeable a) =>
String -> ByteString -> m a
parseTypeCSV String
colname ByteString
x = case ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
x of
        Left UnicodeException
e  -> String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in column " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
colname
        Right Text
t -> Text -> m a
forall a (m :: * -> *). (Makeable a, MonadFail m) => Text -> m a
forall (m :: * -> *). MonadFail m => Text -> m a
make (Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
t

-- template haskell function to generate repetitive instances
makeInstances :: Name -> String -> DecsQ
makeInstances :: Name -> String -> DecsQ
makeInstances Name
name String
col = do
    TyConI (NewtypeD Cxt
_ Name
_ [TyVarBndr ()]
_ Maybe Kind
_ (NormalC Name
conName [BangType]
_) [DerivClause]
_) <- Name -> Q Info
reify Name
name
    let x :: Name
x = String -> Name
mkName String
"x"
    [d|
      instance Makeable $(Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT Name
name) where      make txt = return $ $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
conName) txt
      instance Show $(Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT Name
name) where          show $(Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP Name
conName [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
x]) = T.unpack $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
x)
      instance Csv.ToField $(Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT Name
name) where   toField $(Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP Name
conName [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
x]) = Csv.toField $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
x)
      instance Csv.FromField $(Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT Name
name) where parseField = parseTypeCSV col
      |]