c6e8971..master · typeable/derive-api-th

git.iko.soy/typeable/derive-api-th

on master help sign in

derive-api-th.cabal+34−33

since splitsnapshots

unifiedsplit

@@ -1,46 +1,47 @@

1−cabal-version: 1.12

1+cabal-version: 1.12

2+name: derive-api-th

3+version: 0.1.0.0

4+description:

5+ Please see the README on GitHub at <https://github.com/typeable/derive-api-th#readme>

3−name: derive-api-th

4−version: 0.1.0.0

5−description: Please see the README on GitHub at <https://github.com/typeable/derive-api-th#readme>

6−homepage: https://github.com/typeable/derive-api-th#readme

7+homepage: https://github.com/typeable/derive-api-th#readme

7−bug-reports: https://github.com/typeable/derive-api-th/issues

8+bug-reports: https://github.com/typeable/derive-api-th/issues

8−author: Typeable

9+author: Typeable

9−maintainer: dima@typeable.io

10+maintainer: dima@typeable.io

10−copyright: 2022 Typeable LLC

11+copyright: 2022 Typeable LLC

11−license: BSD3

12+license: BSD3

12−license-file: LICENSE

13+license-file: LICENSE

13−build-type: Simple

14+build-type: Simple

14−extra-source-files:

15+extra-source-files: README.md

15− README.md

17source-repository head

18− type: git

18+ type: git

19 location: https://github.com/typeable/derive-api-th

21library

22− exposed-modules:

22+ exposed-modules: Derive.API.TH

23− Derive.API.TH

24− other-modules:

25− Paths_derive_api_th

23+ other-modules: Paths_derive_api_th

26− hs-source-dirs:

24+ hs-source-dirs: src

27− src

28 build-depends:

25 build-depends:

26+ aeson

29− base >=4.7 && <5

27+ , base >=4.7 && <5

30− , aeson

31 , containers

28 , containers

32 , template-haskell

29 , template-haskell

33 , th-abstraction

30 , th-abstraction

31+

34− if !(impl(ghcjs) || arch(javascript))

32+ if !(impl(ghcjs) || arch(javascript) || arch(wasm32))

35 build-depends:

33 build-depends:

36− openapi3

34+ generic-arbitrary >=1.0

37− , generic-arbitrary

35+ , openapi3

38 , QuickCheck

36 , QuickCheck

37+

38+ cpp-options: -DBACKEND

39+

39− default-language: Haskell2010

40+ default-language: Haskell2010

40 default-extensions:

41 default-extensions:

41− BlockArguments

42+ BlockArguments

42− , DuplicateRecordFields

43+ DuplicateRecordFields

43− , NamedFieldPuns

44+ NamedFieldPuns

44− , RecordWildCards

45+ RecordWildCards

45− , StandaloneDeriving

46+ StandaloneDeriving

46− , TemplateHaskell

47+ TemplateHaskell

src/Derive/API/TH.hs+19−16

@@ -10,7 +10,7 @@ module Derive.API.TH

10 , derivingOptionsToJsonOptions

11 , deriveApiInstances

12 , deriveApiAndArbitraryInstances

13−#ifndef ghcjs_HOST_OS

13+#ifdef BACKEND

14 , derivingOptionsToSchemaOptions

15 , deriveToParamSchema

16 , deriveToSchema

@@ -31,16 +31,16 @@ import Data.Typeable

31import Language.Haskell.TH

32import Language.Haskell.TH.Datatype

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

39#endif

41-- | derive JSON and openapi3 (ToSchema) instances

42deriveApiInstances :: DerivingOptions -> Name -> Q [Dec]

43−#ifndef ghcjs_HOST_OS

43+#ifdef BACKEND

44deriveApiInstances opts tname = liftM2 (<>)

45 (deriveJSON (derivingOptionsToJsonOptions opts) tname)

46 (deriveToSchema opts tname)

@@ -51,7 +51,7 @@ deriveApiInstances opts tname =

52-- | derive JSON and openapi3 (ToSchema) and Arbitrary instances

53deriveApiAndArbitraryInstances :: DerivingOptions -> Name -> Q [Dec]

54−#ifndef ghcjs_HOST_OS

54+#ifdef BACKEND

55deriveApiAndArbitraryInstances opts tname = liftM2 (<>)

56 (deriveApiInstances opts tname)

57 (deriveArbitrary tname)

@@ -61,10 +61,14 @@ deriveApiAndArbitraryInstances opts tname =

61#endif

63#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)

65instance (Lift k, Lift a) => Lift (Map k a) where

66 liftTyped x = unsafeCodeCoerce (lift x)

67 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)|]

68#else

72#else

