Parse state_reason (values: completed, not_planned, reopened)

Added `issueStateReason` to `Issue`.

Author: andreasabel

CHANGELOG.md

@@ -1,3 +1,13 @@
+## Changes for 0.29
+
+_2022-06-24, Andreas Abel, Midsommar edition_
+
+- Add field `issueStateReason` of type `Maybe IssueStateReason` to `Issue`
+ with possible values `completed`, `not_planned` and `reopened`.
+ (PR [...]).
+
+Tested with GHC 7.8 - 9.6.2
+
 ## Changes for 0.28.0.1
 
 _2022-07-23, Andreas Abel_

github.cabal

@@ -1,7 +1,6 @@
 cabal-version: >=1.10
 name: github
-version: 0.28.0.1
-x-revision: 2
+version: 0.29
 synopsis: Access to the GitHub API, v3.
 category: Network
 description:
@@ -72,6 +71,7 @@ library
  DataKinds
  DeriveDataTypeable
  DeriveGeneric
+ LambdaCase
  OverloadedStrings
  ScopedTypeVariables
  TypeOperators

samples/Issues/ShowRepoIssues.hs

@@ -1,17 +1,27 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-import qualified GitHub as Github
-import Data.List (intercalate)
 import Data.Foldable (toList)
+import Data.List (intercalate)
+import Data.Vector (Vector)
+
+import qualified GitHub as Github
 
 main :: IO ()
 main = do
  let filt = Github.stateClosed <> Github.optionsMentioned "mike-burns" <> Github.optionsAssignee "jyurek"
- possibleIssues <- Github.github' $ Github.issuesForRepoR "thoughtbot" "paperclip" filt Github.FetchAll
- case possibleIssues of
- Left err -> putStrLn $ "Error: " ++ show err
- Right issues ->
- putStrLn $ intercalate "\n\n" $ map formatIssue $ toList issues
+ printIssues =<< do
+ Github.github' $ Github.issuesForRepoR "thoughtbot" "paperclip" filt Github.FetchAll
+
+ printIssues =<< do
+ Github.github' $ Github.issuesForRepoR "haskell-github" "playground" Github.stateClosed Github.FetchAll
+
+printIssues :: Either Github.Error (Vector Github.Issue) -> IO ()
+printIssues = \case
+ Left err ->
+ putStrLn $ "Error: " ++ show err
+ Right issues ->
+ putStrLn $ intercalate "\n\n" $ map formatIssue $ toList issues
 
 formatIssue :: Github.Issue -> String
 formatIssue issue = concat
@@ -23,6 +33,7 @@ formatIssue issue = concat
 
  , "It is currently "
  , show $ Github.issueState issue
+ , maybe "" (\ r -> " with reason " ++ show r) $ Github.issueStateReason issue
  , " with "
  , show $ Github.issueComments issue
  , " comments.\n\n"

src/GitHub/Data/Issues.hs

@@ -9,7 +9,7 @@ import GitHub.Data.Definitions
 import GitHub.Data.Id (Id)
 import GitHub.Data.Milestone (Milestone)
 import GitHub.Data.Name (Name)
-import GitHub.Data.Options (IssueState)
+import GitHub.Data.Options (IssueState, IssueStateReason)
 import GitHub.Data.PullRequests
 import GitHub.Data.URL (URL)
 import GitHub.Internal.Prelude
@@ -36,6 +36,7 @@ data Issue = Issue
  , issueId :: !(Id Issue)
  , issueComments :: !Int
  , issueMilestone :: !(Maybe Milestone)
+ , issueStateReason :: !(Maybe IssueStateReason)
  }
  deriving (Show, Data, Typeable, Eq, Ord, Generic)
 
@@ -203,6 +204,7 @@ instance FromJSON Issue where
  <*> o .: "id"
  <*> o .: "comments"
  <*> o .:? "milestone"
+ <*> o .:? "state_reason"
 
 instance ToJSON NewIssue where
  toJSON (NewIssue t b a m ls) = object $ filter notNull

src/GitHub/Data/Options.hs

@@ -50,6 +50,7 @@ module GitHub.Data.Options (
  optionsAssignee,
  -- * Data
  IssueState (..),
+ IssueStateReason (..),
  MergeableState (..),
  -- * Internal
  HasState,
@@ -94,6 +95,30 @@ instance FromJSON IssueState where
 instance NFData IssueState where rnf = genericRnf
 instance Binary IssueState
 
+-- | 'GitHub.Data.Issues.Issue' state reason
+data IssueStateReason
+ = StateReasonCompleted
+ | StateReasonNotPlanned
+ | StateReasonReopened
+ deriving
+ (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data)
+
+instance ToJSON IssueStateReason where
+ toJSON = String . \case
+ StateReasonCompleted -> "completed"
+ StateReasonNotPlanned -> "not_planned"
+ StateReasonReopened -> "reopened"
+
+instance FromJSON IssueStateReason where
+ parseJSON = withText "IssueStateReason" $ \t -> case T.toLower t of
+ "completed" -> pure StateReasonCompleted
+ "not_planned" -> pure StateReasonNotPlanned
+ "reopened" -> pure StateReasonReopened
+ _ -> fail $ "Unknown IssueStateReason: " <> T.unpack t
+
+instance NFData IssueStateReason where rnf = genericRnf
+instance Binary IssueStateReason
+
 -- | 'GitHub.Data.PullRequests.PullRequest' mergeable_state
 data MergeableState
  = StateUnknown