@@ -31,16 +31,16 @@ import Data.Typeable
31import Language.Haskell.TH
31import Language.Haskell.TH
32import Language.Haskell.TH.Datatype
32import Language.Haskell.TH.Datatype
33import Language.Haskell.TH.Syntax
33import Language.Haskell.TH.Syntax
34−import Test.QuickCheck
35−import Test.QuickCheck.Arbitrary.Generic
37−#ifndef ghcjs_HOST_OS
35+#ifdef BACKEND
38import Data.OpenApi hiding (prefix)
36import Data.OpenApi hiding (prefix)
37+import Test.QuickCheck
38+import Test.QuickCheck.Arbitrary.Generic
41-- | derive JSON and openapi3 (ToSchema) instances
41-- | derive JSON and openapi3 (ToSchema) instances
42deriveApiInstances :: DerivingOptions -> Name -> Q [Dec]
42deriveApiInstances :: DerivingOptions -> Name -> Q [Dec]
43−#ifndef ghcjs_HOST_OS
43+#ifdef BACKEND
44deriveApiInstances opts tname = liftM2 (<>)
44deriveApiInstances opts tname = liftM2 (<>)
45 (deriveJSON (derivingOptionsToJsonOptions opts) tname)
45 (deriveJSON (derivingOptionsToJsonOptions opts) tname)
46 (deriveToSchema opts tname)
46 (deriveToSchema opts tname)
@@ -51,7 +51,7 @@ deriveApiInstances opts tname =
52-- | derive JSON and openapi3 (ToSchema) and Arbitrary instances
52-- | derive JSON and openapi3 (ToSchema) and Arbitrary instances
53deriveApiAndArbitraryInstances :: DerivingOptions -> Name -> Q [Dec]
53deriveApiAndArbitraryInstances :: DerivingOptions -> Name -> Q [Dec]
54−#ifndef ghcjs_HOST_OS
54+#ifdef BACKEND
55deriveApiAndArbitraryInstances opts tname = liftM2 (<>)
55deriveApiAndArbitraryInstances opts tname = liftM2 (<>)
56 (deriveApiInstances opts tname)
56 (deriveApiInstances opts tname)
57 (deriveArbitrary tname)
57 (deriveArbitrary tname)
@@ -73,7 +73,7 @@ instance (Lift k, Lift a) => Lift (Map k a) where
73-- so we use this type.
73-- so we use this type.
74data DerivingOptions = DerivingOptions
74data DerivingOptions = DerivingOptions
75 { prefix :: Maybe String
75 { prefix :: Maybe String
76− -- ^ Optional prefix to strip from constructors and field labels
76+ -- ^ Optional prefix to strip from constructors and field labels
77 , snake :: Bool
77 , snake :: Bool
78 -- ^ Whether to snake constructors and field labels
78 -- ^ Whether to snake constructors and field labels
79 -- Applied after stripping prefix
79 -- Applied after stripping prefix
@@ -107,12 +107,12 @@ derivingOptionsToJsonOptions DerivingOptions{..} = defaultOptions
107 snaked = if snake then camelTo2 '_' else id
107 snaked = if snake then camelTo2 '_' else id
108 stripped = maybe id stripPrefix' prefix
108 stripped = maybe id stripPrefix' prefix
110−#ifndef ghcjs_HOST_OS
110+#ifdef BACKEND
111datatypeVarsTypes :: DatatypeInfo -> [Type]
111datatypeVarsTypes :: DatatypeInfo -> [Type]
112#if MIN_VERSION_th_abstraction(0,3,0)
112#if MIN_VERSION_th_abstraction(0,3,0)
113−datatypeVarsTypes = fmap (VarT . tvName) . datatypeVars
113+datatypeVarsTypes = fmap (VarT . tvName) . datatypeVars
115−datatypeVarsTypes = datatypeVars
115+datatypeVarsTypes = datatypeVars
118derivingOptionsToSchemaOptions :: DerivingOptions -> SchemaOptions
118derivingOptionsToSchemaOptions :: DerivingOptions -> SchemaOptions
@@ -120,7 +120,7 @@ derivingOptionsToSchemaOptions = fromAesonOptions . derivingOptionsToJsonOptions
121deriveToParamSchema :: DerivingOptions -> Name -> Q [Dec]
121deriveToParamSchema :: DerivingOptions -> Name -> Q [Dec]
122deriveToParamSchema opts tname = do
122deriveToParamSchema opts tname = do
123− body <- AppE (VarE 'genericToParamSchema)
123+ body <- AppE (VarE 'genericToParamSchema)
124 . AppE (VarE 'derivingOptionsToSchemaOptions) <$> lift opts
124 . AppE (VarE 'derivingOptionsToSchemaOptions) <$> lift opts
125 pure [InstanceD Nothing []
125 pure [InstanceD Nothing []
126 (ConT ''ToParamSchema `AppT` ConT tname)
126 (ConT ''ToParamSchema `AppT` ConT tname)
@@ -140,11 +140,11 @@ deriveToSchema opts tname = do
140 [ FunD 'declareNamedSchema [Clause [] (NormalB body) []] ]]
140 [ FunD 'declareNamedSchema [Clause [] (NormalB body) []] ]]
142deriveArbitrary :: Name -> Q [Dec]
142deriveArbitrary :: Name -> Q [Dec]
143−deriveArbitrary t = do
143+deriveArbitrary t = do
144 tinfo <- reifyDatatype t
144 tinfo <- reifyDatatype t
146 typ = datatypeType tinfo
146 typ = datatypeType tinfo
147− ctx = datatypeVarsTypes tinfo >>= \tv ->
147+ ctx = datatypeVarsTypes tinfo >>= \tv ->
148 [ ConT ''Arbitrary `AppT` tv
148 [ ConT ''Arbitrary `AppT` tv
149 , ConT ''Arg `AppT` typ `AppT` tv ]
149 , ConT ''Arg `AppT` typ `AppT` tv ]
150 pure [InstanceD Nothing ctx (ConT ''Arbitrary `AppT` typ)
150 pure [InstanceD Nothing ctx (ConT ''Arbitrary `AppT` typ)
@@ -163,4 +163,3 @@ generateParseJSON = mkParseJSON . derivingOptionsToJsonOptions
164stripPrefix' :: String -> String -> String
164stripPrefix' :: String -> String -> String
165stripPrefix' pfx = fromMaybe <*> stripPrefix pfx
165stripPrefix' pfx = fromMaybe <*> stripPrefix pfx