Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

IsString instances #47

Merged
merged 1 commit into from
Feb 1, 2016
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 4 additions & 3 deletions src/Data/Swagger.hs
Original file line number Diff line number Diff line change
Expand Up @@ -168,9 +168,10 @@ import Data.Swagger.Internal
-- & paths .~
-- [ ("/user", mempty & get ?~ (mempty
-- & produces ?~ MimeList ["application/json"]
-- & at 200 ?~ Inline (mempty & schema ?~ Ref (Reference "User")))) ]
-- & at 200 ?~ ("OK" & _Inline.schema ?~ Ref (Reference "User"))
-- & at 404 ?~ "User info not found")) ]
-- :}
-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"definitions\":{\"User\":{\"type\":\"string\"}},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"schema\":{\"$ref\":\"#/definitions/User\"},\"description\":\"\"}},\"produces\":[\"application/json\"]}}}}"
-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"definitions\":{\"User\":{\"type\":\"string\"}},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"404\":{\"description\":\"User info not found\"},\"200\":{\"schema\":{\"$ref\":\"#/definitions/User\"},\"description\":\"OK\"}},\"produces\":[\"application/json\"]}}}}"
--
-- In the snippet above we declare API with a single path @/user@ providing method @GET@
-- which produces @application/json@ output and should respond with code @200@ and body specified
Expand Down Expand Up @@ -202,7 +203,7 @@ import Data.Swagger.Internal
--
-- >>> :{
-- encode $ (mempty :: Operation)
-- & at 404 ?~ Inline (mempty & description .~ "Not found")
-- & at 404 ?~ "Not found"
-- :}
-- "{\"responses\":{\"404\":{\"description\":\"Not found\"}}}"
--
Expand Down
20 changes: 18 additions & 2 deletions src/Data/Swagger/Internal.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
Expand All @@ -23,7 +24,7 @@ import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid
import Data.Scientific (Scientific)
import Data.String (fromString)
import Data.String (IsString(..))
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Generics (Generic)
Expand Down Expand Up @@ -145,12 +146,18 @@ data License = License
, _licenseUrl :: Maybe URL
} deriving (Eq, Show, Generic, Data, Typeable)

instance IsString License where
fromString s = License (fromString s) Nothing

-- | The host (name or ip) serving the API. It MAY include a port.
data Host = Host
{ _hostName :: HostName -- ^ Host name.
, _hostPort :: Maybe PortNumber -- ^ Optional port.
} deriving (Eq, Show, Generic, Typeable)

instance IsString Host where
fromString s = Host s Nothing

hostConstr :: Constr
hostConstr = mkConstr hostDataType "Host" [] Prefix

Expand Down Expand Up @@ -582,6 +589,9 @@ data Response = Response
, _responseExamples :: Maybe Example
} deriving (Eq, Show, Generic, Data, Typeable)

instance IsString Response where
fromString s = Response (fromString s) Nothing mempty Nothing

type HeaderName = Text

data Header = Header
Expand Down Expand Up @@ -680,6 +690,9 @@ data Tag = Tag
, _tagExternalDocs :: Maybe ExternalDocs
} deriving (Eq, Show, Generic, Data, Typeable)

instance IsString Tag where
fromString s = Tag (fromString s) Nothing Nothing

-- | Allows referencing an external resource for extended documentation.
data ExternalDocs = ExternalDocs
{ -- | A short description of the target documentation.
Expand All @@ -698,7 +711,10 @@ newtype Reference = Reference { getReference :: Text }
data Referenced a
= Ref Reference
| Inline a
deriving (Eq, Show, Data, Typeable)
deriving (Eq, Show, Functor, Data, Typeable)

instance IsString a => IsString (Referenced a) where
fromString = Inline . fromString

newtype URL = URL { getUrl :: Text } deriving (Eq, Show, ToJSON, FromJSON, Data, Typeable)

Expand Down
2 changes: 2 additions & 0 deletions src/Data/Swagger/Lens.hs
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,8 @@ makeFields ''ExternalDocs
makePrisms ''ParamAnySchema
-- ** 'SecuritySchemeType' prisms
makePrisms ''SecuritySchemeType
-- ** 'Referenced' prisms
makePrisms ''Referenced

-- ** 'SwaggerItems' prisms

Expand Down
11 changes: 6 additions & 5 deletions test/Data/SwaggerSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -95,7 +95,8 @@ contactExampleJSON = [aesonQQ|
-- =======================================================================

licenseExample :: License
licenseExample = License "Apache 2.0" (Just (URL "http://www.apache.org/licenses/LICENSE-2.0.html"))
licenseExample = "Apache 2.0"
& url ?~ URL "http://www.apache.org/licenses/LICENSE-2.0.html"

licenseExampleJSON :: Value
licenseExampleJSON = [aesonQQ|
Expand Down Expand Up @@ -136,9 +137,8 @@ operationExample = mempty
& schema .~ ParamOther (stringSchema ParamFormData)
]

& responses .~ (mempty & responses .~
[ (200, Inline (mempty & description .~ "Pet updated."))
, (405, Inline (mempty & description .~ "Invalid input")) ])
& at 200 ?~ "Pet updated."
& at 405 ?~ "Invalid input"
& security .~ [SecurityRequirement [("petstore_auth", ["write:pets", "read:pets"])]]
where
stringSchema :: ParamLocation -> ParamOtherSchema
Expand Down Expand Up @@ -476,7 +476,8 @@ swaggerExample = mempty
& info .~ (mempty
& version .~ "1.0"
& title .~ "Todo API"
& license ?~ License "MIT" (Just (URL "http://mit.com"))
& license ?~ "MIT"
& license._Just.url ?~ URL "http://mit.com"
& description ?~ "This is a an API that tests servant-swagger support for a Todo API")
& paths.at "/todo/{id}" ?~ (mempty & get ?~ ((mempty :: Operation)
& at 200 ?~ Inline (mempty
Expand Down