git.iko.soy/typeable/derive-api-th
on master help sign in
cleanup
a2431c2odr
src/Derive/API/TH.hs+20−22
compare with master
unifiedsplit
@@ -59,10 +59,11 @@ deriveApiAndArbitraryInstances opts tname =
59 deriveApiInstances opts tname
59 deriveApiInstances opts tname
60#endif
60#endif
61
61
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.
63data DerivingOptions = DerivingOptions
64data DerivingOptions = DerivingOptions
64 { prefix :: Maybe String
65 { prefix :: Maybe String
65− -- ^ Optional prefix to strip from constructors and field labels
66+ -- ^ Optional prefix to strip from constructors and field labels
66 , snake :: Bool
67 , snake :: Bool
67 -- ^ Whether to snake constructors and field labels
68 -- ^ Whether to snake constructors and field labels
68 -- Applied after stripping prefix
69 -- Applied after stripping prefix
@@ -93,18 +94,23 @@ derivingOptionsToJsonOptions DerivingOptions{..} = defaultOptions
93 stripped = maybe id stripPrefix' prefix
94 stripped = maybe id stripPrefix' prefix
94
95
95#ifndef ghcjs_HOST_OS
96#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+
96derivingOptionsToSchemaOptions :: DerivingOptions -> SchemaOptions
104derivingOptionsToSchemaOptions :: DerivingOptions -> SchemaOptions
97derivingOptionsToSchemaOptions = fromAesonOptions . derivingOptionsToJsonOptions
105derivingOptionsToSchemaOptions = fromAesonOptions . derivingOptionsToJsonOptions
98
106
99deriveToParamSchema :: DerivingOptions -> Name -> Q [Dec]
107deriveToParamSchema :: DerivingOptions -> Name -> Q [Dec]
100deriveToParamSchema opts tname = do
108deriveToParamSchema opts tname = do
101− let
102− body = AppE (VarE 'genericToParamSchema) <$>
109+ body <- AppE (VarE 'genericToParamSchema)
103− appE (pure $ VarE 'derivingOptionsToSchemaOptions) (lift opts)
110+ . AppE (VarE 'derivingOptionsToSchemaOptions) <$> lift opts
104− pure <$> instanceD
111+ pure [InstanceD Nothing []
105− (pure [])
106− (pure $ ConT ''ToParamSchema `AppT` ConT tname)
112+ (ConT ''ToParamSchema `AppT` ConT tname)
107− [ funD 'toParamSchema $ pure $ clause [] (normalB body) [] ]
113+ [FunD 'toParamSchema [Clause [] (NormalB body) []] ]]
108
114
109deriveToSchema :: DerivingOptions -> Name -> Q [Dec]
115deriveToSchema :: DerivingOptions -> Name -> Q [Dec]
110deriveToSchema opts tname = do
116deriveToSchema opts tname = do
@@ -113,19 +119,11 @@ deriveToSchema opts tname = do
113 context = do
119 context = do
114 var <- datatypeVarsTypes tinfo
120 var <- datatypeVarsTypes tinfo
115 [ConT ''Typeable `AppT` var, ConT ''ToSchema `AppT` var]
121 [ConT ''Typeable `AppT` var, ConT ''ToSchema `AppT` var]
116− body = AppE (VarE 'genericDeclareNamedSchema) <$>
122+ body <- AppE (VarE 'genericDeclareNamedSchema)
117− appE (pure $ VarE 'derivingOptionsToSchemaOptions) (lift opts)
123+ . AppE (VarE 'derivingOptionsToSchemaOptions) <$> lift opts
118− pure <$> instanceD
124+ pure [InstanceD Nothing context
119− (pure context)
120− (pure $ ConT ''ToSchema `AppT` datatypeType tinfo)
125+ (ConT ''ToSchema `AppT` datatypeType tinfo)
121− [ funD 'declareNamedSchema $ pure $ clause [] (normalB body) [] ]
126+ [ FunD 'declareNamedSchema [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
129
127
130deriveArbitrary :: Name -> Q [Dec]
128deriveArbitrary :: Name -> Q [Dec]
131deriveArbitrary t = do
129deriveArbitrary t = do