Merge pull request #8 from GetShopTV/maybe-bools-#1

Wrap Bool in Maybe everywhere to gain true monoids
GetShopTV · Nov 10, 2015 · 24d4040 · 24d4040
2 parents 55b6369 + a3dfb9f
commit 24d4040
Show file tree

Hide file tree

Showing 5 changed files with 22 additions and 22 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,3 +1,11 @@
+0.3
+---
+* Fixes:
+    * Fix `SwaggerMonoid Text` instance;
+    * Wrap `Bool` in `Maybe` everywhere;
+    * These changes make all `Data.Swagger` `Monoid` instances obey monoid laws
+      (previously right identity law was broken by some instances).
+
 0.2
 ---
 * Add `Data.Swagger.Lens`

diff --git a/src/Data/Swagger/Internal.hs b/src/Data/Swagger/Internal.hs
@@ -242,7 +242,7 @@ data SwaggerOperation = SwaggerOperation
     -- | Declares this operation to be deprecated.
     -- Usage of the declared operation should be refrained.
     -- Default value is @False@.
-  , _swaggerOperationDeprecated :: Bool
+  , _swaggerOperationDeprecated :: Maybe Bool
 
     -- | A declaration of which security schemes are applied for this operation.
     -- The list of values describes alternative security schemes that can be used
@@ -270,7 +270,7 @@ data SwaggerParameter = SwaggerParameter
     -- | Determines whether this parameter is mandatory.
     -- If the parameter is in "path", this property is required and its value MUST be true.
     -- Otherwise, the property MAY be included and its default value is @False@.
-  , _swaggerParameterRequired :: Bool
+  , _swaggerParameterRequired :: Maybe Bool
 
     -- | Parameter schema.
   , _swaggerParameterSchema :: SwaggerParameterSchema
@@ -300,7 +300,7 @@ data SwaggerParameterOtherSchema = SwaggerParameterOtherSchema
     -- This is valid only for either @'SwaggerParameterQuery'@ or @'SwaggerParameterFormData'@
     -- and allows you to send a parameter with a name only or an empty value.
     -- Default value is @False@.
-  , _swaggerParameterOtherSchemaAllowEmptyValue :: Bool
+  , _swaggerParameterOtherSchemaAllowEmptyValue :: Maybe Bool
 
     -- | __Required if type is @'SwaggerParamArray'@__.
     -- Describes the type of items in the array.
@@ -451,15 +451,15 @@ data SwaggerXml = SwaggerXml
 
     -- | Declares whether the property definition translates to an attribute instead of an element.
     -- Default value is @False@.
-  , _swaggerXmlAttribute :: Bool
+  , _swaggerXmlAttribute :: Maybe Bool
 
     -- | MAY be used only for an array definition.
     -- Signifies whether the array is wrapped
     -- (for example, @\<books\>\<book/\>\<book/\>\</books\>@)
     -- or unwrapped (@\<book/\>\<book/\>@).
     -- Default value is @False@.
     -- The definition takes effect only when defined alongside type being array (outside the items).
-  , _swaggerXmlWrapped :: Bool
+  , _swaggerXmlWrapped :: Maybe Bool
   } deriving (Eq, Show, Generic)
 
 data SwaggerItems = SwaggerItems
@@ -953,7 +953,6 @@ instance FromJSON SwaggerMimeList where
 
 instance FromJSON SwaggerParameter where
   parseJSON = genericParseJSONWithSub "schema" (jsonPrefix "swaggerParameter")
-    `withDefaults` [ "required" .= False ]
 
 instance FromJSON SwaggerParameterSchema where
   parseJSON json@(Object o) = do
@@ -967,7 +966,6 @@ instance FromJSON SwaggerParameterSchema where
 
 instance FromJSON SwaggerParameterOtherSchema where
   parseJSON = genericParseJSONWithSub "common" (jsonPrefix "swaggerParameterOtherSchema")
-    `withDefaults` [ "allowEmptyValue" .= False ]
 
 instance FromJSON SwaggerSchemaItems where
   parseJSON json@(Object _) = SwaggerSchemaItemsObject <$> parseJSON json
@@ -991,8 +989,7 @@ instance FromJSON SwaggerResponse where
 
 instance FromJSON SwaggerOperation where
   parseJSON = genericParseJSON (jsonPrefix "swaggerOperation")
