@@ -13,6 +13,14 @@ import Data.Aeson
13import Data.Proxy
13import Data.Proxy
14import GHC.Generics
14import GHC.Generics
18+import Data.Scientific
19+import qualified Data.Text as T
20+import qualified Data.Text.Lazy as TL
16import Data.Swagger.Internal
24import Data.Swagger.Internal
17import Data.Swagger.Internal.Schema (SchemaOptions(..), defaultSchemaOptions)
25import Data.Swagger.Internal.Schema (SchemaOptions(..), defaultSchemaOptions)
18import Data.Swagger.Lens
26import Data.Swagger.Lens
@@ -23,6 +31,110 @@ class ToParamSchema a where
23 default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => proxy a -> ParamLocation -> ParamOtherSchema
31 default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => proxy a -> ParamLocation -> ParamOtherSchema
24 toParamSchema = genericToParamSchema defaultSchemaOptions
32 toParamSchema = genericToParamSchema defaultSchemaOptions
34+instance {-# OVERLAPPING #-} ToParamSchema String where
35+ toParamSchema _ loc = mempty
36+ & paramOtherSchemaIn .~ loc
37+ & paramOtherSchemaType .~ ParamString
39+instance ToParamSchema Bool where
40+ toParamSchema _ loc = mempty
41+ & paramOtherSchemaIn .~ loc
42+ & paramOtherSchemaType .~ ParamBoolean
44+instance ToParamSchema Integer where
45+ toParamSchema _ loc = mempty
46+ & paramOtherSchemaIn .~ loc
47+ & paramOtherSchemaType .~ ParamInteger
49+instance ToParamSchema Int where toParamSchema = toParamSchemaBoundedIntegral
50+instance ToParamSchema Int8 where toParamSchema = toParamSchemaBoundedIntegral
51+instance ToParamSchema Int16 where toParamSchema = toParamSchemaBoundedIntegral
52+instance ToParamSchema Int32 where toParamSchema = toParamSchemaBoundedIntegral
53+instance ToParamSchema Int64 where toParamSchema = toParamSchemaBoundedIntegral
55+instance ToParamSchema Word where toParamSchema = toParamSchemaBoundedIntegral
56+instance ToParamSchema Word8 where toParamSchema = toParamSchemaBoundedIntegral
57+instance ToParamSchema Word16 where toParamSchema = toParamSchemaBoundedIntegral
58+instance ToParamSchema Word32 where toParamSchema = toParamSchemaBoundedIntegral
59+instance ToParamSchema Word64 where toParamSchema = toParamSchemaBoundedIntegral
61+toParamSchemaBoundedIntegral :: forall proxy a. (Bounded a, Integral a) => proxy a -> ParamLocation -> ParamOtherSchema
62+toParamSchemaBoundedIntegral _ loc = mempty
63+ & paramOtherSchemaIn .~ loc
64+ & paramOtherSchemaType .~ ParamInteger
65+ & schemaMinimum ?~ fromInteger (toInteger (minBound :: a))
66+ & schemaMaximum ?~ fromInteger (toInteger (maxBound :: a))
68+instance ToParamSchema Char where
69+ toParamSchema _ loc = mempty
70+ & paramOtherSchemaIn .~ loc
71+ & paramOtherSchemaType .~ ParamString
72+ & schemaMaxLength ?~ 1
73+ & schemaMinLength ?~ 1
75+instance ToParamSchema Scientific where
76+ toParamSchema _ loc = mempty
77+ & paramOtherSchemaIn .~ loc
78+ & paramOtherSchemaType .~ ParamNumber
80+instance ToParamSchema Double where
81+ toParamSchema _ loc = mempty
82+ & paramOtherSchemaIn .~ loc
83+ & paramOtherSchemaType .~ ParamNumber
85+instance ToParamSchema Float where
86+ toParamSchema _ loc = mempty
87+ & paramOtherSchemaIn .~ loc
88+ & paramOtherSchemaType .~ ParamNumber
90+timeParamSchema :: String -> ParamLocation -> ParamOtherSchema
91+timeParamSchema format loc = mempty
92+ & paramOtherSchemaIn .~ loc
93+ & paramOtherSchemaType .~ ParamString
94+ & paramOtherSchemaFormat ?~ T.pack format
95+ & schemaMinLength ?~ toInteger (length format)
98+-- >>> toParamSchema (Proxy :: Proxy Day) ^. paramOtherSchemaFormat
100+instance ToParamSchema Day where
101+ toParamSchema _ = timeParamSchema "yyyy-mm-dd"
104+-- >>> toSchema (Proxy :: Proxy LocalTime) ^. schemaFormat
105+-- Just "yyyy-mm-ddThh:MM:ss"
106+instance ToParamSchema LocalTime where
107+ toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss"
110+-- >>> toSchema (Proxy :: Proxy ZonedTime) ^. schemaFormat
111+-- Just "yyyy-mm-ddTHH:MM:ss+HHMM"
112+instance ToParamSchema ZonedTime where
113+ toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss+HHMM"
116+-- >>> toSchema (Proxy :: Proxy UTCTime) ^. schemaFormat
117+-- Just "yyyy-mm-ddThh:MM:ssZ"
118+instance ToParamSchema UTCTime where
119+ toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ssZ"
121+instance ToParamSchema NominalDiffTime where
122+ toParamSchema _ = toParamSchema (Proxy :: Proxy Integer)
124+instance ToParamSchema T.Text where
125+ toParamSchema _ = toParamSchema (Proxy :: Proxy String)
127+instance ToParamSchema TL.Text where
128+ toParamSchema _ = toParamSchema (Proxy :: Proxy String)
130+instance ToParamSchema All where toParamSchema _ = toParamSchema (Proxy :: Proxy Bool)
131+instance ToParamSchema Any where toParamSchema _ = toParamSchema (Proxy :: Proxy Bool)
132+instance ToParamSchema a => ToParamSchema (Sum a) where toParamSchema _ = toParamSchema (Proxy :: Proxy a)
133+instance ToParamSchema a => ToParamSchema (Product a) where toParamSchema _ = toParamSchema (Proxy :: Proxy a)
134+instance ToParamSchema a => ToParamSchema (First a) where toParamSchema _ = toParamSchema (Proxy :: Proxy a)
135+instance ToParamSchema a => ToParamSchema (Last a) where toParamSchema _ = toParamSchema (Proxy :: Proxy a)
136+instance ToParamSchema a => ToParamSchema (Dual a) where toParamSchema _ = toParamSchema (Proxy :: Proxy a)
26genericToParamSchema :: forall proxy a. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> proxy a -> ParamLocation -> ParamOtherSchema
138genericToParamSchema :: forall proxy a. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> proxy a -> ParamLocation -> ParamOtherSchema
27genericToParamSchema opts _ loc = gtoParamSchema opts (Proxy :: Proxy (Rep a)) loc mempty
139genericToParamSchema opts _ loc = gtoParamSchema opts (Proxy :: Proxy (Rep a)) loc mempty
@@ -41,7 +153,6 @@ instance ToParamSchema c => GToParamSchema (K1 i c) where
41instance (GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) where
153instance (GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) where
42 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))
154 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))
45class GEnumParamSchema (f :: * -> *) where
156class GEnumParamSchema (f :: * -> *) where
46 genumParamSchema :: SchemaOptions -> proxy f -> ParamLocation -> ParamOtherSchema -> ParamOtherSchema
157 genumParamSchema :: SchemaOptions -> proxy f -> ParamLocation -> ParamOtherSchema -> ParamOtherSchema