Label description (haskell-github#418)

sajidanower23 · phadej · commit 2503b54595ac · 2019-12-20T13:26:03.000+02:00
* Add description field to IssueLabel
* Add types for Update and New label
* Use NewIssueLabel and UpdateIssueLabel for generating requests
diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs
@@ -268,6 +268,7 @@ data IssueLabel = IssueLabel
     { labelColor :: !Text
     , labelUrl   :: !URL
     , labelName  :: !(Name IssueLabel)
+    , labelDesc  :: !(Maybe Text)
     }
   deriving (Show, Data, Typeable, Eq, Ord, Generic)
 
@@ -279,3 +280,57 @@ instance FromJSON IssueLabel where
         <$> o .: "color"
         <*> o .:? "url" .!= URL "" -- in events there aren't URL
         <*> o .: "name"
+        <*> o .:? "description"
+
+
+-------------------------------------------------------------------------------
+-- NewIssueLabel
+-------------------------------------------------------------------------------
+
+data NewIssueLabel = NewIssueLabel
+    { newLabelColor :: !Text
+    , newLabelName  :: !(Name NewIssueLabel)
+    , newLabelDesc  :: !(Maybe Text)
+    }
+  deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData NewIssueLabel where rnf = genericRnf
+instance Binary NewIssueLabel
+
+
+instance ToJSON NewIssueLabel where
+    toJSON (NewIssueLabel color lblName lblDesc) = object $ filter notNull
+        [ "name" .= lblName
+        , "color" .= color
+        , "description" .= lblDesc
+        ]
+        where
+            notNull (_, Null) = False
+            notNull (_, _)    = True
+
+
+
+-------------------------------------------------------------------------------
+-- UpdateIssueLabel
+-------------------------------------------------------------------------------
+
+data UpdateIssueLabel = UpdateIssueLabel
+    { updateLabelColor :: !Text
+    , updateLabelName  :: !(Name UpdateIssueLabel)
+    , updateLabelDesc  :: !(Maybe Text)
+    }
+  deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData UpdateIssueLabel where rnf = genericRnf
+instance Binary UpdateIssueLabel
+
+
+instance ToJSON UpdateIssueLabel where
+    toJSON (UpdateIssueLabel color lblName lblDesc) = object $ filter notNull
+        [ "new_name" .= lblName
+        , "color" .= color
+        , "description" .= lblDesc
+        ]
+        where
+            notNull (_, Null) = False
+            notNull (_, _)    = True
diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs
@@ -38,26 +38,19 @@ labelR user repo lbl =
 
 -- | Create a label.
 -- See <https://developer.github.com/v3/issues/labels/#create-a-label>
-createLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> String -> Request 'RW IssueLabel
-createLabelR user repo lbl color =
-    command Post paths $ encode body
-  where
-    paths = ["repos", toPathPart user, toPathPart repo, "labels"]
-    body = object ["name" .= untagName lbl, "color" .= color]
+createLabelR :: Name Owner -> Name Repo -> NewIssueLabel -> Request 'RW IssueLabel
+createLabelR user repo =
+    command Post ["repos", toPathPart user, toPathPart repo, "labels"] . encode
 
 -- | Update a label.
 -- See <https://developer.github.com/v3/issues/labels/#update-a-label>
 updateLabelR :: Name Owner
              -> Name Repo
              -> Name IssueLabel   -- ^ old label name
-             -> Name IssueLabel   -- ^ new label name
-             -> String            -- ^ new color
+             -> UpdateIssueLabel   -- ^ new label
              -> Request 'RW IssueLabel
-updateLabelR user repo oldLbl newLbl color =
-    command Patch paths (encode body)
-  where
-    paths = ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl]
-    body = object ["name" .= untagName newLbl, "color" .= color]
+updateLabelR user repo oldLbl =
+    command Patch ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl] . encode
 
 -- | Delete a label.
 -- See <https://developer.github.com/v3/issues/labels/#delete-a-label>
