@@ -59,10 +59,11 @@ deriveApiAndArbitraryInstances opts tname =
5959 deriveApiInstances opts tname
6060#endif
6161
62−-- We can't directly 'lift' Options into TH, so have to use this
62+-- We can't directly 'lift' Options into TH (there is no instance for function),
63+-- so we use this type.
6364data DerivingOptions = DerivingOptions
6465 { prefix :: Maybe String
65− -- ^ Optional prefix to strip from constructors and field labels
66+ -- ^ Optional prefix to strip from constructors and field labels
6667 , snake :: Bool
6768 -- ^ Whether to snake constructors and field labels
6869 -- Applied after stripping prefix
@@ -93,18 +94,23 @@ derivingOptionsToJsonOptions DerivingOptions{..} = defaultOptions
9394 stripped = maybe id stripPrefix' prefix
9495
9596#ifndef ghcjs_HOST_OS
97+datatypeVarsTypes :: DatatypeInfo -> [Type]
98+#if MIN_VERSION_th_abstraction(0,3,0)
99+datatypeVarsTypes = fmap (VarT . tvName) . datatypeVars
100+#else
101+datatypeVarsTypes = datatypeVars
102+#endif
103+
96104derivingOptionsToSchemaOptions :: DerivingOptions -> SchemaOptions
97105derivingOptionsToSchemaOptions = fromAesonOptions . derivingOptionsToJsonOptions
98106
99107deriveToParamSchema :: DerivingOptions -> Name -> Q [Dec]
100108deriveToParamSchema opts tname = do
101− let
102− body = AppE (VarE 'genericToParamSchema) <$>
103− appE (pure $ VarE 'derivingOptionsToSchemaOptions) (lift opts)
104− pure <$> instanceD
105− (pure [])
106− (pure $ ConT ''ToParamSchema `AppT` ConT tname)
107− [ funD 'toParamSchema $ pure $ clause [] (normalB body) [] ]
109+ body <- AppE (VarE 'genericToParamSchema)
110+ . AppE (VarE 'derivingOptionsToSchemaOptions) <$> lift opts
111+ pure [InstanceD Nothing []
112+ (ConT ''ToParamSchema `AppT` ConT tname)
113+ [FunD 'toParamSchema [Clause [] (NormalB body) []] ]]
108114
109115deriveToSchema :: DerivingOptions -> Name -> Q [Dec]
110116deriveToSchema opts tname = do
@@ -113,19 +119,11 @@ deriveToSchema opts tname = do
113119 context = do
114120 var <- datatypeVarsTypes tinfo
115121 [ConT ''Typeable `AppT` var, ConT ''ToSchema `AppT` var]
116− body = AppE (VarE 'genericDeclareNamedSchema) <$>
117− appE (pure $ VarE 'derivingOptionsToSchemaOptions) (lift opts)
118− pure <$> instanceD
119− (pure context)
120− (pure $ ConT ''ToSchema `AppT` datatypeType tinfo)
121− [ funD 'declareNamedSchema $ pure $ clause [] (normalB body) [] ]
122−
123−datatypeVarsTypes :: DatatypeInfo -> [Type]
124−#if MIN_VERSION_th_abstraction(0,3,0)
125−datatypeVarsTypes = fmap (VarT . tvName) . datatypeVars
126−#else
127−datatypeVarsTypes = datatypeVars
128−#endif
122+ body <- AppE (VarE 'genericDeclareNamedSchema)
123+ . AppE (VarE 'derivingOptionsToSchemaOptions) <$> lift opts
124+ pure [InstanceD Nothing context
125+ (ConT ''ToSchema `AppT` datatypeType tinfo)
126+ [ FunD 'declareNamedSchema [Clause [] (NormalB body) []] ]]
129127
130128deriveArbitrary :: Name -> Q [Dec]
131129deriveArbitrary t = do