39 lines
1.0 KiB
Haskell
39 lines
1.0 KiB
Haskell
{-# 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)
|
|
|]
|