git.iko.soy/typeable/derive-api-th
on master help sign in
add Arbitrary
075cd79Dmitry Olshansky
derive-api-th.cabal+3−1
compare with master
unifiedsplit
@@ -32,7 +32,9 @@ library
32 , th-abstraction
32 , th-abstraction
33 if !impl(ghcjs)
33 if !impl(ghcjs)
34 build-depends:
34 build-depends:
35− openapi3
35+ openapi3
36+ , generic-arbitrary
37+ , QuickCheck
36 default-language: Haskell2010
38 default-language: Haskell2010
37 default-extensions:
39 default-extensions:
38 DuplicateRecordFields
40 DuplicateRecordFields
src/Derive/API/TH.hs+26−3
@@ -13,6 +13,7 @@ module Derive.API.TH
13 , derivingOptionsToSchemaOptions
13 , derivingOptionsToSchemaOptions
14 , deriveToParamSchema
14 , deriveToParamSchema
15 , deriveToSchema
15 , deriveToSchema
16+ , deriveArbitrary
16#endif
17#endif
17 , deriveApiFromJSON
18 , deriveApiFromJSON
18 , deriveApiToJSON
19 , deriveApiToJSON
@@ -27,14 +28,16 @@ import Data.Functor
27#endif
28#endif
28import qualified Data.List as List
29import qualified Data.List as List
29import Data.Maybe
30import Data.Maybe
30−#ifndef ghcjs_HOST_OS
31−import Data.OpenApi hiding (prefix)
32−#endif
33import Data.Typeable
31import Data.Typeable
34import Language.Haskell.TH
32import Language.Haskell.TH
35import Language.Haskell.TH.Datatype
33import Language.Haskell.TH.Datatype
36import Language.Haskell.TH.Syntax
34import Language.Haskell.TH.Syntax
37
35
36+#ifndef ghcjs_HOST_OS
37+import Data.OpenApi hiding (prefix)
38+import Test.QuickCheck
39+import Test.QuickCheck.Arbitrary.Generic
40+#endif
38
41
39-- | derive JSON and openapi3 (ToSchema) instances
42-- | derive JSON and openapi3 (ToSchema) instances
40deriveApiInstances :: DerivingOptions -> Name -> Q [Dec]
43deriveApiInstances :: DerivingOptions -> Name -> Q [Dec]
@@ -47,6 +50,17 @@ deriveApiInstances opts tname =
47 deriveJSON (derivingOptionsToJsonOptions opts) tname
50 deriveJSON (derivingOptionsToJsonOptions opts) tname
48#endif
51#endif
49
52
53+-- | derive JSON and openapi3 (ToSchema) instances
54+deriveApiAndArbitraryInstances :: DerivingOptions -> Name -> Q [Dec]
55+#ifndef ghcjs_HOST_OS
56+deriveApiAndArbitraryInstances opts tname = liftM2 (<>)
57+ (deriveApiInstances opts tname)
58+ (deriveArbitrary tname)
59+#else
60+deriveApiAndArbitraryInstances opts tname =
61+ deriveApiInstances opts tname
62+#endif
63+
50-- We can't directly 'lift' Options into TH, so have to use this
64-- We can't directly 'lift' Options into TH, so have to use this
51data DerivingOptions = DerivingOptions
65data DerivingOptions = DerivingOptions
52 { prefix :: Maybe String
66 { prefix :: Maybe String
@@ -121,3 +135,12 @@ generateParseJSON = mkParseJSON . derivingOptionsToJsonOptions
121
135
122stripPrefix :: String -> String -> String
136stripPrefix :: String -> String -> String
123stripPrefix pfx = fromMaybe <*> List.stripPrefix pfx
137stripPrefix pfx = fromMaybe <*> List.stripPrefix pfx
138+
139+#ifndef ghcjs_HOST_OS
140+deriveArbitrary :: Name -> Q [Dec]
141+deriveArbitrary t = [d|
142+ instance Arbitrary $(conT t) where
143+ arbitrary = genericArbitrary
144+ shrink = genericShrink
145+ |]
146+#endif