Merge pull request #337 from sajidanower23/sajid/create-milestone

Create milestone

Author: phadej

src/GitHub.hs

@@ -139,11 +139,12 @@ module GitHub (
     --
     -- Missing endpoints:
     --
-    -- * Create a milestone
     -- * Update a milestone
     -- * Delete a milestone
     milestonesR,
     milestoneR,
+    createMilestone,
+    createMilestoneR,
 
     -- * Organizations
     -- | See <https://developer.github.com/v3/orgs/>

src/GitHub/Data/Milestone.hs

@@ -40,3 +40,26 @@ instance FromJSON Milestone where
         <*> o .: "url"
         <*> o .: "created_at"
         <*> o .: "state"
+
+data NewMilestone = NewMilestone
+    { newMilestoneTitle       :: !Text
+    , newMilestoneState       :: !Text
+    , newMilestoneDescription :: !(Maybe Text)
+    , newMilestoneDueOn       :: !(Maybe UTCTime)
+    }
+  deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData NewMilestone where rnf = genericRnf
+instance Binary NewMilestone
+
+
+instance ToJSON NewMilestone where
+    toJSON (NewMilestone title state desc due) = object $ filter notNull
+        [ "title"       .= title
+        , "state"       .= state
+        , "description" .= desc
+        , "due_on"      .= due
+        ]
+      where
+        notNull (_, Null) = False
+        notNull (_, _)    = True

src/GitHub/Endpoints/Issues/Milestones.hs

@@ -11,6 +11,8 @@ module GitHub.Endpoints.Issues.Milestones (
     milestonesR,
     milestone,
     milestoneR,
+    createMilestone,
+    createMilestoneR,
     module GitHub.Data,
     ) where
 
@@ -50,3 +52,13 @@ milestone user repo mid =
 milestoneR :: Name Owner -> Name Repo -> Id Milestone -> Request k Milestone
 milestoneR user repo mid =
     query ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] []
+
+createMilestone :: Auth -> Name Owner -> Name Repo -> NewMilestone -> IO (Either Error Milestone)
+createMilestone auth user repo mst = executeRequest auth $ createMilestoneR user repo mst
+
+-- | Create a milestone.
+-- See <https://developer.github.com/v3/issues/milestones/#create-a-milestone>
+createMilestoneR :: Name Owner -> Name Repo -> NewMilestone -> Request 'RW Milestone
+createMilestoneR user repo =
+    command Post ["repos", toPathPart user, toPathPart repo, "milestones"] . encode
+