Merge pull request #47 from GetShopTV/isstring-#43

IsString instances
GetShopTV · Feb 1, 2016 · 104bce6 · 104bce6
2 parents 87906b0 + ee1ebb7
commit 104bce6
Show file tree

Hide file tree

Showing 4 changed files with 30 additions and 10 deletions.
diff --git a/src/Data/Swagger.hs b/src/Data/Swagger.hs
@@ -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
@@ -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\"}}}"
 --

diff --git a/src/Data/Swagger/Internal.hs b/src/Data/Swagger/Internal.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -28,7 +29,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)
@@ -150,12 +151,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
 
@@ -591,6 +598,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
@@ -689,6 +699,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.
@@ -707,7 +720,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)
 

diff --git a/src/Data/Swagger/Lens.hs b/src/Data/Swagger/Lens.hs
@@ -48,6 +48,8 @@ makeFields ''ExternalDocs
 makePrisms ''ParamAnySchema
 -- ** 'SecuritySchemeType' prisms
 makePrisms ''SecuritySchemeType
+-- ** 'Referenced' prisms
+makePrisms ''Referenced
 
 -- ** 'SwaggerItems' prisms
 

diff --git a/test/Data/SwaggerSpec.hs b/test/Data/SwaggerSpec.hs
@@ -98,7 +98,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|
@@ -139,9 +140,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
@@ -479,7 +479,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