69instance (Lift k, Lift a) => Lift (Map k a) where

73instance (Lift k, Lift a) => Lift (Map k a) where

70 lift m = [|M.fromList (M.toList m)|]

74 lift m = [|M.fromList (M.toList m)|]

@@ -73,7 +77,7 @@ instance (Lift k, Lift a) => Lift (Map k a) where

73-- so we use this type.

77-- so we use this type.

74data DerivingOptions = DerivingOptions

78data DerivingOptions = DerivingOptions

75 { prefix :: Maybe String

79 { prefix :: Maybe String

76− -- ^ Optional prefix to strip from constructors and field labels

80+ -- ^ Optional prefix to strip from constructors and field labels

77 , snake :: Bool

81 , snake :: Bool

78 -- ^ Whether to snake constructors and field labels

82 -- ^ Whether to snake constructors and field labels

79 -- Applied after stripping prefix

83 -- Applied after stripping prefix

@@ -107,12 +111,12 @@ derivingOptionsToJsonOptions DerivingOptions{..} = defaultOptions

107 snaked = if snake then camelTo2 '_' else id

111 snaked = if snake then camelTo2 '_' else id

108 stripped = maybe id stripPrefix' prefix

112 stripped = maybe id stripPrefix' prefix

109

113

110−#ifndef ghcjs_HOST_OS

114+#ifdef BACKEND

111datatypeVarsTypes :: DatatypeInfo -> [Type]

115datatypeVarsTypes :: DatatypeInfo -> [Type]

112#if MIN_VERSION_th_abstraction(0,3,0)

116#if MIN_VERSION_th_abstraction(0,3,0)

113−datatypeVarsTypes = fmap (VarT . tvName) . datatypeVars

117+datatypeVarsTypes = fmap (VarT . tvName) . datatypeVars

114#else

118#else

115−datatypeVarsTypes = datatypeVars

119+datatypeVarsTypes = datatypeVars

116#endif

120#endif

117

121

118derivingOptionsToSchemaOptions :: DerivingOptions -> SchemaOptions

122derivingOptionsToSchemaOptions :: DerivingOptions -> SchemaOptions

@@ -120,7 +124,7 @@ derivingOptionsToSchemaOptions = fromAesonOptions . derivingOptionsToJsonOptions

120

124

121deriveToParamSchema :: DerivingOptions -> Name -> Q [Dec]

125deriveToParamSchema :: DerivingOptions -> Name -> Q [Dec]

122deriveToParamSchema opts tname = do

126deriveToParamSchema opts tname = do

123− body <- AppE (VarE 'genericToParamSchema)

127+ body <- AppE (VarE 'genericToParamSchema)

124 . AppE (VarE 'derivingOptionsToSchemaOptions) <$> lift opts

128 . AppE (VarE 'derivingOptionsToSchemaOptions) <$> lift opts

125 pure [InstanceD Nothing []

129 pure [InstanceD Nothing []

126 (ConT ''ToParamSchema `AppT` ConT tname)

130 (ConT ''ToParamSchema `AppT` ConT tname)

@@ -140,11 +144,11 @@ deriveToSchema opts tname = do

140 [ FunD 'declareNamedSchema [Clause [] (NormalB body) []] ]]

144 [ FunD 'declareNamedSchema [Clause [] (NormalB body) []] ]]

141

145

142deriveArbitrary :: Name -> Q [Dec]

146deriveArbitrary :: Name -> Q [Dec]

143−deriveArbitrary t = do

147+deriveArbitrary t = do

144 tinfo <- reifyDatatype t

148 tinfo <- reifyDatatype t

145− let

149+ let

146 typ = datatypeType tinfo

150 typ = datatypeType tinfo

147− ctx = datatypeVarsTypes tinfo >>= \tv ->

151+ ctx = datatypeVarsTypes tinfo >>= \tv ->

148 [ ConT ''Arbitrary `AppT` tv

152 [ ConT ''Arbitrary `AppT` tv

149 , ConT ''Arg `AppT` typ `AppT` tv ]

153 , ConT ''Arg `AppT` typ `AppT` tv ]

150 pure [InstanceD Nothing ctx (ConT ''Arbitrary `AppT` typ)

154 pure [InstanceD Nothing ctx (ConT ''Arbitrary `AppT` typ)

@@ -163,4 +167,3 @@ generateParseJSON = mkParseJSON . derivingOptionsToJsonOptions

163

167

164stripPrefix' :: String -> String -> String

168stripPrefix' :: String -> String -> String

165stripPrefix' pfx = fromMaybe <*> stripPrefix pfx

169stripPrefix' pfx = fromMaybe <*> stripPrefix pfx

166−