git.iko.soy/typeable/derive-api-th
on master help sign in
make Arbitrary for ghcjs. Subject to change
f157ee1Dmitry Olshansky
derive-api-th.cabal+2−2
@@ -30,11 +30,11 @@ library
30 , aeson
30 , aeson
31 , template-haskell
31 , template-haskell
32 , th-abstraction
32 , th-abstraction
33+ , generic-arbitrary
34+ , QuickCheck
33 if !impl(ghcjs)
35 if !impl(ghcjs)
34 build-depends:
36 build-depends:
35 openapi3
37 openapi3
36− , generic-arbitrary
37− , QuickCheck
38 default-language: Haskell2010
38 default-language: Haskell2010
39 default-extensions:
39 default-extensions:
40 DuplicateRecordFields
40 DuplicateRecordFields
src/Derive/API/TH.hs+19−23
@@ -14,30 +14,27 @@ module Derive.API.TH
14 , derivingOptionsToSchemaOptions
14 , derivingOptionsToSchemaOptions
15 , deriveToParamSchema
15 , deriveToParamSchema
16 , deriveToSchema
16 , deriveToSchema
17− , deriveArbitrary
18#endif
17#endif
19 , deriveApiFromJSON
18 , deriveApiFromJSON
20 , deriveApiToJSON
19 , deriveApiToJSON
20+ , deriveArbitrary
21 , generateParseJSON
21 , generateParseJSON
22 ) where
22 ) where
23
23
24−import Control.Monad
24+import Control.Monad
25−import Data.Aeson.TH as A
25+import Data.Aeson.TH as A
26−import Data.Aeson.Types
26+import Data.Aeson.Types
27−#if MIN_VERSION_th_abstraction(0,3,0)
27+import Data.List
28−import Data.Functor
29−#endif
30−import qualified Data.List as List
31−import Data.Maybe
28+import Data.Maybe
32−import Data.Typeable
29+import Data.Typeable
33−import Language.Haskell.TH
30+import Language.Haskell.TH
34−import Language.Haskell.TH.Datatype
31+import Language.Haskell.TH.Datatype
35−import Language.Haskell.TH.Syntax
32+import Language.Haskell.TH.Syntax
33+import Test.QuickCheck
34+import Test.QuickCheck.Arbitrary.Generic
36
35
37#ifndef ghcjs_HOST_OS
36#ifndef ghcjs_HOST_OS
38−import Data.OpenApi hiding (prefix)
37+import Data.OpenApi hiding (prefix)
39−import Test.QuickCheck
40−import Test.QuickCheck.Arbitrary.Generic
41#endif
38#endif
42
39
43-- | derive JSON and openapi3 (ToSchema) instances
40-- | derive JSON and openapi3 (ToSchema) instances
@@ -90,7 +87,7 @@ derivingOptionsToJsonOptions DerivingOptions{..} = defaultOptions
90 , unwrapUnaryRecords }
87 , unwrapUnaryRecords }
91 where
88 where
92 snaked = if snake then camelTo2 '_' else id
89 snaked = if snake then camelTo2 '_' else id
93− stripped = maybe id stripPrefix prefix
90+ stripped = maybe id stripPrefix' prefix
94
91
95#ifndef ghcjs_HOST_OS
92#ifndef ghcjs_HOST_OS
96derivingOptionsToSchemaOptions :: DerivingOptions -> SchemaOptions
93derivingOptionsToSchemaOptions :: DerivingOptions -> SchemaOptions
@@ -110,9 +107,10 @@ deriveToSchema :: DerivingOptions -> Name -> Q [Dec]
110deriveToSchema opts tname = do
107deriveToSchema opts tname = do
111 tinfo <- reifyDatatype tname
108 tinfo <- reifyDatatype tname
112 let
109 let
113− tvars = datatypeVars tinfo
114#if MIN_VERSION_th_abstraction(0,3,0)
110#if MIN_VERSION_th_abstraction(0,3,0)
115− <&> VarT . tvName
111+ tvars = VarT . tvName <$> datatypeVars tinfo
112+#else
113+ tvars = datatypeVars tinfo
116#endif
114#endif
117 context = do
115 context = do
118 var <- tvars
116 var <- tvars
@@ -134,14 +132,12 @@ deriveApiToJSON = deriveToJSON . derivingOptionsToJsonOptions
134generateParseJSON :: DerivingOptions -> Name -> Q Exp
132generateParseJSON :: DerivingOptions -> Name -> Q Exp
135generateParseJSON = mkParseJSON . derivingOptionsToJsonOptions
133generateParseJSON = mkParseJSON . derivingOptionsToJsonOptions
136
134
137−stripPrefix :: String -> String -> String
135+stripPrefix' :: String -> String -> String
138−stripPrefix pfx = fromMaybe <*> List.stripPrefix pfx
136+stripPrefix' pfx = fromMaybe <*> stripPrefix pfx
139
137
140−#ifndef ghcjs_HOST_OS
141deriveArbitrary :: Name -> Q [Dec]
138deriveArbitrary :: Name -> Q [Dec]
142deriveArbitrary t = [d|
139deriveArbitrary t = [d|
143 instance Arbitrary $(conT t) where
140 instance Arbitrary $(conT t) where
144 arbitrary = genericArbitrary
141 arbitrary = genericArbitrary
145 shrink = genericShrink
142 shrink = genericShrink
146 |]
143 |]
147−#endif