From 445c8de7300b25b51a4c6850e9468dcb6bc7f534 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 23 Jun 2023 14:23:10 +0200 Subject: [PATCH 1/2] Resurrect samples/Issues/ShowRepoIssues This example wasn't ported to the new API. Now it is, with some ugly `show`s still. --- .github/workflows/haskell-ci.yml | 12 +++++----- samples/Issues/ShowRepoIssues.hs | 38 ++++++++++++++++++++------------ samples/github-samples.cabal | 11 +++++---- 3 files changed, 37 insertions(+), 24 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 7a5b1d89..b5d24eb9 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -203,7 +203,7 @@ jobs: run: | touch cabal.project echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project - if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project ; fi cat cabal.project - name: sdist run: | @@ -223,11 +223,11 @@ jobs: touch cabal.project touch cabal.project.local echo "packages: ${PKGDIR_github}" >> cabal.project - if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi - if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi cat >> cabal.project <= 71000)) -ne 0 ] ; then cd ${PKGDIR_github_samples} || false ; fi - if [ $((HCNUMVER >= 71000)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then cd ${PKGDIR_github_samples} || false ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi - name: haddock run: | if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi diff --git a/samples/Issues/ShowRepoIssues.hs b/samples/Issues/ShowRepoIssues.hs index b6f26e68..3bfaa4ba 100644 --- a/samples/Issues/ShowRepoIssues.hs +++ b/samples/Issues/ShowRepoIssues.hs @@ -1,21 +1,31 @@ -module ShowRepoIssue where +{-# LANGUAGE OverloadedStrings #-} -import qualified Github.Issues as Github +import qualified GitHub as Github import Data.List (intercalate) +import Data.Foldable (toList) +main :: IO () main = do - let limitations = [Github.OnlyClosed, Github.Mentions "mike-burns", Github.AssignedTo "jyurek"] - possibleIssues <- Github.issuesForRepo "thoughtbot" "paperclip" limitations + 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 error) -> putStrLn $ "Error: " ++ show error - (Right issues) -> - putStrLn $ intercalate "\n\n" $ map formatIssue issues + Left err -> putStrLn $ "Error: " ++ show err + Right issues -> + putStrLn $ intercalate "\n\n" $ map formatIssue $ toList issues -formatIssue issue = - (Github.githubOwnerLogin $ Github.issueUser issue) ++ - " opened this issue " ++ - (show $ Github.fromDate $ Github.issueCreatedAt issue) ++ "\n" ++ - (Github.issueState issue) ++ " with " ++ - (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ - (Github.issueTitle issue) +formatIssue :: Github.Issue -> String +formatIssue issue = concat + [ show $ Github.simpleUserLogin $ Github.issueUser issue + , " opened this issue " + , show $ Github.issueCreatedAt issue + , ".\n" + + , "It is currently " + , show $ Github.issueState issue + , " with " + , show $ Github.issueComments issue + , " comments.\n\n" + + , show $ Github.issueTitle issue + ] diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index c76d6b14..c3c6813d 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -18,15 +18,13 @@ tested-with: GHC == 8.8.4 GHC == 8.6.5 GHC == 8.4.4 - GHC == 8.2.2 - GHC == 8.0.2 - GHC == 7.10.3 library hs-source-dirs: src ghc-options: -Wall build-depends: - , base >=4.7 && <5 + , base >=4.11 && <5 + -- require base-4.11 because then (<>) is in Prelude , base-compat-batteries , github , text @@ -149,6 +147,11 @@ executable github-list-team-current -- main-is: ShowDeployKey.hs -- hs-source-dirs: Repos/DeployKeys +executable github-show-repo-issues + import: deps + main-is: ShowRepoIssues.hs + hs-source-dirs: Issues + executable github-show-user import: deps main-is: ShowUser.hs From 723884baa49627fe24424c493ba4c6436df53492 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Fri, 23 Jun 2023 14:39:03 +0200 Subject: [PATCH 2/2] Parse `state_reason` (values: completed, not_planned, reopened) Added `issueStateReason` to `Issue`. --- CHANGELOG.md | 10 ++++++++++ github.cabal | 4 ++-- samples/Issues/ShowRepoIssues.hs | 25 ++++++++++++++++++------- src/GitHub/Data/Issues.hs | 4 +++- src/GitHub/Data/Options.hs | 25 +++++++++++++++++++++++++ 5 files changed, 58 insertions(+), 10 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f402d4d1..1fa91d95 100644 --- a/CHANGELOG.md +++ b/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 [#496](https://github.com/haskell-github/github/pull/496)). + +Tested with GHC 7.8 - 9.6.2 + ## Changes for 0.28.0.1 _2022-07-23, Andreas Abel_ diff --git a/github.cabal b/github.cabal index 34389c64..a0669042 100644 --- a/github.cabal +++ b/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 diff --git a/samples/Issues/ShowRepoIssues.hs b/samples/Issues/ShowRepoIssues.hs index 3bfaa4ba..5f54026b 100644 --- a/samples/Issues/ShowRepoIssues.hs +++ b/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" diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs index 6e98da8f..3ec17781 100644 --- a/src/GitHub/Data/Issues.hs +++ b/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 diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs index 24bc4369..5d27e0b1 100644 --- a/src/GitHub/Data/Options.hs +++ b/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