@@ -10,7 +10,7 @@ module Derive.API.TH
1010 , derivingOptionsToJsonOptions
1111 , deriveApiInstances
1212 , deriveApiAndArbitraryInstances
13−#ifdef BACKEND
13+#ifndef ghcjs_HOST_OS
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−
35−#ifdef BACKEND
36−import Data.OpenApi hiding (prefix)
3734import Test.QuickCheck
3835import Test.QuickCheck.Arbitrary.Generic
36+
37+#ifndef ghcjs_HOST_OS
38+import Data.OpenApi hiding (prefix)
3939#endif
4040
4141-- | derive JSON and openapi3 (ToSchema) instances
4242deriveApiInstances :: DerivingOptions -> Name -> Q [Dec]
43−#ifdef BACKEND
43+#ifndef ghcjs_HOST_OS
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−#ifdef BACKEND
54+#ifndef ghcjs_HOST_OS
5555deriveApiAndArbitraryInstances opts tname = liftM2 (<>)
5656 (deriveApiInstances opts tname)
5757 (deriveArbitrary tname)
@@ -61,13 +61,9 @@ deriveApiAndArbitraryInstances opts tname =
6161#endif
6262
6363#if MIN_VERSION_containers(0,6,6)
64−#elif MIN_VERSION_template_haskell(2,17,0)
65−instance (Lift k, Lift a) => Lift (Map k a) where
66− liftTyped x = unsafeCodeCoerce (lift x)
67− lift m = [|M.fromList (M.toList m)|]
6864#elif MIN_VERSION_template_haskell(2,16,0)
6965instance (Lift k, Lift a) => Lift (Map k a) where
70− liftTyped x = unsafeTExpCoerce (lift x)
66+ liftTyped x = unsafeCodeCoerce (lift x)
7167 lift m = [|M.fromList (M.toList m)|]
7268#else
7369instance (Lift k, Lift a) => Lift (Map k a) where
@@ -77,7 +73,7 @@ instance (Lift k, Lift a) => Lift (Map k a) where
7773-- so we use this type.
7874data DerivingOptions = DerivingOptions
7975 { prefix :: Maybe String
80− -- ^ Optional prefix to strip from constructors and field labels
76+ -- ^ Optional prefix to strip from constructors and field labels
8177 , snake :: Bool
8278 -- ^ Whether to snake constructors and field labels
8379 -- Applied after stripping prefix
@@ -111,12 +107,12 @@ derivingOptionsToJsonOptions DerivingOptions{..} = defaultOptions
111107 snaked = if snake then camelTo2 '_' else id
112108 stripped = maybe id stripPrefix' prefix
113109
114−#ifdef BACKEND
110+#ifndef ghcjs_HOST_OS
115111datatypeVarsTypes :: DatatypeInfo -> [Type]
116112#if MIN_VERSION_th_abstraction(0,3,0)
117−datatypeVarsTypes = fmap (VarT . tvName) . datatypeVars
113+datatypeVarsTypes = fmap (VarT . tvName) . datatypeVars
118114#else
119−datatypeVarsTypes = datatypeVars
115+datatypeVarsTypes = datatypeVars
120116#endif
121117
122118derivingOptionsToSchemaOptions :: DerivingOptions -> SchemaOptions
@@ -124,7 +120,7 @@ derivingOptionsToSchemaOptions = fromAesonOptions . derivingOptionsToJsonOptions
124120
125121deriveToParamSchema :: DerivingOptions -> Name -> Q [Dec]
126122deriveToParamSchema opts tname = do
127− body <- AppE (VarE 'genericToParamSchema)
123+ body <- AppE (VarE 'genericToParamSchema)
128124 . AppE (VarE 'derivingOptionsToSchemaOptions) <$> lift opts
129125 pure [InstanceD Nothing []
130126 (ConT ''ToParamSchema `AppT` ConT tname)
@@ -144,11 +140,11 @@ deriveToSchema opts tname = do
144140 [ FunD 'declareNamedSchema [Clause [] (NormalB body) []] ]]
145141
146142deriveArbitrary :: Name -> Q [Dec]
147−deriveArbitrary t = do
143+deriveArbitrary t = do
148144 tinfo <- reifyDatatype t
149− let
145+ let
150146 typ = datatypeType tinfo
151− ctx = datatypeVarsTypes tinfo >>= \tv ->
147+ ctx = datatypeVarsTypes tinfo >>= \tv ->
152148 [ ConT ''Arbitrary `AppT` tv
153149 , ConT ''Arg `AppT` typ `AppT` tv ]
154150 pure [InstanceD Nothing ctx (ConT ''Arbitrary `AppT` typ)
@@ -167,3 +163,4 @@ generateParseJSON = mkParseJSON . derivingOptionsToJsonOptions
167163
168164stripPrefix' :: String -> String -> String
169165stripPrefix' pfx = fromMaybe <*> stripPrefix pfx
166+