{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Mig.Extra.Derive (
deriveParam,
deriveNewtypeParam,
deriveBody,
deriveParamBody,
deriveNewtypeBody,
deriveNewtypeParamBody,
deriveHttp,
deriveNewtypeHttp,
deriveNewtypeForm,
deriveForm,
mapDerive,
paramClasses,
bodyClasses,
paramBodyClasses,
httpClasses,
) where
import Data.Aeson (FromJSON, ToJSON)
import Data.OpenApi (ToParamSchema, ToSchema)
import GHC.Generics (Generic)
import Language.Haskell.TH
import Web.FormUrlEncoded (FromForm, ToForm)
import Web.HttpApiData (FromHttpApiData, ToHttpApiData)
paramClasses :: [Name]
paramClasses :: [Name]
paramClasses = [''Show, ''Eq, ''Ord, ''Generic, ''ToJSON, ''FromJSON, ''ToParamSchema, ''ToHttpApiData, ''FromHttpApiData]
bodyClasses :: [Name]
bodyClasses :: [Name]
bodyClasses = [''Show, ''Eq, ''Ord, ''Generic, ''ToJSON, ''FromJSON, ''ToSchema, ''ToHttpApiData, ''FromHttpApiData]
paramBodyClasses :: [Name]
paramBodyClasses :: [Name]
paramBodyClasses = [''Show, ''Eq, ''Ord, ''Generic, ''ToJSON, ''FromJSON, ''ToParamSchema, ''ToSchema, ''ToHttpApiData, ''FromHttpApiData]
httpClasses :: [Name]
httpClasses :: [Name]
httpClasses = [''Show, ''Eq, ''Ord, ''Generic, ''ToJSON, ''FromJSON, ''ToParamSchema, ''ToSchema, ''ToHttpApiData, ''FromHttpApiData]
mapDerive :: (Name -> Q [Dec]) -> [Name] -> Q [Dec]
mapDerive :: (Name -> Q [Dec]) -> [Name] -> Q [Dec]
mapDerive Name -> Q [Dec]
f [Name]
types = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> Q [Dec]
f [Name]
types)
deriveNewtypeParam :: Name -> Q [Dec]
deriveNewtypeParam :: Name -> Q [Dec]
deriveNewtypeParam Name
typeName = do
let typeCon :: Q Type
typeCon = forall (m :: * -> *). Quote m => Name -> m Type
conT Name
typeName
[d|
deriving newtype instance Show $(typeCon)
deriving newtype instance Eq $(typeCon)
deriving newtype instance Ord $(typeCon)
deriving newtype instance ToJSON $(typeCon)
deriving newtype instance FromJSON $(typeCon)
deriving newtype instance ToParamSchema $(typeCon)
deriving newtype instance ToHttpApiData $(typeCon)
deriving newtype instance FromHttpApiData $(typeCon)
|]
deriveParam :: Name -> Q [Dec]
deriveParam :: Name -> Q [Dec]
deriveParam Name
typeName = do
let typeCon :: Q Type
typeCon = forall (m :: * -> *). Quote m => Name -> m Type
conT Name
typeName
[d|
deriving stock instance Show $(typeCon)
deriving stock instance Eq $(typeCon)
deriving stock instance Ord $(typeCon)
deriving instance Generic $(typeCon)
deriving anyclass instance ToJSON $(typeCon)
deriving anyclass instance FromJSON $(typeCon)
deriving anyclass instance ToParamSchema $(typeCon)
deriving anyclass instance ToHttpApiData $(typeCon)
deriving anyclass instance FromHttpApiData $(typeCon)
|]
deriveNewtypeBody :: Name -> Q [Dec]
deriveNewtypeBody :: Name -> Q [Dec]
deriveNewtypeBody Name
typeName = do
let typeCon :: Q Type
typeCon = forall (m :: * -> *). Quote m => Name -> m Type
conT Name
typeName
[d|
deriving newtype instance Show $(typeCon)
deriving newtype instance Eq $(typeCon)
deriving newtype instance Ord $(typeCon)
deriving newtype instance ToJSON $(typeCon)
deriving newtype instance FromJSON $(typeCon)
deriving newtype instance ToSchema $(typeCon)
|]
deriveBody :: Name -> Q [Dec]
deriveBody :: Name -> Q [Dec]
deriveBody Name
typeName = do
let typeCon :: Q Type
typeCon = forall (m :: * -> *). Quote m => Name -> m Type
conT Name
typeName
[d|
deriving instance Show $(typeCon)
deriving instance Eq $(typeCon)
deriving instance Ord $(typeCon)
deriving instance Generic $(typeCon)
deriving instance ToJSON $(typeCon)
deriving instance FromJSON $(typeCon)
deriving instance ToSchema $(typeCon)
|]
deriveNewtypeForm :: Name -> Q [Dec]
deriveNewtypeForm :: Name -> Q [Dec]
deriveNewtypeForm Name
typeName = do
let typeCon :: Q Type
typeCon = forall (m :: * -> *). Quote m => Name -> m Type
conT Name
typeName
[d|
deriving newtype instance Show $(typeCon)
deriving newtype instance Eq $(typeCon)
deriving newtype instance Ord $(typeCon)
deriving newtype instance ToForm $(typeCon)
deriving newtype instance FromForm $(typeCon)
deriving newtype instance ToSchema $(typeCon)
|]
deriveForm :: Name -> Q [Dec]
deriveForm :: Name -> Q [Dec]
deriveForm Name
typeName = do
let typeCon :: Q Type
typeCon = forall (m :: * -> *). Quote m => Name -> m Type
conT Name
typeName
[d|
deriving instance Show $(typeCon)
deriving instance Eq $(typeCon)
deriving instance Ord $(typeCon)
deriving instance Generic $(typeCon)
deriving instance FromForm $(typeCon)
deriving instance ToForm $(typeCon)
deriving instance ToSchema $(typeCon)
|]
deriveNewtypeHttp :: Name -> Q [Dec]
deriveNewtypeHttp :: Name -> Q [Dec]
deriveNewtypeHttp = Name -> Q [Dec]
deriveNewtypeParamBody
deriveHttp :: Name -> Q [Dec]
deriveHttp :: Name -> Q [Dec]
deriveHttp = Name -> Q [Dec]
deriveParamBody
deriveNewtypeParamBody :: Name -> Q [Dec]
deriveNewtypeParamBody :: Name -> Q [Dec]
deriveNewtypeParamBody Name
typeName = do
let typeCon :: Q Type
typeCon = forall (m :: * -> *). Quote m => Name -> m Type
conT Name
typeName
[d|
deriving newtype instance Show $(typeCon)
deriving newtype instance Eq $(typeCon)
deriving newtype instance Ord $(typeCon)
deriving newtype instance ToJSON $(typeCon)
deriving newtype instance FromJSON $(typeCon)
deriving newtype instance ToSchema $(typeCon)
deriving newtype instance ToParamSchema $(typeCon)
deriving newtype instance ToHttpApiData $(typeCon)
deriving newtype instance FromHttpApiData $(typeCon)
|]
deriveParamBody :: Name -> Q [Dec]
deriveParamBody :: Name -> Q [Dec]
deriveParamBody Name
typeName = do
let typeCon :: Q Type
typeCon = forall (m :: * -> *). Quote m => Name -> m Type
conT Name
typeName
[d|
deriving stock instance Show $(typeCon)
deriving stock instance Eq $(typeCon)
deriving stock instance Ord $(typeCon)
deriving stock instance Generic $(typeCon)
deriving anyclass instance ToJSON $(typeCon)
deriving anyclass instance FromJSON $(typeCon)
deriving anyclass instance ToSchema $(typeCon)
deriving anyclass instance ToParamSchema $(typeCon)
deriving anyclass instance ToHttpApiData $(typeCon)
deriving anyclass instance FromHttpApiData $(typeCon)
|]