@@ -1,108 +1,139 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2{-# OPTIONS_GHC -Wno-orphans #-}
2{-# OPTIONS_GHC -Wno-orphans #-}
6+-- >>> :set -XDerivingStrategies -XDerivingVia -XDeriveGeneric
10+-- { userFirstName :: String,
11+-- userAge :: Maybe Integer
13+-- deriving stock (Generic)
14+-- deriving (FromJSON, ToJSON, ToSchema)
16+-- '[FieldLabelModifier '[StripPrefix "user", CamelToSnake], RejectUnknownFields]
18+-- showYaml = Data.ByteString.Char8.putStr . Data.Yaml.encode
21+-- >>> showYaml $ toSchema (Proxy :: Proxy User)
30+-- additionalProperties: false
4module Deriving.OpenApi
31module Deriving.OpenApi
5 ( CustomOpenApi,
32 ( CustomOpenApi,
6 DatatypeNameModifier,
33 DatatypeNameModifier,
8 module Deriving.Aeson,
35 module Deriving.Aeson,
13import Control.Lens
39import Control.Lens
14import qualified Data.Aeson.Types as A
40import qualified Data.Aeson.Types as A
16import Data.OpenApi
41import Data.OpenApi
42+import Data.OpenApi.Internal.ParamSchema
17import Data.OpenApi.Internal.Schema
43import Data.OpenApi.Internal.Schema
18import Data.Proxy
44import Data.Proxy
45+import Data.Text (Text)
46+import qualified Data.Text as T
19import Data.Typeable
47import Data.Typeable
20import Deriving.Aeson
48import Deriving.Aeson
21import GHC.Generics
49import GHC.Generics
22import GHC.TypeLits
50import GHC.TypeLits
24−#ifdef SERVANT_DESCRIPTION
52+data Description (desc :: Symbol) = Description
27−import Data.Text (Text)
28−import qualified Data.Text as T
30instance (AesonOptions xs) => AesonOptions (Description f ': xs) where
54instance (AesonOptions xs) => AesonOptions (Description f ': xs) where
31 aesonOptions = aesonOptions @xs
55 aesonOptions = aesonOptions @xs
33−instance (OpenApiOptions xs, KnownSymbol t) => OpenApiOptions (Description t ': xs) where
57+instance KnownSymbol t => OpenApiOptionModifier (Description t) where
34− openApiOptions = openApiOptions @xs
35 openApiSchemaModifier = schema . description <>~ Just (toTextLine @t)
58 openApiSchemaModifier = schema . description <>~ Just (toTextLine @t)
37toTextLine :: forall s. KnownSymbol s => Text
60toTextLine :: forall s. KnownSymbol s => Text
38toTextLine = "\n\n" <> T.pack (symbolVal (Proxy @s))
61toTextLine = "\n\n" <> T.pack (symbolVal (Proxy @s))
64+-- >>> import qualified Data.Yaml
65+-- >>> import qualified Data.ByteString.Char8
42type CustomOpenApi = CustomJSON
67type CustomOpenApi = CustomJSON
44−instance (OpenApiOptions xs, GToSchema (Rep x), Generic x, Typeable x, Typeable xs) => ToSchema (CustomJSON xs x) where
70+ (OpenApiOptionModifier xs, GToSchema (Rep x), Generic x, Typeable x, Typeable xs, Typeable k) =>
71+ ToSchema (CustomJSON (xs :: k) x)
45 declareNamedSchema Proxy =
73 declareNamedSchema Proxy =
46− openApiSchemaModifier @xs <$> genericDeclareNamedSchema (openApiOptions @xs) (Proxy @x)
74+ openApiSchemaModifier @xs
75+ <$> genericDeclareNamedSchema (openApiOptionsModifier @xs defaultSchemaOptions) (Proxy @x)
78+ (OpenApiOptionModifier xs, GToParamSchema (Rep x), Generic x) =>
79+ ToParamSchema (CustomJSON (xs :: k) x)
81+ toParamSchema Proxy =
82+ genericToParamSchema (openApiOptionsModifier @xs defaultSchemaOptions) (Proxy @x)
84+class OpenApiOptionModifier x where
85+ openApiOptionsModifier :: SchemaOptions -> SchemaOptions
86+ openApiOptionsModifier = id
87+ openApiSchemaModifier :: NamedSchema -> NamedSchema
88+ openApiSchemaModifier = id
48data DatatypeNameModifier t
90data DatatypeNameModifier t
50−instance (StringModifier f, OpenApiOptions xs) => OpenApiOptions (DatatypeNameModifier f ': xs) where
92+instance (StringModifier f) => OpenApiOptionModifier (DatatypeNameModifier f) where
51− openApiOptions = (openApiOptions @xs) {datatypeNameModifier = getStringModifier @f}
93+ openApiOptionsModifier o = o {datatypeNameModifier = getStringModifier @f}
53instance (AesonOptions xs) => AesonOptions (DatatypeNameModifier f ': xs) where
95instance (AesonOptions xs) => AesonOptions (DatatypeNameModifier f ': xs) where
54 aesonOptions = aesonOptions @xs
96 aesonOptions = aesonOptions @xs
56−type family (++) (x :: [k]) (y :: [k]) :: [k] where
58− (++) (x ': xs) ys = xs ++ (x ': ys)
60−type family Extending (c :: * -> *) (ee :: [*]) :: * -> * where
61− Extending (CustomJSON a) ee = CustomJSON (a ++ ee)
63-- deriving-aeson-based instances
98-- deriving-aeson-based instances
65−class OpenApiOptions (xs :: [Type]) where
66− openApiOptions :: SchemaOptions
67− openApiSchemaModifier :: NamedSchema -> NamedSchema
68− openApiSchemaModifier = id
70−instance OpenApiOptions '[] where
71− openApiOptions = defaultSchemaOptions
73−instance OpenApiOptions xs => OpenApiOptions (UnwrapUnaryRecords ': xs) where
100+instance OpenApiOptionModifier UnwrapUnaryRecords where
74− openApiOptions = (openApiOptions @xs) {unwrapUnaryRecords = True}
101+ openApiOptionsModifier o = o {unwrapUnaryRecords = True}
76−instance OpenApiOptions xs => OpenApiOptions (OmitNothingFields ': xs) where
103+instance OpenApiOptionModifier OmitNothingFields
77− openApiOptions = openApiOptions @xs
79−instance OpenApiOptions xs => OpenApiOptions (RejectUnknownFields ': xs) where
105+#if MIN_VERSION_deriving_aeson(0,2,4)
80− openApiOptions = openApiOptions @xs
106+instance OpenApiOptionModifier RejectUnknownFields where
81 openApiSchemaModifier = schema . additionalProperties .~ Just (AdditionalPropertiesAllowed False)
107 openApiSchemaModifier = schema . additionalProperties .~ Just (AdditionalPropertiesAllowed False)
83−instance (StringModifier f, OpenApiOptions xs) => OpenApiOptions (FieldLabelModifier f ': xs) where
110+instance StringModifier f => OpenApiOptionModifier (FieldLabelModifier f) where
84− openApiOptions = (openApiOptions @xs) {fieldLabelModifier = getStringModifier @f}
111+ openApiOptionsModifier o = o {fieldLabelModifier = getStringModifier @f}
86−instance (StringModifier f, OpenApiOptions xs) => OpenApiOptions (ConstructorTagModifier f ': xs) where
113+instance StringModifier f => OpenApiOptionModifier (ConstructorTagModifier f) where
87− openApiOptions = (openApiOptions @xs) {constructorTagModifier = getStringModifier @f}
114+ openApiOptionsModifier o = o {constructorTagModifier = getStringModifier @f}
90− (OpenApiOptions xs, TypeError ('Text "openapi3-deriving does not currently the `TagSingleConstructors` modifier.")) =>
117+ TypeError ('Text "deriving-openapi3 does not currently the `TagSingleConstructors` modifier.") =>
91− OpenApiOptions (TagSingleConstructors ': xs)
118+ OpenApiOptionModifier TagSingleConstructors
93− openApiOptions = undefined
120+instance OpenApiOptionModifier NoAllNullaryToStringTag where
121+ openApiOptionsModifier o = o {allNullaryToStringTag = False}
123+instance (KnownSymbol t, KnownSymbol c) => OpenApiOptionModifier (SumTaggedObject t c) where
124+ openApiOptionsModifier o = o {sumEncoding = A.TaggedObject (symbolVal (Proxy @t)) (symbolVal (Proxy @c))}
95−instance OpenApiOptions xs => OpenApiOptions (NoAllNullaryToStringTag ': xs) where
126+instance OpenApiOptionModifier SumUntaggedValue where
96− openApiOptions = (openApiOptions @xs) {allNullaryToStringTag = False}
127+ openApiOptionsModifier o = o {sumEncoding = A.UntaggedValue}
98−instance (KnownSymbol t, KnownSymbol c, OpenApiOptions xs) => OpenApiOptions (SumTaggedObject t c ': xs) where
129+instance OpenApiOptionModifier SumObjectWithSingleField where
99− openApiOptions = (openApiOptions @xs) {sumEncoding = A.TaggedObject (symbolVal (Proxy @t)) (symbolVal (Proxy @c))}
130+ openApiOptionsModifier o = o {sumEncoding = A.ObjectWithSingleField}
101−instance (OpenApiOptions xs) => OpenApiOptions (SumUntaggedValue ': xs) where
132+instance OpenApiOptionModifier SumTwoElemArray where
102− openApiOptions = (openApiOptions @xs) {sumEncoding = A.UntaggedValue}
133+ openApiOptionsModifier o = o {sumEncoding = A.TwoElemArray}
104−instance (OpenApiOptions xs) => OpenApiOptions (SumObjectWithSingleField ': xs) where
135+instance OpenApiOptionModifier '[]
105− openApiOptions = (openApiOptions @xs) {sumEncoding = A.ObjectWithSingleField}
107−instance (OpenApiOptions xs) => OpenApiOptions (SumTwoElemArray ': xs) where
137+instance (OpenApiOptionModifier x, OpenApiOptionModifier xs) => OpenApiOptionModifier (x ': xs) where
108− openApiOptions = (openApiOptions @xs) {sumEncoding = A.TwoElemArray}
138+ openApiOptionsModifier = openApiOptionsModifier @xs . openApiOptionsModifier @x
139+ openApiSchemaModifier = openApiSchemaModifier @xs . openApiSchemaModifier @x