{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

module CryptoID.TH where

import ClassyPrelude

import Language.Haskell.TH

import Data.CryptoID (CryptoID)
import Data.UUID.Types (UUID)
import Data.Binary (Binary(..))

import Database.Persist.Sql (toSqlKey, fromSqlKey)


decTypeAliases :: [String] -> Q [Dec]
decTypeAliases = return . concatMap decTypeAliases'
  where
    decTypeAliases' :: String -> [Dec]
    decTypeAliases' n
      = [ TySynD cryptoIDn [] $ ConT ''CryptoID `AppT` LitT (StrTyLit n)
        , TySynD cryptoUUIDn [] $ ConT cryptoIDn `AppT` ConT ''UUID
        ]
      where
        cryptoIDn = mkName $ "CryptoID" ++ n
        cryptoUUIDn = mkName $ "CryptoUUID" ++ n

decKeysBinary :: [Name] -> DecsQ
decKeysBinary = fmap concat . mapM decKeyBinary
  where
    decKeyBinary :: Name -> DecsQ
    decKeyBinary (conT -> t)
      = [d| instance Binary $(t) where
              get = $(varE 'toSqlKey) <$> get
              put = put . $(varE 'fromSqlKey)
          |]