@@ -1,139 +1,108 @@
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
31module Deriving.OpenApi
4module Deriving.OpenApi
32 ( CustomOpenApi,
5 ( CustomOpenApi,
33 DatatypeNameModifier,
6 DatatypeNameModifier,
35 module Deriving.Aeson,
8 module Deriving.Aeson,
39import Control.Lens
13import Control.Lens
40import qualified Data.Aeson.Types as A
14import qualified Data.Aeson.Types as A
41import Data.OpenApi
16import Data.OpenApi
42−import Data.OpenApi.Internal.ParamSchema
43import Data.OpenApi.Internal.Schema
17import Data.OpenApi.Internal.Schema
44import Data.Proxy
18import Data.Proxy
45−import Data.Text (Text)
46−import qualified Data.Text as T
47import Data.Typeable
19import Data.Typeable
48import Deriving.Aeson
20import Deriving.Aeson
49import GHC.Generics
21import GHC.Generics
50import GHC.TypeLits
22import GHC.TypeLits
52−data Description (desc :: Symbol) = Description
24+#ifdef SERVANT_DESCRIPTION
27+import Data.Text (Text)
28+import qualified Data.Text as T
54instance (AesonOptions xs) => AesonOptions (Description f ': xs) where
30instance (AesonOptions xs) => AesonOptions (Description f ': xs) where
55 aesonOptions = aesonOptions @xs
31 aesonOptions = aesonOptions @xs
57−instance KnownSymbol t => OpenApiOptionModifier (Description t) where
33+instance (OpenApiOptions xs, KnownSymbol t) => OpenApiOptions (Description t ': xs) where
34+ openApiOptions = openApiOptions @xs
58 openApiSchemaModifier = schema . description <>~ Just (toTextLine @t)
35 openApiSchemaModifier = schema . description <>~ Just (toTextLine @t)
60toTextLine :: forall s. KnownSymbol s => Text
37toTextLine :: forall s. KnownSymbol s => Text
61toTextLine = "\n\n" <> T.pack (symbolVal (Proxy @s))
38toTextLine = "\n\n" <> T.pack (symbolVal (Proxy @s))
64−-- >>> import qualified Data.Yaml
65−-- >>> import qualified Data.ByteString.Char8
67type CustomOpenApi = CustomJSON
42type CustomOpenApi = CustomJSON
70− (OpenApiOptionModifier xs, GToSchema (Rep x), Generic x, Typeable x, Typeable xs, Typeable k) =>
44+instance (OpenApiOptions xs, GToSchema (Rep x), Generic x, Typeable x, Typeable xs) => ToSchema (CustomJSON xs x) where
71− ToSchema (CustomJSON (xs :: k) x)
73 declareNamedSchema Proxy =
45 declareNamedSchema Proxy =
74− openApiSchemaModifier @xs
46+ openApiSchemaModifier @xs <$> genericDeclareNamedSchema (openApiOptions @xs) (Proxy @x)
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
90data DatatypeNameModifier t
48data DatatypeNameModifier t
92−instance (StringModifier f) => OpenApiOptionModifier (DatatypeNameModifier f) where
50+instance (StringModifier f, OpenApiOptions xs) => OpenApiOptions (DatatypeNameModifier f ': xs) where
93− openApiOptionsModifier o = o {datatypeNameModifier = getStringModifier @f}
51+ openApiOptions = (openApiOptions @xs) {datatypeNameModifier = getStringModifier @f}
95instance (AesonOptions xs) => AesonOptions (DatatypeNameModifier f ': xs) where
53instance (AesonOptions xs) => AesonOptions (DatatypeNameModifier f ': xs) where
96 aesonOptions = aesonOptions @xs
54 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)
98-- deriving-aeson-based instances
63-- 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
100−instance OpenApiOptionModifier UnwrapUnaryRecords where
73+instance OpenApiOptions xs => OpenApiOptions (UnwrapUnaryRecords ': xs) where
101− openApiOptionsModifier o = o {unwrapUnaryRecords = True}
74+ openApiOptions = (openApiOptions @xs) {unwrapUnaryRecords = True}
103−instance OpenApiOptionModifier OmitNothingFields
76+instance OpenApiOptions xs => OpenApiOptions (OmitNothingFields ': xs) where
77+ openApiOptions = openApiOptions @xs
105−#if MIN_VERSION_deriving_aeson(0,2,4)
106−instance OpenApiOptionModifier RejectUnknownFields where
79+instance OpenApiOptions xs => OpenApiOptions (RejectUnknownFields ': xs) where
80+ openApiOptions = openApiOptions @xs
107 openApiSchemaModifier = schema . additionalProperties .~ Just (AdditionalPropertiesAllowed False)
81 openApiSchemaModifier = schema . additionalProperties .~ Just (AdditionalPropertiesAllowed False)
110−instance StringModifier f => OpenApiOptionModifier (FieldLabelModifier f) where
83+instance (StringModifier f, OpenApiOptions xs) => OpenApiOptions (FieldLabelModifier f ': xs) where
111− openApiOptionsModifier o = o {fieldLabelModifier = getStringModifier @f}
84+ openApiOptions = (openApiOptions @xs) {fieldLabelModifier = getStringModifier @f}
113−instance StringModifier f => OpenApiOptionModifier (ConstructorTagModifier f) where
86+instance (StringModifier f, OpenApiOptions xs) => OpenApiOptions (ConstructorTagModifier f ': xs) where
114− openApiOptionsModifier o = o {constructorTagModifier = getStringModifier @f}
87+ openApiOptions = (openApiOptions @xs) {constructorTagModifier = getStringModifier @f}
117− TypeError ('Text "deriving-openapi3 does not currently the `TagSingleConstructors` modifier.") =>
90+ (OpenApiOptions xs, TypeError ('Text "openapi3-deriving does not currently the `TagSingleConstructors` modifier.")) =>
118− OpenApiOptionModifier TagSingleConstructors
91+ OpenApiOptions (TagSingleConstructors ': xs)
120−instance OpenApiOptionModifier NoAllNullaryToStringTag where
93+ openApiOptions = undefined
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))}
126−instance OpenApiOptionModifier SumUntaggedValue where
95+instance OpenApiOptions xs => OpenApiOptions (NoAllNullaryToStringTag ': xs) where
127− openApiOptionsModifier o = o {sumEncoding = A.UntaggedValue}
96+ openApiOptions = (openApiOptions @xs) {allNullaryToStringTag = False}
129−instance OpenApiOptionModifier SumObjectWithSingleField where
98+instance (KnownSymbol t, KnownSymbol c, OpenApiOptions xs) => OpenApiOptions (SumTaggedObject t c ': xs) where
130− openApiOptionsModifier o = o {sumEncoding = A.ObjectWithSingleField}
99+ openApiOptions = (openApiOptions @xs) {sumEncoding = A.TaggedObject (symbolVal (Proxy @t)) (symbolVal (Proxy @c))}
132−instance OpenApiOptionModifier SumTwoElemArray where
101+instance (OpenApiOptions xs) => OpenApiOptions (SumUntaggedValue ': xs) where
133− openApiOptionsModifier o = o {sumEncoding = A.TwoElemArray}
102+ openApiOptions = (openApiOptions @xs) {sumEncoding = A.UntaggedValue}
135−instance OpenApiOptionModifier '[]
104+instance (OpenApiOptions xs) => OpenApiOptions (SumObjectWithSingleField ': xs) where
105+ openApiOptions = (openApiOptions @xs) {sumEncoding = A.ObjectWithSingleField}
137−instance (OpenApiOptionModifier x, OpenApiOptionModifier xs) => OpenApiOptionModifier (x ': xs) where
107+instance (OpenApiOptions xs) => OpenApiOptions (SumTwoElemArray ': xs) where
138− openApiOptionsModifier = openApiOptionsModifier @xs . openApiOptionsModifier @x
108+ openApiOptions = (openApiOptions @xs) {sumEncoding = A.TwoElemArray}
139− openApiSchemaModifier = openApiSchemaModifier @xs . openApiSchemaModifier @x