-    `withDefaults` [ "deprecated" .= False
-                   , "security"   .= ([] :: [SwaggerSecurityRequirement]) ]
+    `withDefaults` [ "security"   .= ([] :: [SwaggerSecurityRequirement]) ]
 
 instance FromJSON SwaggerPathItem where
   parseJSON = genericParseJSON (jsonPrefix "swaggerPathItem")
@@ -1009,5 +1006,4 @@ instance FromJSON a => FromJSON (SwaggerReferenced a) where
 
 instance FromJSON SwaggerXml where
   parseJSON = genericParseJSON (jsonPrefix "swaggerXml")
-    `withDefaults` [ "attribute" .= False, "wrapped" .= False ]
 
diff --git a/src/Data/Swagger/Internal/Utils.hs b/src/Data/Swagger/Internal/Utils.hs
@@ -120,8 +120,3 @@ instance SwaggerMonoid (Maybe a) where
   swaggerMappend x Nothing = x
   swaggerMappend _ y = y
 
--- | __WARNING:__ not a true monoid (`swaggerMempty` breaks right identity law).
-instance SwaggerMonoid Bool where
-  swaggerMempty = False
-  swaggerMappend _ y = y
-
diff --git a/swagger2.cabal b/swagger2.cabal
@@ -1,8 +1,9 @@
 name:                swagger2
-version:             0.2
+version:             0.3
 synopsis:            Swagger 2.0 data model
 description:         Please see README.md
 homepage:            https://github.com/GetShopTV/swagger2
+bug-reports:         https://github.com/GetShopTV/swagger2/issues
 license:             BSD3
 license-file:        LICENSE
 author:              Nickolay Kudasov

diff --git a/test/Data/SwaggerSpec.hs b/test/Data/SwaggerSpec.hs
@@ -165,17 +165,17 @@ operationExample = mempty
       [ SwaggerParameter
           { _swaggerParameterName = "petId"
           , _swaggerParameterDescription = Just "ID of pet that needs to be updated"
-          , _swaggerParameterRequired = True
+          , _swaggerParameterRequired = Just True
           , _swaggerParameterSchema = SwaggerParameterOther (stringSchema SwaggerParameterPath) }
       , SwaggerParameter
           { _swaggerParameterName = "name"
           , _swaggerParameterDescription = Just "Updated name of the pet"
-          , _swaggerParameterRequired = False
+          , _swaggerParameterRequired = Just False
           , _swaggerParameterSchema = SwaggerParameterOther (stringSchema SwaggerParameterFormData) }
       , SwaggerParameter
           { _swaggerParameterName = "status"
           , _swaggerParameterDescription = Just "Updated status of the pet"
-          , _swaggerParameterRequired = False
+          , _swaggerParameterRequired = Just False
           , _swaggerParameterSchema = SwaggerParameterOther (stringSchema SwaggerParameterFormData) }
       ]
 
@@ -415,15 +415,15 @@ parametersDefinitionExample =
   [ ("skipParam", mempty
       { _swaggerParameterName = "skip"
       , _swaggerParameterDescription = Just "number of items to skip"
-      , _swaggerParameterRequired = True
+      , _swaggerParameterRequired = Just True
       , _swaggerParameterSchema = SwaggerParameterOther mempty
           { _swaggerParameterOtherSchemaIn = SwaggerParameterQuery
           , _swaggerParameterOtherSchemaType = SwaggerParamInteger
           , _swaggerParameterOtherSchemaFormat = Just "int32" } })
   , ("limitParam", mempty
       { _swaggerParameterName = "limit"
       , _swaggerParameterDescription = Just "max records to return"
-      , _swaggerParameterRequired = True
+      , _swaggerParameterRequired = Just True
       , _swaggerParameterSchema = SwaggerParameterOther mempty
           { _swaggerParameterOtherSchemaIn = SwaggerParameterQuery
           , _swaggerParameterOtherSchemaType = SwaggerParamInteger
@@ -549,7 +549,7 @@ swaggerExample = mempty
                   , _swaggerOperationProduces = Just (SwaggerMimeList [ "application/json" ])
                   , _swaggerOperationParameters =
                       [ SwaggerInline mempty
-                          { _swaggerParameterRequired = True
+                          { _swaggerParameterRequired = Just True
                           , _swaggerParameterName = "id"
                           , _swaggerParameterDescription = Just "TodoId param"
                           , _swaggerParameterSchema = SwaggerParameterOther mempty