Merge pull request #41 from GetShopTV/make-fields-#39

Switch to classy field lenses

src/Data/Swagger.hs

@@ -33,8 +33,7 @@ module Data.Swagger (
   Contact(..),
   License(..),
 
-  -- ** Paths
-  Paths(..),
+  -- ** PathItem
   PathItem(..),
 
   -- ** Operations
@@ -160,33 +159,61 @@ import Data.Swagger.Internal
 -- $lens
 --
 -- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used
--- to modify this structure. In combination with @'Monoid'@ instances, lenses
--- also make it fairly simple to construct/modify any part of the specification:
+-- to work comfortly with it. In combination with @'Monoid'@ instances, lenses
+-- make it fairly simple to construct/modify any part of the specification:
 --
 -- >>> :{
--- encode $ mempty & pathsMap .~
---   [ ("/user", mempty & pathItemGet ?~ (mempty
---       & operationProduces ?~ MimeList ["application/json"]
---       & operationResponses .~ (mempty
---         & responsesResponses . at 200 ?~ Inline (mempty & responseSchema ?~ Ref (Reference "#/definitions/User")))))]
+-- encode $ (mempty :: Swagger)
+--   & definitions .~ [ ("User", mempty & type_ .~ SwaggerString) ]
+--   & paths .~
+--     [ ("/user", mempty & get ?~ (mempty
+--         & produces ?~ MimeList ["application/json"]
+--         & at 200 ?~ Inline (mempty & schema ?~ Ref (Reference "User")))) ]
 -- :}
--- "{\"/user\":{\"get\":{\"responses\":{\"200\":{\"schema\":{\"$ref\":\"#/definitions/#/definitions/User\"},\"description\":\"\"}},\"produces\":[\"application/json\"]}}}"
+-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"definitions\":{\"User\":{\"type\":\"string\"}},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"schema\":{\"$ref\":\"#/definitions/User\"},\"description\":\"\"}},\"produces\":[\"application/json\"]}}}}"
 --
--- In the snippet above we declare API paths with a single path @/user@ providing method @GET@
+-- 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
--- by schema @User@ (which should be defined in @definitions@ property of swagger specification).
+-- by schema @User@ which is defined in @'definitions'@ property of swagger specification.
 --
--- Since @'ParamSchema'@ is basically the /base schema specification/, a special
--- @'HasParamSchema'@ class has been introduced to generalize @'ParamSchema'@ lenses
--- and allow them to be used by any type that has a @'ParamSchema'@:
+-- For convenience, @swagger2@ uses /classy field lenses/. It means that
+-- field accessor names can be overloaded for different types. One such
+-- common field is @'description'@. Many components of Swagger specification
+-- can have descriptions, and you can use the same name for them:
 --
+-- >>> encode $ (mempty :: Response) & description .~ "No content"
+-- "{\"description\":\"No content\"}"
 -- >>> :{
--- encode $ mempty
---   & schemaTitle   ?~ "Email"
---   & schemaType    .~ SwaggerString
---   & schemaFormat  ?~ "email"
+-- encode $ (mempty :: Schema)
+--   & type_       .~ SwaggerBoolean
+--   & description ?~ "To be or not to be"
 -- :}
--- "{\"format\":\"email\",\"title\":\"Email\",\"type\":\"string\"}"
+-- "{\"type\":\"boolean\",\"description\":\"To be or not to be\"}"
+--
+-- @'ParamSchema'@ is basically the /base schema specification/ and many types contain it (see @'HasParamSchema'@).
+-- So for convenience, all @'ParamSchema'@ fields are transitively made fields of the type that has it.
+-- For example, you can use @'type_'@ to access @'SwaggerType'@ of @'Header'@ schema without having to use @'paramSchema'@:
+--
+-- >>> encode $ (mempty :: Header) & type_ .~ SwaggerNumber
+-- "{\"type\":\"number\"}"
+--
+-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
+-- have direct access to it via @'at' code@. Example:
+--
+-- >>> :{
+-- encode $ (mempty :: Operation)
+--   & at 404 ?~ Inline (mempty & description .~ "Not found")
+-- :}
+-- "{\"responses\":{\"404\":{\"description\":\"Not found\"}}}"
+--
+-- You might've noticed that @'type_'@ has an extra underscore in its name
+-- compared to, say, @'description'@ field accessor.
+-- This is because @type@ is a keyword in Haskell.
+-- A few other field accessors are modified in this way:
+--
+--    - @'in_'@, @'type_'@, @'default_'@ (as keywords);
+--    - @'maximum_'@ and @'minimum_'@ (as conflicting with @Prelude@);
+--    - @'enum_'@ (as conflicting with @Control.Lens@).
 
 -- $schema
 --
@@ -199,8 +226,8 @@ import Data.Swagger.Internal
 -- with properties in addition to what @'ParamSchema'@ provides.
 --
 -- In most cases you will have a Haskell data type for which you would like to
--- define a corresponding schema. To facilitate thise use case
--- this library provides two classes for schema encoding.
+-- define a corresponding schema. To facilitate this use case
+-- @swagger2@ provides two classes for schema encoding.
 -- Both these classes provide means to encode /types/ as Swagger /schemas/.
 --
 -- @'ToParamSchema'@ is intended to be used for primitive API endpoint parameters,

src/Data/Swagger/Internal.hs

@@ -40,61 +40,63 @@ type Definitions = HashMap Text
 data Swagger = Swagger
   { -- | Provides metadata about the API.
     -- The metadata can be used by the clients if needed.
-    _info :: Info
+    _swaggerInfo :: Info
 
     -- | The host (name or ip) serving the API. It MAY include a port.
     -- If the host is not included, the host serving the documentation is to be used (including the port).
-  , _host :: Maybe Host
+  , _swaggerHost :: Maybe Host
 
     -- | The base path on which the API is served, which is relative to the host.
     -- If it is not included, the API is served directly under the host.
     -- The value MUST start with a leading slash (/).
-  , _basePath :: Maybe FilePath
+  , _swaggerBasePath :: Maybe FilePath
 
     -- | The transfer protocol of the API.
     -- If the schemes is not included, the default scheme to be used is the one used to access the Swagger definition itself.
-  , _schemes :: Maybe [Scheme]
+  , _swaggerSchemes :: Maybe [Scheme]
 
     -- | A list of MIME types the APIs can consume.
     -- This is global to all APIs but can be overridden on specific API calls.
-  , _consumes :: MimeList
+  , _swaggerConsumes :: MimeList
 
     -- | A list of MIME types the APIs can produce.
     -- This is global to all APIs but can be overridden on specific API calls.
-  , _produces :: MimeList
+  , _swaggerProduces :: MimeList
 
     -- | The available paths and operations for the API.
-  , _paths :: Paths
+    -- Holds the relative paths to the individual endpoints.
+    -- The path is appended to the @'basePath'@ in order to construct the full URL.
+  , _swaggerPaths :: HashMap FilePath PathItem
 
     -- | An object to hold data types produced and consumed by operations.
-  , _definitions :: Definitions Schema
+  , _swaggerDefinitions :: Definitions Schema
 
     -- | An object to hold parameters that can be used across operations.
     -- This property does not define global parameters for all operations.
-  , _parameters :: Definitions Param
+  , _swaggerParameters :: Definitions Param
 
     -- | An object to hold responses that can be used across operations.
     -- This property does not define global responses for all operations.
-  , _responses :: Definitions Response
+  , _swaggerResponses :: Definitions Response
 
     -- | Security scheme definitions that can be used across the specification.
-  , _securityDefinitions :: Definitions SecurityScheme
+  , _swaggerSecurityDefinitions :: Definitions SecurityScheme
 
     -- | A declaration of which security schemes are applied for the API as a whole.
     -- The list of values describes alternative security schemes that can be used
     -- (that is, there is a logical OR between the security requirements).
     -- Individual operations can override this definition.
-  , _security :: [SecurityRequirement]
+  , _swaggerSecurity :: [SecurityRequirement]
 
     -- | A list of tags used by the specification with additional metadata.
     -- The order of the tags can be used to reflect on their order by the parsing tools.
     -- Not all tags that are used by the Operation Object must be declared.
     -- The tags that are not declared may be organized randomly or based on the tools' logic.
     -- Each tag name in the list MUST be unique.
-  , _tags :: [Tag]
+  , _swaggerTags :: [Tag]
 
     -- | Additional external documentation.
-  , _externalDocs :: Maybe ExternalDocs
+  , _swaggerExternalDocs :: Maybe ExternalDocs
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 -- | The object provides metadata about the API.
@@ -170,13 +172,6 @@ data Scheme
   | Wss
   deriving (Eq, Show, Generic, Data, Typeable)
 
--- | The available paths and operations for the API.
-data Paths = Paths
-  { -- | Holds the relative paths to the individual endpoints.
-    -- The path is appended to the @'basePath'@ in order to construct the full URL.
-    _pathsMap         :: HashMap FilePath PathItem
-  } deriving (Eq, Show, Generic, Data, Typeable)
-
 -- | Describes the operations available on a single path.
 -- A @'PathItem'@ may be empty, due to ACL constraints.
 -- The path itself is still exposed to the documentation viewer
@@ -719,7 +714,7 @@ instance Monoid Info where
   mempty = genericMempty
   mappend = genericMappend
 
-instance Monoid Paths where
+instance Monoid Contact where
   mempty = genericMempty
   mappend = genericMappend
 
@@ -772,7 +767,6 @@ instance Monoid Example where
 -- =======================================================================
 
 instance SwaggerMonoid Info
-instance SwaggerMonoid Paths
 instance SwaggerMonoid PathItem
 instance SwaggerMonoid Schema
 instance SwaggerMonoid (ParamSchema t)
@@ -907,7 +901,7 @@ instance ToJSON SecuritySchemeType where
     <+> object [ "type" .= ("oauth2" :: Text) ]
 
 instance ToJSON Swagger where
-  toJSON = omitEmpties . addVersion . genericToJSON (jsonPrefix "")
+  toJSON = omitEmpties . addVersion . genericToJSON (jsonPrefix "swagger")
     where
       addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
       addVersion _ = error "impossible"
@@ -937,9 +931,6 @@ instance ToJSON Host where
       Nothing -> host
       Just port -> host ++ ":" ++ show port
 
-instance ToJSON Paths where
-  toJSON (Paths m) = toJSON m
-
 instance ToJSON MimeList where
   toJSON (MimeList xs) = toJSON (map show xs)
 
@@ -1037,7 +1028,7 @@ instance FromJSON Swagger where
   parseJSON js@(Object o) = do
     (version :: Text) <- o .: "swagger"
     when (version /= "2.0") empty
-    (genericParseJSON (jsonPrefix "")
+    (genericParseJSON (jsonPrefix "swagger")
       `withDefaults` [ "consumes" .= (mempty :: MimeList)
                      , "produces" .= (mempty :: MimeList)
                      , "security" .= ([] :: [SecurityRequirement])
@@ -1080,9 +1071,6 @@ instance FromJSON Host where
       [host, portStr] = map Text.unpack [hostText, portText]
   parseJSON _ = empty
 
-instance FromJSON Paths where
-  parseJSON js = Paths <$> parseJSON js
-
 instance FromJSON MimeList where
   parseJSON js = (MimeList . map fromString) <$> parseJSON js
 

src/Data/Swagger/Internal/ParamSchema.hs

@@ -42,8 +42,8 @@ import Data.Swagger.SchemaOptions
 --
 -- instance ToParamSchema Direction where
 --   toParamSchema = mempty
---      & schemaType .~ SwaggerString
---      & schemaEnum .~ [ \"Up\", \"Down\" ]
+--      & type_ .~ SwaggerString
+--      & enum_ .~ [ \"Up\", \"Down\" ]
 -- @
 --
 -- Instead of manually writing your @'ToParamSchema'@ instance you can
@@ -74,23 +74,23 @@ class ToParamSchema a where
   toParamSchema = genericToParamSchema defaultSchemaOptions
 
 instance {-# OVERLAPPING #-} ToParamSchema String where
-  toParamSchema _ = mempty & schemaType .~ SwaggerString
+  toParamSchema _ = mempty & type_ .~ SwaggerString
 
 instance ToParamSchema Bool where
-  toParamSchema _ = mempty & schemaType .~ SwaggerBoolean
+  toParamSchema _ = mempty & type_ .~ SwaggerBoolean
 
 instance ToParamSchema Integer where
-  toParamSchema _ = mempty & schemaType .~ SwaggerInteger
+  toParamSchema _ = mempty & type_ .~ SwaggerInteger
 
 instance ToParamSchema Int    where toParamSchema = toParamSchemaBoundedIntegral
 instance ToParamSchema Int8   where toParamSchema = toParamSchemaBoundedIntegral
 instance ToParamSchema Int16  where toParamSchema = toParamSchemaBoundedIntegral
 
 instance ToParamSchema Int32 where
-  toParamSchema proxy = toParamSchemaBoundedIntegral proxy & schemaFormat ?~ "int32"
+  toParamSchema proxy = toParamSchemaBoundedIntegral proxy & format ?~ "int32"
 
 instance ToParamSchema Int64 where
-  toParamSchema proxy = toParamSchemaBoundedIntegral proxy & schemaFormat ?~ "int64"
+  toParamSchema proxy = toParamSchemaBoundedIntegral proxy & format ?~ "int64"
 
 instance ToParamSchema Word   where toParamSchema = toParamSchemaBoundedIntegral
 instance ToParamSchema Word8  where toParamSchema = toParamSchemaBoundedIntegral
@@ -104,52 +104,52 @@ instance ToParamSchema Word64 where toParamSchema = toParamSchemaBoundedIntegral
 -- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
 toParamSchemaBoundedIntegral :: forall proxy a t. (Bounded a, Integral a) => proxy a -> ParamSchema t
 toParamSchemaBoundedIntegral _ = mempty
-  & schemaType .~ SwaggerInteger
-  & schemaMinimum ?~ fromInteger (toInteger (minBound :: a))
-  & schemaMaximum ?~ fromInteger (toInteger (maxBound :: a))
+  & type_ .~ SwaggerInteger
+  & minimum_ ?~ fromInteger (toInteger (minBound :: a))
+  & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
 
 instance ToParamSchema Char where
   toParamSchema _ = mempty
-    & schemaType .~ SwaggerString
-    & schemaMaxLength ?~ 1
-    & schemaMinLength ?~ 1
+    & type_ .~ SwaggerString
+    & maxLength ?~ 1
+    & minLength ?~ 1
 
 instance ToParamSchema Scientific where
-  toParamSchema _ = mempty & schemaType .~ SwaggerNumber
+  toParamSchema _ = mempty & type_ .~ SwaggerNumber
 
 instance ToParamSchema Double where
   toParamSchema _ = mempty
-    & schemaType   .~ SwaggerNumber
-    & schemaFormat ?~ "double"
+    & type_  .~ SwaggerNumber
+    & format ?~ "double"
 
 instance ToParamSchema Float where
   toParamSchema _ = mempty
-    & schemaType   .~ SwaggerNumber
-    & schemaFormat ?~ "float"
+    & type_  .~ SwaggerNumber
+    & format ?~ "float"
 
 timeParamSchema :: String -> ParamSchema t
-timeParamSchema format = mempty
-  & schemaType      .~ SwaggerString
-  & schemaFormat    ?~ T.pack format
+timeParamSchema fmt = mempty
+  & type_  .~ SwaggerString
+  & format ?~ T.pack fmt
 
 -- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
 instance ToParamSchema Day where
   toParamSchema _ = timeParamSchema "date"
 
 -- |
--- >>> toParamSchema (Proxy :: Proxy LocalTime) ^. schemaFormat
+-- >>> toParamSchema (Proxy :: Proxy LocalTime) ^. format
 -- Just "yyyy-mm-ddThh:MM:ss"
 instance ToParamSchema LocalTime where
   toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss"
 
 -- |
--- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. schemaFormat
+-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. format
 -- Just "yyyy-mm-ddThh:MM:ss+hhMM"
 instance ToParamSchema ZonedTime where
   toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss+hhMM"
 
 -- |
--- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. schemaFormat
+-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. format
 -- Just "yyyy-mm-ddThh:MM:ssZ"
 instance ToParamSchema UTCTime where
   toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ssZ"
@@ -173,12 +173,12 @@ instance ToParamSchema a => ToParamSchema (Dual a)    where toParamSchema _ = to
 
 instance ToParamSchema a => ToParamSchema [a] where
   toParamSchema _ = mempty
-    & schemaType  .~ SwaggerArray
-    & schemaItems ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))
+    & type_ .~ SwaggerArray
+    & items ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))
 
 instance ToParamSchema a => ToParamSchema (Set a) where
   toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
-    & schemaUniqueItems ?~ True
+    & uniqueItems ?~ True
 
 instance ToParamSchema a => ToParamSchema (HashSet a) where
   toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))
@@ -188,8 +188,8 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where
 -- "{\"type\":\"string\",\"enum\":[\"_\"]}"
 instance ToParamSchema () where
   toParamSchema _ = mempty
-    & schemaType .~ SwaggerString
-    & schemaEnum ?~ ["_"]
+    & type_ .~ SwaggerString
+    & enum_ ?~ ["_"]
 
 -- | A configurable generic @'ParamSchema'@ creator.
 --
@@ -226,8 +226,8 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g)
 
 instance Constructor c => GEnumParamSchema (C1 c U1) where
   genumParamSchema opts _ s = s
-    & schemaType .~ SwaggerString
-    & schemaEnum %~ addEnumValue tag
+    & type_ .~ SwaggerString
+    & enum_ %~ addEnumValue tag
     where
       tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))