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

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

on 10446b5 help sign in

4 files changed+49−97

since splitsnapshots

unifiedsplit

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

default.nixdeleted−34

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

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+34−35

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

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>

1+cabal-version: 1.12

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

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

1616

1717source-repository head

18− type: git

18+ type: git

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

2020

2121library

22− exposed-modules: Derive.API.TH

23− other-modules: Paths_derive_api_th

24− hs-source-dirs: src

22+ exposed-modules:

23+ Derive.API.TH

24+ other-modules:

25+ Paths_derive_api_th

26+ hs-source-dirs:

27+ src

2528 build-depends:

26− aeson

27− , base >=4.7 && <5

29+ base >=4.7 && <5

30+ , aeson

2831 , containers

2932 , template-haskell

3033 , th-abstraction

31−

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

34+ , generic-arbitrary

35+ , QuickCheck

36+ if !impl(ghcjs)

3337 build-depends:

34− generic-arbitrary >=1.0

35− , openapi3

36− , QuickCheck

37−

38− cpp-options: -DBACKEND

39−

40− default-language: Haskell2010

38+ openapi3

39+ default-language: Haskell2010

4140 default-extensions:

42− BlockArguments

43− DuplicateRecordFields

44− NamedFieldPuns

45− RecordWildCards

46− StandaloneDeriving

47− TemplateHaskell

41+ BlockArguments

42+ , DuplicateRecordFields

43+ , NamedFieldPuns

44+ , RecordWildCards

45+ , StandaloneDeriving

46+ , TemplateHaskell

shell.nixdeleted−1

@@ -1 +0,0 @@

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

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

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

@@ -60,24 +60,11 @@ 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

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

7764-- so we use this type.

7865data DerivingOptions = DerivingOptions

7966 { prefix :: Maybe String

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

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

8168 , snake :: Bool

8269 -- ^ Whether to snake constructors and field labels

8370 -- Applied after stripping prefix

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

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

11299 stripped = maybe id stripPrefix' prefix

113100

114−#ifdef BACKEND

101+#ifndef ghcjs_HOST_OS

115102datatypeVarsTypes :: DatatypeInfo -> [Type]

116103#if MIN_VERSION_th_abstraction(0,3,0)

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

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

118105#else

119−datatypeVarsTypes = datatypeVars

106+datatypeVarsTypes = datatypeVars

120107#endif

121108

122109derivingOptionsToSchemaOptions :: DerivingOptions -> SchemaOptions

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

124111

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

126113deriveToParamSchema opts tname = do

127− body <- AppE (VarE 'genericToParamSchema)

114+ body <- AppE (VarE 'genericToParamSchema)

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

129116 pure [InstanceD Nothing []

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

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

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

145132

146133deriveArbitrary :: Name -> Q [Dec]

147−deriveArbitrary t = do

134+deriveArbitrary t = do

148135 tinfo <- reifyDatatype t

149− let

136+ let

150137 typ = datatypeType tinfo

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

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

152139 [ ConT ''Arbitrary `AppT` tv

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

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

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

167154

168155stripPrefix' :: String -> String -> String

169156stripPrefix' pfx = fromMaybe <*> stripPrefix pfx

157+