@@ -19,26 +19,29 @@ module Data.Swagger.Internal where
1919import Prelude ()
2020import Prelude.Compat
2121
22−import Control.Lens ((&), (.~), (?~))
2322import Control.Applicative
24−import Data.Aeson hiding (Encoding)
25−import qualified Data.Aeson.Types as JSON
26−import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
27−import Data.Hashable (Hashable)
28−import qualified Data.HashMap.Strict as HashMap
29−import Data.HashSet.InsOrd (InsOrdHashSet)
30−import Data.Map (Map)
31−import qualified Data.Map as Map
32−import Data.Monoid (Monoid (..))
33−import Data.Semigroup.Compat (Semigroup (..))
34−import Data.Scientific (Scientific)
35−import Data.String (IsString(..))
36−import Data.Text (Text)
37−import qualified Data.Text as Text
38−import GHC.Generics (Generic)
39−import Network.Socket (HostName, PortNumber)
40−import Network.HTTP.Media (MediaType)
41−import Text.Read (readMaybe)
23+import Control.Lens ((&), (.~), (?~))
24+import Data.Aeson hiding (Encoding)
25+import qualified Data.Aeson.Types as JSON
26+import Data.Data (Constr, Data (..), DataType, Fixity (..), Typeable,
27+ constrIndex, mkConstr, mkDataType)
28+import Data.Hashable (Hashable (..))
29+import qualified Data.HashMap.Strict as HashMap
30+import Data.HashSet.InsOrd (InsOrdHashSet)
31+import Data.Map (Map)
32+import qualified Data.Map as Map
33+import Data.Monoid (Monoid (..))
34+import Data.Scientific (Scientific)
35+import Data.Semigroup.Compat (Semigroup (..))
36+import Data.String (IsString (..))
37+import Data.Text (Text)
38+import qualified Data.Text as Text
39+import Data.Text.Encoding (encodeUtf8)
40+import GHC.Generics (Generic)
41+import Network.HTTP.Media (MediaType, mainType, parameters, parseAccept, subType, (//),
42+ (/:))
43+import Network.Socket (HostName, PortNumber)
44+import Text.Read (readMaybe)
4245
4346import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
4447import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
@@ -304,6 +307,22 @@ data Operation = Operation
304307 , _operationServers :: [Server]
305308 } deriving (Eq, Show, Generic, Data, Typeable)
306309
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."
315+
316+ toConstr _ = mediaTypeConstr
317+
318+ dataTypeOf _ = mediaTypeData
319+
320+mediaTypeConstr = mkConstr mediaTypeData "MediaType" [] Prefix
321+mediaTypeData = mkDataType "MediaType" [mediaTypeConstr]
322+
323+instance Hashable MediaType where
324+ hashWithSalt salt mt = salt `hashWithSalt` show mt
325+
307326-- | Describes a single request body.
308327data RequestBody = RequestBody
309328 { -- | A brief description of the request body. This could contain examples of use.
@@ -314,7 +333,7 @@ data RequestBody = RequestBody
314333 -- The key is a media type or media type range and the value describes it.
315334 -- For requests that match multiple keys, only the most specific key is applicable.
316335 -- e.g. @text/plain@ overrides @text/*@
317− , _requestBodyContent :: InsOrdHashMap {-MediaType-} Text MediaTypeObject -- FIXME Data MediaType
336+ , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject
318337
319338 , _requestBodyRequired :: Maybe Bool
320339 } deriving (Eq, Show, Generic, Data, Typeable)
@@ -369,7 +388,7 @@ data Encoding = Encoding
369388 -- for array – the default is defined based on the inner type.
370389 -- The value can be a specific media type (e.g. @application/json@),
371390 -- a wildcard media type (e.g. @image/*@), or a comma-separated list of the two types.
372− _encodingContentType :: Maybe Text
391+ _encodingContentType :: Maybe MediaType
373392
374393 -- | A map allowing additional information to be provided as headers,
375394 -- for example @Content-Disposition@. @Content-Type@ is described separately
@@ -417,9 +436,6 @@ instance Data MimeList where
417436 toConstr (MimeList _) = mimeListConstr
418437 dataTypeOf _ = mimeListDataType
419438
420−-- TODO style
421−-- TODO example
422−
423439-- | Describes a single operation parameter.
424440-- A unique parameter is defined by a combination of a name and location.
425441data Param = Param
@@ -669,7 +685,7 @@ data Response = Response
669685 -- The key is a media type or media type range and the value describes it.
670686 -- For responses that match multiple keys, only the most specific key is applicable.
671687 -- e.g. @text/plain@ overrides @text/*@.
672− , _responseContent :: InsOrdHashMap Text MediaTypeObject
688+ , _responseContent :: InsOrdHashMap MediaType MediaTypeObject
673689
674690 -- | Maps a header name to its definition.
675691 , _responseHeaders :: InsOrdHashMap HeaderName (Referenced Header)
@@ -1137,7 +1153,14 @@ instance FromJSON OAuth2AuthorizationCodeFlow where
11371153-- Manual ToJSON instances
11381154-- =======================================================================
11391155
1140−instance (Eq p, ToJSON p, AesonDefaultValue p) =>ToJSON (OAuth2Flow p) where
1156+instance ToJSON MediaType where
1157+ toJSON = toJSON . show
1158+ toEncoding = toEncoding . show
1159+
1160+instance ToJSONKey MediaType where
1161+ toJSONKey = JSON.toJSONKeyText (Text.pack . show)
1162+
1163+instance (Eq p, ToJSON p, AesonDefaultValue p) => ToJSON (OAuth2Flow p) where
11411164 toJSON = sopSwaggerGenericToJSON
11421165 toEncoding = sopSwaggerGenericToEncoding
11431166
@@ -1271,6 +1294,13 @@ instance ToJSON AdditionalProperties where
12711294-- Manual FromJSON instances
12721295-- =======================================================================
12731296
1297+instance FromJSON MediaType where
1298+ parseJSON = withText "MediaType" $ \str ->
1299+ maybe (fail $ "Invalid media type literal " <> Text.unpack str) pure $ parseAccept $ encodeUtf8 str
1300+
1301+instance FromJSONKey MediaType where
1302+ fromJSONKey = FromJSONKeyTextParser (parseJSON . String)
1303+
12741304instance (Eq p, FromJSON p, AesonDefaultValue p) => FromJSON (OAuth2Flow p) where
12751305 parseJSON = sopSwaggerGenericParseJSON
12761306