@@ -13,6 +13,14 @@ import Data.Aeson
1313import Data.Proxy
1414import GHC.Generics
1515
16+import Data.Int
17+import Data.Monoid
18+import Data.Scientific
19+import qualified Data.Text as T
20+import qualified Data.Text.Lazy as TL
21+import Data.Time
22+import Data.Word
23+
1624import Data.Swagger.Internal
1725import Data.Swagger.Internal.Schema (SchemaOptions(..), defaultSchemaOptions)
1826import Data.Swagger.Lens
@@ -23,6 +31,110 @@ class ToParamSchema a where
2331 default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => proxy a -> ParamLocation -> ParamOtherSchema
2432 toParamSchema = genericToParamSchema defaultSchemaOptions
2533
34+instance {-# OVERLAPPING #-} ToParamSchema String where
35+ toParamSchema _ loc = mempty
36+ & paramOtherSchemaIn .~ loc
37+ & paramOtherSchemaType .~ ParamString
38+
39+instance ToParamSchema Bool where
40+ toParamSchema _ loc = mempty
41+ & paramOtherSchemaIn .~ loc
42+ & paramOtherSchemaType .~ ParamBoolean
43+
44+instance ToParamSchema Integer where
45+ toParamSchema _ loc = mempty
46+ & paramOtherSchemaIn .~ loc
47+ & paramOtherSchemaType .~ ParamInteger
48+
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
54+
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
60+
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))
67+
68+instance ToParamSchema Char where
69+ toParamSchema _ loc = mempty
70+ & paramOtherSchemaIn .~ loc
71+ & paramOtherSchemaType .~ ParamString
72+ & schemaMaxLength ?~ 1
73+ & schemaMinLength ?~ 1
74+
75+instance ToParamSchema Scientific where
76+ toParamSchema _ loc = mempty
77+ & paramOtherSchemaIn .~ loc
78+ & paramOtherSchemaType .~ ParamNumber
79+
80+instance ToParamSchema Double where
81+ toParamSchema _ loc = mempty
82+ & paramOtherSchemaIn .~ loc
83+ & paramOtherSchemaType .~ ParamNumber
84+
85+instance ToParamSchema Float where
86+ toParamSchema _ loc = mempty
87+ & paramOtherSchemaIn .~ loc
88+ & paramOtherSchemaType .~ ParamNumber
89+
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)
96+
97+-- |
98+-- >>> toParamSchema (Proxy :: Proxy Day) ^. paramOtherSchemaFormat
99+-- Just "yyyy-mm-dd"
100+instance ToParamSchema Day where
101+ toParamSchema _ = timeParamSchema "yyyy-mm-dd"
102+
103+-- |
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"
108+
109+-- |
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"
114+
115+-- |
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"
120+
121+instance ToParamSchema NominalDiffTime where
122+ toParamSchema _ = toParamSchema (Proxy :: Proxy Integer)
123+
124+instance ToParamSchema T.Text where
125+ toParamSchema _ = toParamSchema (Proxy :: Proxy String)
126+
127+instance ToParamSchema TL.Text where
128+ toParamSchema _ = toParamSchema (Proxy :: Proxy String)
129+
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)
137+
26138genericToParamSchema :: forall proxy a. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> proxy a -> ParamLocation -> ParamOtherSchema
27139genericToParamSchema opts _ loc = gtoParamSchema opts (Proxy :: Proxy (Rep a)) loc mempty
28140
@@ -41,7 +153,6 @@ instance ToParamSchema c => GToParamSchema (K1 i c) where
41153instance (GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) where
42154 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))
43155
44−
45156class GEnumParamSchema (f :: * -> *) where
46157 genumParamSchema :: SchemaOptions -> proxy f -> ParamLocation -> ParamOtherSchema -> ParamOtherSchema
47158