@@ -10,7 +10,7 @@ module Derive.API.TH
1010 , derivingOptionsToJsonOptions
1111 , deriveApiInstances
1212 , deriveApiAndArbitraryInstances
13−#ifndef ghcjs_HOST_OS
13+#ifdef BACKEND
1414 , derivingOptionsToSchemaOptions
1515 , deriveToParamSchema
1616 , deriveToSchema
@@ -31,16 +31,16 @@ import Data.Typeable
3131import Language.Haskell.TH
3232import Language.Haskell.TH.Datatype
3333import Language.Haskell.TH.Syntax
34−import Test.QuickCheck
35−import Test.QuickCheck.Arbitrary.Generic
3634
37−#ifndef ghcjs_HOST_OS
35+#ifdef BACKEND
3836import Data.OpenApi hiding (prefix)
37+import Test.QuickCheck
38+import Test.QuickCheck.Arbitrary.Generic
3939#endif
4040
4141-- | derive JSON and openapi3 (ToSchema) instances
4242deriveApiInstances :: DerivingOptions -> Name -> Q [Dec]
43−#ifndef ghcjs_HOST_OS
43+#ifdef BACKEND
4444deriveApiInstances opts tname = liftM2 (<>)
4545 (deriveJSON (derivingOptionsToJsonOptions opts) tname)
4646 (deriveToSchema opts tname)
@@ -51,7 +51,7 @@ deriveApiInstances opts tname =
5151
5252-- | derive JSON and openapi3 (ToSchema) and Arbitrary instances
5353deriveApiAndArbitraryInstances :: DerivingOptions -> Name -> Q [Dec]
54−#ifndef ghcjs_HOST_OS
54+#ifdef BACKEND
5555deriveApiAndArbitraryInstances opts tname = liftM2 (<>)
5656 (deriveApiInstances opts tname)
5757 (deriveArbitrary tname)
@@ -61,10 +61,14 @@ deriveApiAndArbitraryInstances opts tname =
6161#endif
6262
6363#if MIN_VERSION_containers(0,6,6)
64−#elif MIN_VERSION_template_haskell(2,16,0)
64+#elif MIN_VERSION_template_haskell(2,17,0)
6565instance (Lift k, Lift a) => Lift (Map k a) where
6666 liftTyped x = unsafeCodeCoerce (lift x)
6767 lift m = [|M.fromList (M.toList m)|]
68+#elif MIN_VERSION_template_haskell(2,16,0)
69+instance (Lift k, Lift a) => Lift (Map k a) where
70+ liftTyped x = unsafeTExpCoerce (lift x)
71+ lift m = [|M.fromList (M.toList m)|]
6872#else
6973instance (Lift k, Lift a) => Lift (Map k a) where
7074 lift m = [|M.fromList (M.toList m)|]
@@ -73,7 +77,7 @@ instance (Lift k, Lift a) => Lift (Map k a) where
7377-- so we use this type.
7478data DerivingOptions = DerivingOptions
7579 { prefix :: Maybe String
76− -- ^ Optional prefix to strip from constructors and field labels
80+ -- ^ Optional prefix to strip from constructors and field labels
7781 , snake :: Bool
7882 -- ^ Whether to snake constructors and field labels
7983 -- Applied after stripping prefix
@@ -107,12 +111,12 @@ derivingOptionsToJsonOptions DerivingOptions{..} = defaultOptions
107111 snaked = if snake then camelTo2 '_' else id
108112 stripped = maybe id stripPrefix' prefix
109113
110−#ifndef ghcjs_HOST_OS
114+#ifdef BACKEND
111115datatypeVarsTypes :: DatatypeInfo -> [Type]
112116#if MIN_VERSION_th_abstraction(0,3,0)
113−datatypeVarsTypes = fmap (VarT . tvName) . datatypeVars
117+datatypeVarsTypes = fmap (VarT . tvName) . datatypeVars
114118#else
115−datatypeVarsTypes = datatypeVars
119+datatypeVarsTypes = datatypeVars
116120#endif
117121
118122derivingOptionsToSchemaOptions :: DerivingOptions -> SchemaOptions
@@ -120,7 +124,7 @@ derivingOptionsToSchemaOptions = fromAesonOptions . derivingOptionsToJsonOptions
120124
121125deriveToParamSchema :: DerivingOptions -> Name -> Q [Dec]
122126deriveToParamSchema opts tname = do
123− body <- AppE (VarE 'genericToParamSchema)
127+ body <- AppE (VarE 'genericToParamSchema)
124128 . AppE (VarE 'derivingOptionsToSchemaOptions) <$> lift opts
125129 pure [InstanceD Nothing []
126130 (ConT ''ToParamSchema `AppT` ConT tname)
@@ -140,11 +144,11 @@ deriveToSchema opts tname = do
140144 [ FunD 'declareNamedSchema [Clause [] (NormalB body) []] ]]
141145
142146deriveArbitrary :: Name -> Q [Dec]
143−deriveArbitrary t = do
147+deriveArbitrary t = do
144148 tinfo <- reifyDatatype t
145− let
149+ let
146150 typ = datatypeType tinfo
147− ctx = datatypeVarsTypes tinfo >>= \tv ->
151+ ctx = datatypeVarsTypes tinfo >>= \tv ->
148152 [ ConT ''Arbitrary `AppT` tv
149153 , ConT ''Arg `AppT` typ `AppT` tv ]
150154 pure [InstanceD Nothing ctx (ConT ''Arbitrary `AppT` typ)
@@ -163,4 +167,3 @@ generateParseJSON = mkParseJSON . derivingOptionsToJsonOptions
163167
164168stripPrefix' :: String -> String -> String
165169stripPrefix' pfx = fromMaybe <*> stripPrefix pfx
166−