{-# LANGUAGE CPP #-}
module Composite.Swagger.TH where
import Composite.CoRecord (Field)
import Composite.Swagger.Base (wrappedSchema)
import Data.Proxy (Proxy (Proxy))
import Data.Swagger (ToSchema, declareNamedSchema)
import Language.Haskell.TH
( Dec, Name, Q, mkName
, bang, bangType, clause, conT, cxt, funD, instanceD, newtypeD, normalB, recC, varBangType , wildP
, noSourceStrictness, noSourceUnpackedness )
makeToSchema :: String -> Name -> Q [Dec]
makeToSchema schemaName wrapperName =
sequence
[ instanceD
(cxt [])
[t| ToSchema $(conT wrapperName) |]
[ funD
'declareNamedSchema
[ clause [wildP] (normalB [| wrappedSchema (Proxy :: Proxy $(conT wrapperName)) schemaName |]) [] ]
]
]
makeToSchemaWrapper :: String -> Name -> Q [Dec]
makeToSchemaWrapper wrapperNameStr fieldsTyName = do
let wrapperName = mkName wrapperNameStr
extractorName = mkName $ "un" <> wrapperNameStr
fieldTy = [t| Field $(conT fieldsTyName) |]
wrapperNewtype <- newtypeD
(cxt [])
wrapperName
[]
Nothing
(recC wrapperName [varBangType extractorName (bangType (bang noSourceUnpackedness noSourceStrictness) fieldTy)])
#if MIN_VERSION_template_haskell(2,12,0)
[]
#else
(cxt [])
#endif
wrapperInstances <- makeToSchema wrapperNameStr wrapperName
pure $ wrapperNewtype:wrapperInstances