10446b5...master · typeable/derive-api-th

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

on master help sign in

4 files changed+97−49

since splitsnapshots

unifiedsplit

default.nix+34 derive-api-th.cabal+35−34 shell.nix+1 src/Derive/API/TH.hs+27−15

default.nixnew file+34

@@ -0,0 +1,34 @@

1+{ reflex-platform ? ((import <nixpkgs> {}).fetchFromGitHub {

2+ owner = "reflex-frp";

3+ repo = "reflex-platform";

4+ rev = "a4664e3b99f1b89a77ac759501b6bd85e18eac95";

5+ sha256 = "1pjzjhj966rs16f4b80ir9v8d7g7q2aa0i0zs30fny3x0xk1b4ah";

6+ })

7+}:

8+(import reflex-platform { config.allowBroken = true; }).project ({ pkgs, ... }:{

9+ useWarp = true;

10+ withHoogle = false;

11+

12+ packages = {

13+ derive-api-th = ../derive-api-th;

14+ };

15+

16+ tools = _: [

17+ (pkgs.haskell.lib.dontCheck pkgs.haskellPackages.cabal-cargs)

18+ pkgs.inotify-tools

19+ ];

20+

21+ shellToolOverrides = ghc: super: {

22+ closure-compiler = null;

23+ haskell-ide-engine = null;

24+ hdevtools = null;

25+ hlint = null;

26+ stylish-haskell = null;

27+ hoogle = null;

28+ };

29+

30+ shells = {

31+ ghc = ["derive-api-th"];

32+ ghcjs = ["derive-api-th"];

33+ };

34+})

derive-api-th.cabal+35−34

@@ -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−bug-reports: https://github.com/typeable/derive-api-th/issues

8−author: Typeable

9−maintainer: dima@typeable.io

10−copyright: 2022 Typeable LLC

11−license: BSD3

12−license-file: LICENSE

13−build-type: Simple

14−extra-source-files:

15− README.md

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

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

9+author: Typeable

10+maintainer: dima@typeable.io

11+copyright: 2022 Typeable LLC

12+license: BSD3

13+license-file: LICENSE

14+build-type: Simple

15+extra-source-files: README.md

1616

1717source-repository head

18− type: git

18+ type: git

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

2020

2121library

22− exposed-modules:

23− Derive.API.TH

24− other-modules:

25− Paths_derive_api_th

26− hs-source-dirs:

27− src

22+ exposed-modules: Derive.API.TH

23+ other-modules: Paths_derive_api_th

24+ hs-source-dirs: src

2825 build-depends:

29− base >=4.7 && <5

30− , aeson

26+ aeson

27+ , base >=4.7 && <5

3128 , containers

3229 , template-haskell

3330 , th-abstraction

34− , generic-arbitrary

35− , QuickCheck

36− if !impl(ghcjs)

31+

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

3733 build-depends:

38− openapi3

39− default-language: Haskell2010

34+ generic-arbitrary >=1.0

35+ , openapi3

36+ , QuickCheck

37+

38+ cpp-options: -DBACKEND

39+

40+ default-language: Haskell2010

4041 default-extensions:

41− BlockArguments

42− , DuplicateRecordFields

43− , NamedFieldPuns

44− , RecordWildCards

45− , StandaloneDeriving

46− , TemplateHaskell

42+ BlockArguments

43+ DuplicateRecordFields

44+ NamedFieldPuns

45+ RecordWildCards

46+ StandaloneDeriving

47+ TemplateHaskell

shell.nixnew file+1

@@ -0,0 +1 @@

1+(import ./default.nix { }).shells.ghcjs

src/Derive/API/TH.hs+27−15

@@ -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)

@@ -60,11 +60,24 @@ deriveApiAndArbitraryInstances opts tname =

6060 deriveApiInstances opts tname

6161#endif

6262

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

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

72+#else

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

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

75+#endif

6376-- We can't directly 'lift' Options into TH (there is no instance for function),

6477-- so we use this type.

6578data DerivingOptions = DerivingOptions

6679 { prefix :: Maybe String

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

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

6881 , snake :: Bool

6982 -- ^ Whether to snake constructors and field labels

7083 -- Applied after stripping prefix

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

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

99112 stripped = maybe id stripPrefix' prefix

100113

101−#ifndef ghcjs_HOST_OS

114+#ifdef BACKEND

102115datatypeVarsTypes :: DatatypeInfo -> [Type]

103116#if MIN_VERSION_th_abstraction(0,3,0)

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

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

105118#else

106−datatypeVarsTypes = datatypeVars

119+datatypeVarsTypes = datatypeVars

107120#endif

108121

109122derivingOptionsToSchemaOptions :: DerivingOptions -> SchemaOptions

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

111124

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

113126deriveToParamSchema opts tname = do

114− body <- AppE (VarE 'genericToParamSchema)

127+ body <- AppE (VarE 'genericToParamSchema)

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

116129 pure [InstanceD Nothing []

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

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

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

132145

133146deriveArbitrary :: Name -> Q [Dec]

134−deriveArbitrary t = do

147+deriveArbitrary t = do

135148 tinfo <- reifyDatatype t

136− let

149+ let

137150 typ = datatypeType tinfo

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

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

139152 [ ConT ''Arbitrary `AppT` tv

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

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

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

154167

155168stripPrefix' :: String -> String -> String

156169stripPrefix' pfx = fromMaybe <*> stripPrefix pfx

157−