diff --git a/src/Data/Swagger/Internal.hs b/src/Data/Swagger/Internal.hs index 9de67b1..2022c12 100644 --- a/src/Data/Swagger/Internal.hs +++ b/src/Data/Swagger/Internal.hs @@ -15,6 +15,7 @@ import Control.Applicative import Control.Monad import Data.Aeson import Data.Aeson.TH (deriveJSON) +import qualified Data.Aeson.Types as JSON import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.Map (Map) @@ -811,9 +812,13 @@ instance ToJSON Example where instance ToJSON Reference where toJSON (Reference ref) = object [ "$ref" .= ref ] -instance ToJSON a => ToJSON (Referenced a) where - toJSON (Ref ref) = toJSON ref - toJSON (Inline x) = toJSON x +referencedToJSON :: ToJSON a => Text -> Referenced a -> Value +referencedToJSON prefix (Ref (Reference ref)) = object [ "$ref" .= (prefix <> ref) ] +referencedToJSON _ (Inline x) = toJSON x + +instance ToJSON (Referenced Schema) where toJSON = referencedToJSON "#/definitions/" +instance ToJSON (Referenced Param) where toJSON = referencedToJSON "#/parameters/" +instance ToJSON (Referenced Response) where toJSON = referencedToJSON "#/responses/" instance ToJSON (SwaggerType t) where toJSON SwaggerArray = "array" @@ -959,10 +964,21 @@ instance FromJSON Reference where parseJSON (Object o) = Reference <$> o .: "$ref" parseJSON _ = empty -instance FromJSON a => FromJSON (Referenced a) where - parseJSON js - = Ref <$> parseJSON js - <|> Inline <$> parseJSON js +referencedParseJSON :: FromJSON a => Text -> Value -> JSON.Parser (Referenced a) +referencedParseJSON prefix js@(Object o) = do + ms <- o .:? "$ref" + case ms of + Nothing -> Inline <$> parseJSON js + Just s -> Ref <$> parseRef s + where + parseRef s = do + case Text.stripPrefix prefix s of + Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s + Just suffix -> pure (Reference suffix) + +instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/" +instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/" +instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#/responses/" instance FromJSON Xml where parseJSON = genericParseJSON (jsonPrefix "xml") diff --git a/src/Data/Swagger/Internal/Schema.hs b/src/Data/Swagger/Internal/Schema.hs index 1000754..0b5d4f9 100644 --- a/src/Data/Swagger/Internal/Schema.hs +++ b/src/Data/Swagger/Internal/Schema.hs @@ -158,7 +158,7 @@ declareSchemaRef proxy = do when (not known) $ do declare [(name, schema)] void $ declareNamedSchema proxy - return $ Ref (Reference ("#/definitions/" <> name)) + return $ Ref (Reference name) _ -> Inline <$> declareSchema proxy class GToSchema (f :: * -> *) where @@ -376,7 +376,7 @@ gdeclareSchemaRef opts proxy = do when (not known) $ do declare [(name, schema)] void $ gdeclareNamedSchema opts proxy mempty - return $ Ref (Reference ("#/definitions/" <> name)) + return $ Ref (Reference name) _ -> Inline <$> gdeclareSchema opts proxy appendItem :: Referenced Schema -> Maybe SchemaItems -> Maybe SchemaItems diff --git a/test/Data/SwaggerSpec.hs b/test/Data/SwaggerSpec.hs index 0501e0f..8053cf1 100644 --- a/test/Data/SwaggerSpec.hs +++ b/test/Data/SwaggerSpec.hs @@ -237,7 +237,7 @@ schemaSimpleModelExample = mempty & schemaRequired .~ [ "name" ] & schemaProperties .~ [ ("name", Inline (mempty & schemaType .~ SwaggerString)) - , ("address", Ref (Reference "#/definitions/Address")) + , ("address", Ref (Reference "Address")) , ("age", Inline $ mempty & schemaMinimum ?~ 0 & schemaType .~ SwaggerInteger