@@ -111,13 +111,8 @@ deriveToSchema :: DerivingOptions -> Name -> Q [Dec]
111111deriveToSchema opts tname = do
112112 tinfo <- reifyDatatype tname
113113 let
114−#if MIN_VERSION_th_abstraction(0,3,0)
115− tvars = VarT . tvName <$> datatypeVars tinfo
116−#else
117− tvars = datatypeVars tinfo
118−#endif
119114 context = do
120− var <- tvars
115+ var <- datatypeVarsTypes tinfo
121116 [ConT ''Typeable `AppT` var, ConT ''ToSchema `AppT` var]
122117 body = AppE (VarE 'genericDeclareNamedSchema) <$>
123118 appE (pure $ VarE 'derivingOptionsToSchemaOptions) (lift opts)
@@ -125,6 +120,21 @@ deriveToSchema opts tname = do
125120 (pure context)
126121 (pure $ ConT ''ToSchema `AppT` datatypeType tinfo)
127122 [ funD 'declareNamedSchema $ pure $ clause [] (normalB body) [] ]
123+
124+datatypeVarsTypes :: DatatypeInfo -> [Type]
125+#if MIN_VERSION_th_abstraction(0,3,0)
126+datatypeVarsTypes = fmap (VarT . tvName) . datatypeVars
127+#else
128+datatypeVarsTypes = datatypeVars
129+#endif
130+
131+deriveArbitrary :: Name -> Q [Dec]
132+deriveArbitrary t = do
133+ tinfo <- reifyDatatype t
134+ let ctx = AppT (ConT ''Arbitrary) <$> datatypeVarsTypes tinfo
135+ pure [InstanceD Nothing ctx (ConT ''Arbitrary `AppT` datatypeType tinfo)
136+ [ FunD 'arbitrary [Clause [] (NormalB $ VarE 'genericArbitrary) []]
137+ , FunD 'shrink [Clause [] (NormalB $ VarE 'genericShrink) []] ] ]
128138#endif
129139
130140deriveApiFromJSON :: DerivingOptions -> Name -> Q [Dec]
@@ -139,29 +149,3 @@ generateParseJSON = mkParseJSON . derivingOptionsToJsonOptions
139149stripPrefix' :: String -> String -> String
140150stripPrefix' pfx = fromMaybe <*> stripPrefix pfx
141151
142−deriveArbitrary :: Name -> Q [Dec]
143−deriveArbitrary t = do
144− tinfo <- reifyDatatype t
145− let
146−#if MIN_VERSION_th_abstraction(0,3,0)
147− tvars = VarT . tvName <$> datatypeVars tinfo
148−#else
149− tvars = datatypeVars tinfo
150−#endif
151− ctx = AppT (ConT ''Arbitrary) <$> tvars
152− ba = VarE 'genericArbitrary
153− bs = VarE 'genericShrink
154− pure [InstanceD Nothing ctx (ConT ''Arbitrary `AppT` datatypeType tinfo)
155− [ FunD 'arbitrary [Clause [] (NormalB ba) []]
156− , FunD 'shrink [Clause [] (NormalB bs) []] ] ]
157− -- (pure )
158− -- (pure $ ConT ''ToSchema `AppT` datatypeType tinfo)
159− -- [ funD 'declareNamedSchema $ pure $ clause [] (normalB body) [] ]
160− -- -- body = AppE (VarE 'genericDeclareNamedSchema) <$>
161− -- -- appE (pure $ VarE 'derivingOptionsToSchemaOptions) (lift opts)
162− -- -- pure <$> instanceD
163− -- -- (pure context)
164− -- -- (pure $ ConT ''ToSchema `AppT` datatypeType tinfo)
165− -- -- [ funD 'declareNamedSchema $ pure $ clause [] (normalB body) [] ]
166− -- decs <- [d| arbitrary = genericArbitrary; shrink = genericShrink |]
167− -- pure [InstanceD Nothing ctx (ConT ''Arbitrary `AppT` datatypeType tinfo) decs]