@@ -19,26 +19,29 @@ module Data.Swagger.Internal where
19import Prelude ()
19import Prelude ()
20import Prelude.Compat
20import Prelude.Compat
22−import Control.Lens ((&), (.~), (?~))
23import Control.Applicative
22import Control.Applicative
23+import Control.Lens ((&), (.~), (?~))
24−import Data.Aeson hiding (Encoding)
24+import Data.Aeson hiding (Encoding)
25−import qualified Data.Aeson.Types as JSON
25+import qualified Data.Aeson.Types as JSON
26−import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
26+import Data.Data (Constr, Data (..), DataType, Fixity (..), Typeable,
27+ constrIndex, mkConstr, mkDataType)
27−import Data.Hashable (Hashable)
28+import Data.Hashable (Hashable (..))
28−import qualified Data.HashMap.Strict as HashMap
29+import qualified Data.HashMap.Strict as HashMap
29−import Data.HashSet.InsOrd (InsOrdHashSet)
30+import Data.HashSet.InsOrd (InsOrdHashSet)
30−import Data.Map (Map)
31+import Data.Map (Map)
31−import qualified Data.Map as Map
32+import qualified Data.Map as Map
32−import Data.Monoid (Monoid (..))
33+import Data.Monoid (Monoid (..))
34+import Data.Scientific (Scientific)
33−import Data.Semigroup.Compat (Semigroup (..))
35+import Data.Semigroup.Compat (Semigroup (..))
34−import Data.Scientific (Scientific)
35−import Data.String (IsString(..))
36+import Data.String (IsString (..))
36−import Data.Text (Text)
37+import Data.Text (Text)
37−import qualified Data.Text as Text
38+import qualified Data.Text as Text
39+import Data.Text.Encoding (encodeUtf8)
38−import GHC.Generics (Generic)
40+import GHC.Generics (Generic)
39−import Network.Socket (HostName, PortNumber)
41+import Network.HTTP.Media (MediaType, mainType, parameters, parseAccept, subType, (//),
40−import Network.HTTP.Media (MediaType)
42+ (/:))
43+import Network.Socket (HostName, PortNumber)
41−import Text.Read (readMaybe)
44+import Text.Read (readMaybe)
43import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
46import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
44import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
47import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
@@ -304,6 +307,22 @@ data Operation = Operation
304 , _operationServers :: [Server]
307 , _operationServers :: [Server]
305 } deriving (Eq, Show, Generic, Data, Typeable)
308 } deriving (Eq, Show, Generic, Data, Typeable)
310+-- This instance should be in @http-media@.
311+instance Data MediaType where
312+ gunfold k z c = case constrIndex c of
313+ 1 -> k (k (k (z (\main sub params -> foldl (/:) (main // sub) (Map.toList params)))))
314+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MediaType."
316+ toConstr _ = mediaTypeConstr
318+ dataTypeOf _ = mediaTypeData
320+mediaTypeConstr = mkConstr mediaTypeData "MediaType" [] Prefix
321+mediaTypeData = mkDataType "MediaType" [mediaTypeConstr]
323+instance Hashable MediaType where
324+ hashWithSalt salt mt = salt `hashWithSalt` show mt
307-- | Describes a single request body.
326-- | Describes a single request body.
308data RequestBody = RequestBody
327data RequestBody = RequestBody
309 { -- | A brief description of the request body. This could contain examples of use.
328 { -- | A brief description of the request body. This could contain examples of use.
@@ -314,7 +333,7 @@ data RequestBody = RequestBody
314 -- The key is a media type or media type range and the value describes it.
333 -- The key is a media type or media type range and the value describes it.
315 -- For requests that match multiple keys, only the most specific key is applicable.
334 -- For requests that match multiple keys, only the most specific key is applicable.
316 -- e.g. @text/plain@ overrides @text/*@
335 -- e.g. @text/plain@ overrides @text/*@
317− , _requestBodyContent :: InsOrdHashMap {-MediaType-} Text MediaTypeObject -- FIXME Data MediaType
336+ , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject
319 , _requestBodyRequired :: Maybe Bool
338 , _requestBodyRequired :: Maybe Bool
320 } deriving (Eq, Show, Generic, Data, Typeable)
339 } deriving (Eq, Show, Generic, Data, Typeable)
@@ -369,7 +388,7 @@ data Encoding = Encoding
369 -- for array – the default is defined based on the inner type.
388 -- for array – the default is defined based on the inner type.
370 -- The value can be a specific media type (e.g. @application/json@),
389 -- The value can be a specific media type (e.g. @application/json@),
371 -- a wildcard media type (e.g. @image/*@), or a comma-separated list of the two types.
390 -- a wildcard media type (e.g. @image/*@), or a comma-separated list of the two types.
372− _encodingContentType :: Maybe Text
391+ _encodingContentType :: Maybe MediaType
374 -- | A map allowing additional information to be provided as headers,
393 -- | A map allowing additional information to be provided as headers,
375 -- for example @Content-Disposition@. @Content-Type@ is described separately
394 -- for example @Content-Disposition@. @Content-Type@ is described separately
@@ -417,9 +436,6 @@ instance Data MimeList where
417 toConstr (MimeList _) = mimeListConstr
436 toConstr (MimeList _) = mimeListConstr
418 dataTypeOf _ = mimeListDataType
437 dataTypeOf _ = mimeListDataType
423-- | Describes a single operation parameter.
439-- | Describes a single operation parameter.
424-- A unique parameter is defined by a combination of a name and location.
440-- A unique parameter is defined by a combination of a name and location.
425data Param = Param
441data Param = Param
@@ -669,7 +685,7 @@ data Response = Response
669 -- The key is a media type or media type range and the value describes it.
685 -- The key is a media type or media type range and the value describes it.
670 -- For responses that match multiple keys, only the most specific key is applicable.
686 -- For responses that match multiple keys, only the most specific key is applicable.
671 -- e.g. @text/plain@ overrides @text/*@.
687 -- e.g. @text/plain@ overrides @text/*@.
672− , _responseContent :: InsOrdHashMap Text MediaTypeObject
688+ , _responseContent :: InsOrdHashMap MediaType MediaTypeObject
674 -- | Maps a header name to its definition.
690 -- | Maps a header name to its definition.
675 , _responseHeaders :: InsOrdHashMap HeaderName (Referenced Header)
691 , _responseHeaders :: InsOrdHashMap HeaderName (Referenced Header)
@@ -1137,7 +1153,14 @@ instance FromJSON OAuth2AuthorizationCodeFlow where
1137-- Manual ToJSON instances
1153-- Manual ToJSON instances
1138-- =======================================================================
1154-- =======================================================================
1156+instance ToJSON MediaType where
1157+ toJSON = toJSON . show
1158+ toEncoding = toEncoding . show
1160+instance ToJSONKey MediaType where
1161+ toJSONKey = JSON.toJSONKeyText (Text.pack . show)
1140−instance (Eq p, ToJSON p, AesonDefaultValue p) =>ToJSON (OAuth2Flow p) where
1163+instance (Eq p, ToJSON p, AesonDefaultValue p) => ToJSON (OAuth2Flow p) where
1141 toJSON = sopSwaggerGenericToJSON
1164 toJSON = sopSwaggerGenericToJSON
1142 toEncoding = sopSwaggerGenericToEncoding
1165 toEncoding = sopSwaggerGenericToEncoding
@@ -1271,6 +1294,13 @@ instance ToJSON AdditionalProperties where
1271-- Manual FromJSON instances
1294-- Manual FromJSON instances
1272-- =======================================================================
1295-- =======================================================================
1297+instance FromJSON MediaType where
1298+ parseJSON = withText "MediaType" $ \str ->
1299+ maybe (fail $ "Invalid media type literal " <> Text.unpack str) pure $ parseAccept $ encodeUtf8 str
1301+instance FromJSONKey MediaType where
1302+ fromJSONKey = FromJSONKeyTextParser (parseJSON . String)
1274instance (Eq p, FromJSON p, AesonDefaultValue p) => FromJSON (OAuth2Flow p) where
1304instance (Eq p, FromJSON p, AesonDefaultValue p) => FromJSON (OAuth2Flow p) where
1275 parseJSON = sopSwaggerGenericParseJSON
1305 parseJSON = sopSwaggerGenericParseJSON