From 6144c28f705312aac8cf018ce9e4921e50db24fa Mon Sep 17 00:00:00 2001 From: grdvnl Date: Sat, 13 Mar 2021 19:36:12 -0800 Subject: [PATCH 01/16] Add new Project types --- github.cabal | 1 + src/GitHub/Data/Projects.hs | 77 +++++++++++++++++++++++++++++++++++++ 2 files changed, 78 insertions(+) create mode 100644 src/GitHub/Data/Projects.hs diff --git a/github.cabal b/github.cabal index 348a9345..be2d8d06 100644 --- a/github.cabal +++ b/github.cabal @@ -105,6 +105,7 @@ library GitHub.Data.Options GitHub.Data.PublicSSHKeys GitHub.Data.PullRequests + GitHub.Data.Projects GitHub.Data.RateLimit GitHub.Data.Releases GitHub.Data.Repos diff --git a/src/GitHub/Data/Projects.hs b/src/GitHub/Data/Projects.hs new file mode 100644 index 00000000..41be47ef --- /dev/null +++ b/src/GitHub/Data/Projects.hs @@ -0,0 +1,77 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +module GitHub.Data.Projects where + +import GitHub.Data.Definitions +import GitHub.Data.Name +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +import qualified Data.Text as T + +-- data Project = Project +-- { commentPosition :: !(Maybe Int) +-- , commentLine :: !(Maybe Int) +-- , commentBody :: !Text +-- , commentCommitId :: !(Maybe Text) +-- , commentUpdatedAt :: !UTCTime +-- , commentHtmlUrl :: !(Maybe URL) +-- , commentUrl :: !URL +-- , commentCreatedAt :: !(Maybe UTCTime) +-- , commentPath :: !(Maybe Text) +-- , commentUser :: !SimpleUser +-- , commentId :: !(Id Comment) +-- } +-- deriving (Show, Data, Typeable, Eq, Ord, Generic) + +data ProjectState = StateOpen | StateClosed + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData ProjectState where rnf = genericRnf +instance Binary ProjectState + +instance FromJSON ProjectState where + parseJSON = withText "ProjecState" $ \t -> case T.toLower t of + "open" -> pure StateOpen + "closed" -> pure StateClosed + _ -> fail $ "Unknown ProjectState: " <> T.unpack t + +data Project = Project + { + projectOwnerUrl:: !URL + , projectUrl:: !URL + , projectHtmlUrl:: !URL + , projectColumnsUrl:: !URL + , projectId :: !(Id Project) + , projectName :: !(Name Project) + , projectBody :: !(Maybe Text) + , projectNumber :: !Int + , projectState :: !ProjectState + , projectCreator :: !User + , projectCreatedAt :: !UTCTime + , projectUpdatedAt :: !UTCTime + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Project where rnf = genericRnf +instance Binary Project + +instance FromJSON Project where + parseJSON = withObject "Project" $ \o -> Project + <$> o .: "owner_url" + <*> o .: "url" + <*> o .: "html_url" + <*> o .: "columns_url" + <*> o .: "id" + <*> o .: "name" + <*> o .:? "body" + <*> o .: "number" + <*> o .: "state" + <*> o .: "creator" + <*> o .: "created_at" + <*> o .: "updated_at" From fe56bddfb334923370ccb0c795bd3a3414330780 Mon Sep 17 00:00:00 2001 From: grdvnl Date: Sat, 13 Mar 2021 19:44:19 -0800 Subject: [PATCH 02/16] Add endpoint module fro Projects --- github.cabal | 1 + src/GitHub/Data/Projects.hs | 15 --------------- 2 files changed, 1 insertion(+), 15 deletions(-) diff --git a/github.cabal b/github.cabal index be2d8d06..5c1f2039 100644 --- a/github.cabal +++ b/github.cabal @@ -150,6 +150,7 @@ library GitHub.Endpoints.Repos.Deployments GitHub.Endpoints.Repos.Forks GitHub.Endpoints.Repos.Invitations + GitHub.Endpoints.Repos.Projects GitHub.Endpoints.Repos.Releases GitHub.Endpoints.Repos.Statuses GitHub.Endpoints.Repos.Webhooks diff --git a/src/GitHub/Data/Projects.hs b/src/GitHub/Data/Projects.hs index 41be47ef..7687e34e 100644 --- a/src/GitHub/Data/Projects.hs +++ b/src/GitHub/Data/Projects.hs @@ -14,21 +14,6 @@ import Prelude () import qualified Data.Text as T --- data Project = Project --- { commentPosition :: !(Maybe Int) --- , commentLine :: !(Maybe Int) --- , commentBody :: !Text --- , commentCommitId :: !(Maybe Text) --- , commentUpdatedAt :: !UTCTime --- , commentHtmlUrl :: !(Maybe URL) --- , commentUrl :: !URL --- , commentCreatedAt :: !(Maybe UTCTime) --- , commentPath :: !(Maybe Text) --- , commentUser :: !SimpleUser --- , commentId :: !(Id Comment) --- } --- deriving (Show, Data, Typeable, Eq, Ord, Generic) - data ProjectState = StateOpen | StateClosed deriving (Show, Data, Typeable, Eq, Ord, Generic) From b429a92cf7e2e8a97784760a9c2217071adf1c57 Mon Sep 17 00:00:00 2001 From: grdvnl Date: Sat, 13 Mar 2021 19:44:35 -0800 Subject: [PATCH 03/16] Add endpoint module fro Projects --- src/GitHub/Endpoints/Repos/Projects.hs | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) create mode 100644 src/GitHub/Endpoints/Repos/Projects.hs diff --git a/src/GitHub/Endpoints/Repos/Projects.hs b/src/GitHub/Endpoints/Repos/Projects.hs new file mode 100644 index 00000000..9c0a29ac --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Projects.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE CPP #-} +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The repo commits API as described on +-- . +module GitHub.Endpoints.Repos.Projects ( + projectsForR + ) where + +import GitHub.Data +import GitHub.Data.Projects +import GitHub.Internal.Prelude +import Prelude () + +-- | List projects for a repository +-- See Name Repo -> FetchCount -> Request k (Vector Project) +projectsForR user repo = + pagedQuery ["repos", toPathPart user, toPathPart repo, "projects"] [] From c3643a7b395de9146d169bde4bab494356126775 Mon Sep 17 00:00:00 2001 From: grdvnl Date: Sat, 13 Mar 2021 19:45:31 -0800 Subject: [PATCH 04/16] Update comment --- src/GitHub/Endpoints/Repos/Projects.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Endpoints/Repos/Projects.hs b/src/GitHub/Endpoints/Repos/Projects.hs index 9c0a29ac..7b34eed3 100644 --- a/src/GitHub/Endpoints/Repos/Projects.hs +++ b/src/GitHub/Endpoints/Repos/Projects.hs @@ -5,7 +5,7 @@ -- Maintainer : Oleg Grenrus -- -- The repo commits API as described on --- . +-- module GitHub.Endpoints.Repos.Projects ( projectsForR ) where From bf8f939a25c576323cf0c2dff8cad727387e8dcf Mon Sep 17 00:00:00 2001 From: grdvnl Date: Sat, 13 Mar 2021 21:48:07 -0800 Subject: [PATCH 05/16] Initial version of samples --- samples/github-samples.cabal | 7 +++++++ src/GitHub/Endpoints/Repos/Projects.hs | 1 + 2 files changed, 8 insertions(+) diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index 270609d7..e77e7f93 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -183,3 +183,10 @@ executable github-teaminfo-for -- import: deps -- main-is: GitDiff.hs -- hs-source-dirs: Repos/Commits + +executable github-list-projects + import: deps + main-is: ListProjects.hs + hs-source-dirs: Repos + + diff --git a/src/GitHub/Endpoints/Repos/Projects.hs b/src/GitHub/Endpoints/Repos/Projects.hs index 7b34eed3..a4f29da5 100644 --- a/src/GitHub/Endpoints/Repos/Projects.hs +++ b/src/GitHub/Endpoints/Repos/Projects.hs @@ -11,6 +11,7 @@ module GitHub.Endpoints.Repos.Projects ( ) where import GitHub.Data +import GitHub.Data.Request import GitHub.Data.Projects import GitHub.Internal.Prelude import Prelude () From 4e954e84e2a0c89bf223cab2727b7a2dee29105a Mon Sep 17 00:00:00 2001 From: grdvnl Date: Sat, 13 Mar 2021 23:15:56 -0800 Subject: [PATCH 06/16] Switch to simple user --- src/GitHub/Data/Projects.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GitHub/Data/Projects.hs b/src/GitHub/Data/Projects.hs index 7687e34e..3b78b4ec 100644 --- a/src/GitHub/Data/Projects.hs +++ b/src/GitHub/Data/Projects.hs @@ -37,7 +37,7 @@ data Project = Project , projectBody :: !(Maybe Text) , projectNumber :: !Int , projectState :: !ProjectState - , projectCreator :: !User + , projectCreator :: !SimpleUser , projectCreatedAt :: !UTCTime , projectUpdatedAt :: !UTCTime } From e4c2e7af498671d299656deb655a21cbe9cebf0f Mon Sep 17 00:00:00 2001 From: grdvnl Date: Sat, 13 Mar 2021 23:16:17 -0800 Subject: [PATCH 07/16] Add preview instance for Inertia --- src/GitHub/Endpoints/Repos/Projects.hs | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/src/GitHub/Endpoints/Repos/Projects.hs b/src/GitHub/Endpoints/Repos/Projects.hs index a4f29da5..cc107e7a 100644 --- a/src/GitHub/Endpoints/Repos/Projects.hs +++ b/src/GitHub/Endpoints/Repos/Projects.hs @@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -15,9 +17,20 @@ import GitHub.Data.Request import GitHub.Data.Projects import GitHub.Internal.Prelude import Prelude () +import qualified GitHub as GH +import Data.Tagged (Tagged (..)) + +data Inertia + +instance GH.PreviewAccept Inertia where + previewContentType = Tagged "application/vnd.github.inertia-preview+json" + +instance FromJSON a => GH.PreviewParseResponse Inertia a where + previewParseResponse _ res = Tagged (GH.parseResponseJSON res) + -- | List projects for a repository -- See Name Repo -> FetchCount -> Request k (Vector Project) +projectsForR :: Name Owner -> Name Repo -> FetchCount -> GenRequest ('MtPreview Inertia) k (Vector Project) projectsForR user repo = - pagedQuery ["repos", toPathPart user, toPathPart repo, "projects"] [] + PagedQuery ["repos", toPathPart user, toPathPart repo, "projects"] [] From d411599be0374cfa57c925df8a9fe2ad53cd9bc1 Mon Sep 17 00:00:00 2001 From: grdvnl Date: Sat, 13 Mar 2021 23:16:38 -0800 Subject: [PATCH 08/16] Add sample module for projects --- samples/Repos/ListProjects.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) create mode 100644 samples/Repos/ListProjects.hs diff --git a/samples/Repos/ListProjects.hs b/samples/Repos/ListProjects.hs new file mode 100644 index 00000000..e02d4e73 --- /dev/null +++ b/samples/Repos/ListProjects.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE OverloadedStrings#-} +module Main(main) where + +import qualified GitHub.Endpoints.Repos.Projects as P +import Data.List +import GitHub.Data +import GitHub.Data.Name +import GitHub.Data.Request +import Common +import qualified GitHub +import Prelude () + +main = do + auth <- getAuth + possibleProjects <- GitHub.executeRequestMaybe auth $ P.projectsForR "ResearchAffiliates" "invsys" GitHub.FetchAll + putStrLn $ either (("Error: " <>) . tshow) + (foldMap ((<> "\n") . tshow)) + possibleProjects From 0dd45c974609b86aba8a5d91079c61675b0875be Mon Sep 17 00:00:00 2001 From: grdvnl Date: Sat, 13 Mar 2021 23:48:58 -0800 Subject: [PATCH 09/16] Add org project listing --- src/GitHub/Endpoints/Repos/Projects.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/src/GitHub/Endpoints/Repos/Projects.hs b/src/GitHub/Endpoints/Repos/Projects.hs index cc107e7a..99551455 100644 --- a/src/GitHub/Endpoints/Repos/Projects.hs +++ b/src/GitHub/Endpoints/Repos/Projects.hs @@ -9,8 +9,9 @@ -- The repo commits API as described on -- module GitHub.Endpoints.Repos.Projects ( - projectsForR - ) where + repoProjectsForR + , orgProjectsForR + ) where import GitHub.Data import GitHub.Data.Request @@ -31,6 +32,11 @@ instance FromJSON a => GH.PreviewParseResponse Inertia a where -- | List projects for a repository -- See Name Repo -> FetchCount -> GenRequest ('MtPreview Inertia) k (Vector Project) -projectsForR user repo = +repoProjectsForR :: Name Owner -> Name Repo -> FetchCount -> GenRequest ('MtPreview Inertia) k (Vector Project) +repoProjectsForR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "projects"] [] + + +orgProjectsForR :: Name Owner -> FetchCount -> GenRequest ( 'MtPreview Inertia) k (Vector Project) +orgProjectsForR user = + PagedQuery ["orgs", toPathPart user, "projects"] [] From cab9c4e69b713696de95f06af3794dd145cea1e1 Mon Sep 17 00:00:00 2001 From: grdvnl Date: Sat, 13 Mar 2021 23:49:10 -0800 Subject: [PATCH 10/16] Update sample to point to a toy repo --- samples/Repos/ListProjects.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/samples/Repos/ListProjects.hs b/samples/Repos/ListProjects.hs index e02d4e73..6ed2d6a8 100644 --- a/samples/Repos/ListProjects.hs +++ b/samples/Repos/ListProjects.hs @@ -12,7 +12,13 @@ import Prelude () main = do auth <- getAuth - possibleProjects <- GitHub.executeRequestMaybe auth $ P.projectsForR "ResearchAffiliates" "invsys" GitHub.FetchAll + possibleProjects <- GitHub.executeRequestMaybe auth $ P.repoProjectsForR "lambda-coast" "infinite-turtles" GitHub.FetchAll + putStrLn $ either (("Error: " <>) . tshow) + (foldMap ((<> "\n") . tshow)) + possibleProjects + + + possibleProjects <- GitHub.executeRequestMaybe auth $ P.orgProjectsForR "lambda-coast" GitHub.FetchAll putStrLn $ either (("Error: " <>) . tshow) (foldMap ((<> "\n") . tshow)) possibleProjects From 3ddfb4fe858c3c5888306eb53cceccb4c595fb76 Mon Sep 17 00:00:00 2001 From: grdvnl Date: Sun, 14 Mar 2021 00:10:08 -0800 Subject: [PATCH 11/16] Support column list --- src/GitHub/Endpoints/Repos/Projects.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/GitHub/Endpoints/Repos/Projects.hs b/src/GitHub/Endpoints/Repos/Projects.hs index 99551455..f2750c00 100644 --- a/src/GitHub/Endpoints/Repos/Projects.hs +++ b/src/GitHub/Endpoints/Repos/Projects.hs @@ -40,3 +40,8 @@ repoProjectsForR user repo = orgProjectsForR :: Name Owner -> FetchCount -> GenRequest ( 'MtPreview Inertia) k (Vector Project) orgProjectsForR user = PagedQuery ["orgs", toPathPart user, "projects"] [] + + +projectColumnsForR :: (Id Project) -> FetchCount -> GenRequest ( 'MtPreview Inertia) k (Vector Column) +projectColumnsForR project_id = + PagedQuery ["projects", toPathPart project_id, "columns"] [] From 897a171954b17c81ec4a8a3377409bb392e8c280 Mon Sep 17 00:00:00 2001 From: grdvnl Date: Sun, 14 Mar 2021 00:10:32 -0800 Subject: [PATCH 12/16] Support column list --- src/GitHub/Data/Projects.hs | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/src/GitHub/Data/Projects.hs b/src/GitHub/Data/Projects.hs index 3b78b4ec..cd76e985 100644 --- a/src/GitHub/Data/Projects.hs +++ b/src/GitHub/Data/Projects.hs @@ -60,3 +60,32 @@ instance FromJSON Project where <*> o .: "creator" <*> o .: "created_at" <*> o .: "updated_at" + + +data Column = Column + { + columnUrl :: !URL, + columnProjectUrl :: !URL, + columnCardsUrl :: !URL, + columnId :: !(Id Column), + columnName :: !(Name Column), + columnCreatedAt :: !UTCTime, + columntUpdatedAt :: !UTCTime + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Column where rnf = genericRnf + +instance Binary Column + +instance FromJSON Column where + parseJSON = withObject "Column" $ \o -> + Column + <$> o .: "url" + <*> o .: "project_url" + <*> o .: "cards_url" + <*> o .: "id" + <*> o .: "name" + <*> o .: "created_at" + <*> o .: "updated_at" + From f4620142e793293d963dc9a886057a0cf0a9140c Mon Sep 17 00:00:00 2001 From: grdvnl Date: Sun, 14 Mar 2021 00:10:58 -0800 Subject: [PATCH 13/16] Move type defintions --- src/GitHub/Data/Projects.hs | 14 ++++++++++++++ src/GitHub/Endpoints/Repos/Projects.hs | 19 ++++--------------- 2 files changed, 18 insertions(+), 15 deletions(-) diff --git a/src/GitHub/Data/Projects.hs b/src/GitHub/Data/Projects.hs index cd76e985..352d2a00 100644 --- a/src/GitHub/Data/Projects.hs +++ b/src/GitHub/Data/Projects.hs @@ -3,6 +3,10 @@ -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- + +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} + module GitHub.Data.Projects where import GitHub.Data.Definitions @@ -12,6 +16,9 @@ import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () +import Data.Tagged (Tagged (..)) +import qualified GitHub as GH + import qualified Data.Text as T data ProjectState = StateOpen | StateClosed @@ -89,3 +96,10 @@ instance FromJSON Column where <*> o .: "created_at" <*> o .: "updated_at" +data Inertia + +instance GH.PreviewAccept Inertia where + previewContentType = Tagged "application/vnd.github.inertia-preview+json" + +instance FromJSON a => GH.PreviewParseResponse Inertia a where + previewParseResponse _ res = Tagged (GH.parseResponseJSON res) diff --git a/src/GitHub/Endpoints/Repos/Projects.hs b/src/GitHub/Endpoints/Repos/Projects.hs index f2750c00..1961d20d 100644 --- a/src/GitHub/Endpoints/Repos/Projects.hs +++ b/src/GitHub/Endpoints/Repos/Projects.hs @@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} + ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause @@ -9,8 +8,9 @@ -- The repo commits API as described on -- module GitHub.Endpoints.Repos.Projects ( - repoProjectsForR - , orgProjectsForR + repoProjectsForR + , orgProjectsForR + , projectColumnsForR ) where import GitHub.Data @@ -18,17 +18,6 @@ import GitHub.Data.Request import GitHub.Data.Projects import GitHub.Internal.Prelude import Prelude () -import qualified GitHub as GH -import Data.Tagged (Tagged (..)) - -data Inertia - -instance GH.PreviewAccept Inertia where - previewContentType = Tagged "application/vnd.github.inertia-preview+json" - -instance FromJSON a => GH.PreviewParseResponse Inertia a where - previewParseResponse _ res = Tagged (GH.parseResponseJSON res) - -- | List projects for a repository -- See Date: Sun, 14 Mar 2021 00:11:08 -0800 Subject: [PATCH 14/16] Update sample --- samples/Repos/ListProjects.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/samples/Repos/ListProjects.hs b/samples/Repos/ListProjects.hs index 6ed2d6a8..c4493ff6 100644 --- a/samples/Repos/ListProjects.hs +++ b/samples/Repos/ListProjects.hs @@ -5,6 +5,7 @@ import qualified GitHub.Endpoints.Repos.Projects as P import Data.List import GitHub.Data import GitHub.Data.Name +import GitHub.Data.Id import GitHub.Data.Request import Common import qualified GitHub @@ -22,3 +23,9 @@ main = do putStrLn $ either (("Error: " <>) . tshow) (foldMap ((<> "\n") . tshow)) possibleProjects + + + possibleColumns <- GitHub.executeRequestMaybe auth $ P.projectColumnsForR (Id 11963370) GitHub.FetchAll + putStrLn $ either (("Error: " <>) . tshow) + (foldMap ((<> "\n") . tshow)) + possibleColumns From e3089a19c6751a6d63fb99e812b73120df8e46d1 Mon Sep 17 00:00:00 2001 From: grdvnl Date: Sun, 14 Mar 2021 13:37:29 -0700 Subject: [PATCH 15/16] Add functionality to list cards --- samples/Repos/ListProjects.hs | 7 +++++- src/GitHub/Data/Projects.hs | 33 ++++++++++++++++++++++++++ src/GitHub/Endpoints/Repos/Projects.hs | 6 +++++ 3 files changed, 45 insertions(+), 1 deletion(-) diff --git a/samples/Repos/ListProjects.hs b/samples/Repos/ListProjects.hs index c4493ff6..79728810 100644 --- a/samples/Repos/ListProjects.hs +++ b/samples/Repos/ListProjects.hs @@ -14,7 +14,7 @@ import Prelude () main = do auth <- getAuth possibleProjects <- GitHub.executeRequestMaybe auth $ P.repoProjectsForR "lambda-coast" "infinite-turtles" GitHub.FetchAll - putStrLn $ either (("Error: " <>) . tshow) + putStrLn $ either n(("Error: " <>) . tshow) (foldMap ((<> "\n") . tshow)) possibleProjects @@ -29,3 +29,8 @@ main = do putStrLn $ either (("Error: " <>) . tshow) (foldMap ((<> "\n") . tshow)) possibleColumns + + possibleCards <- GitHub.executeRequestMaybe auth $ P.columnCardsForR (Id 13371133) GitHub.FetchAll + putStrLn $ either (("Error: " <>) . tshow) + (foldMap ((<> "\n") . tshow)) + possibleCards diff --git a/src/GitHub/Data/Projects.hs b/src/GitHub/Data/Projects.hs index 352d2a00..df7b5871 100644 --- a/src/GitHub/Data/Projects.hs +++ b/src/GitHub/Data/Projects.hs @@ -96,6 +96,39 @@ instance FromJSON Column where <*> o .: "created_at" <*> o .: "updated_at" + +data Card = Card + { cardUrl :: !URL, + cardId :: !(Id Column), + cardNote:: !(Maybe T.Text), + cardCreator:: !(SimpleUser), + cardCreatedAt :: !UTCTime, + cardUpdatedAt :: !UTCTime, + archived:: !Bool, + cardColumnUrl:: !URL, + cardContenttUrl:: !(Maybe URL), + cardProjectUrl:: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData Card where rnf = genericRnf + +instance Binary Card + +instance FromJSON Card where + parseJSON = withObject "Card" $ \o -> + Card + <$> o .: "url" + <*> o .: "id" + <*> o .:? "note" + <*> o .: "creator" + <*> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "archived" + <*> o .: "column_url" + <*> o .:? "content_url" + <*> o .: "project_url" + data Inertia instance GH.PreviewAccept Inertia where diff --git a/src/GitHub/Endpoints/Repos/Projects.hs b/src/GitHub/Endpoints/Repos/Projects.hs index 1961d20d..35c29e61 100644 --- a/src/GitHub/Endpoints/Repos/Projects.hs +++ b/src/GitHub/Endpoints/Repos/Projects.hs @@ -11,6 +11,7 @@ module GitHub.Endpoints.Repos.Projects ( repoProjectsForR , orgProjectsForR , projectColumnsForR + , columnCardsForR ) where import GitHub.Data @@ -34,3 +35,8 @@ orgProjectsForR user = projectColumnsForR :: (Id Project) -> FetchCount -> GenRequest ( 'MtPreview Inertia) k (Vector Column) projectColumnsForR project_id = PagedQuery ["projects", toPathPart project_id, "columns"] [] + + +columnCardsForR :: (Id Column) -> FetchCount -> GenRequest ( 'MtPreview Inertia) k (Vector Card) +columnCardsForR column_id = + PagedQuery ["projects", "columns", toPathPart column_id, "cards"] [] From dd8d9817329eaf2acba3a167feb4dc3d4e53525a Mon Sep 17 00:00:00 2001 From: grdvnl Date: Mon, 15 Mar 2021 23:41:25 -0700 Subject: [PATCH 16/16] Streamline imports --- samples/Repos/ListProjects.hs | 2 +- src/GitHub.hs | 8 ++++++++ src/GitHub/Data.hs | 22 ++++++++++++++++++++++ src/GitHub/Data/Projects.hs | 18 +++++------------- src/GitHub/Endpoints/Repos/Projects.hs | 1 + src/GitHub/Request.hs | 14 ++++++++++++++ 6 files changed, 51 insertions(+), 14 deletions(-) diff --git a/samples/Repos/ListProjects.hs b/samples/Repos/ListProjects.hs index 79728810..88b9f0ff 100644 --- a/samples/Repos/ListProjects.hs +++ b/samples/Repos/ListProjects.hs @@ -14,7 +14,7 @@ import Prelude () main = do auth <- getAuth possibleProjects <- GitHub.executeRequestMaybe auth $ P.repoProjectsForR "lambda-coast" "infinite-turtles" GitHub.FetchAll - putStrLn $ either n(("Error: " <>) . tshow) + putStrLn $ either (("Error: " <>) . tshow) (foldMap ((<> "\n") . tshow)) possibleProjects diff --git a/src/GitHub.hs b/src/GitHub.hs index 6b5f8d36..dbc3a27b 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -413,6 +413,13 @@ module GitHub ( -- | See rateLimitR, + -- ** Projects + -- | See + repoProjectsForR, + orgProjectsForR, + projectColumnsForR, + columnCardsForR, + -- * Data definitions module GitHub.Data, -- * Request handling @@ -452,6 +459,7 @@ import GitHub.Endpoints.Repos.DeployKeys import GitHub.Endpoints.Repos.Deployments import GitHub.Endpoints.Repos.Forks import GitHub.Endpoints.Repos.Invitations +import GitHub.Endpoints.Repos.Projects import GitHub.Endpoints.Repos.Releases import GitHub.Endpoints.Repos.Statuses import GitHub.Endpoints.Repos.Webhooks diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 6b475d40..5d1d6037 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -16,6 +16,8 @@ module GitHub.Data ( mkTeamName, mkOrganizationName, mkRepoName, + mkProjectName, + mkColumnName, mkCommitName, fromUserName, fromOrganizationName, @@ -30,6 +32,9 @@ module GitHub.Data ( mkRepoId, fromUserId, fromOrganizationId, + mkProjectId, + mkColumnId, + mkCardId, -- * IssueNumber IssueNumber (..), -- * Module re-exports @@ -53,6 +58,7 @@ module GitHub.Data ( module GitHub.Data.RateLimit, module GitHub.Data.Releases, module GitHub.Data.Repos, + module GitHub.Data.Projects, module GitHub.Data.Request, module GitHub.Data.Reviews, module GitHub.Data.Search, @@ -88,6 +94,7 @@ import GitHub.Data.PullRequests import GitHub.Data.RateLimit import GitHub.Data.Releases import GitHub.Data.Repos +import GitHub.Data.Projects import GitHub.Data.Request import GitHub.Data.Reviews import GitHub.Data.Search @@ -127,6 +134,21 @@ mkRepoId = Id mkRepoName :: Text -> Name Repo mkRepoName = N +mkProjectId :: Int -> Id Project +mkProjectId = Id + +mkProjectName :: Text -> Name Project +mkProjectName = N + +mkColumnId :: Int -> Id Column +mkColumnId = Id + +mkColumnName :: Text -> Name Column +mkColumnName = N + +mkCardId :: Int -> Id Card +mkCardId = Id + mkCommitName :: Text -> Name Commit mkCommitName = N diff --git a/src/GitHub/Data/Projects.hs b/src/GitHub/Data/Projects.hs index df7b5871..7ddaddbd 100644 --- a/src/GitHub/Data/Projects.hs +++ b/src/GitHub/Data/Projects.hs @@ -17,11 +17,11 @@ import GitHub.Internal.Prelude import Prelude () import Data.Tagged (Tagged (..)) -import qualified GitHub as GH +-- import qualified GitHub.Request as GH import qualified Data.Text as T -data ProjectState = StateOpen | StateClosed +data ProjectState = ProjectStateOpen | ProjectStateClosed deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ProjectState where rnf = genericRnf @@ -29,8 +29,8 @@ instance Binary ProjectState instance FromJSON ProjectState where parseJSON = withText "ProjecState" $ \t -> case T.toLower t of - "open" -> pure StateOpen - "closed" -> pure StateClosed + "open" -> pure ProjectStateOpen + "closed" -> pure ProjectStateClosed _ -> fail $ "Unknown ProjectState: " <> T.unpack t data Project = Project @@ -106,7 +106,7 @@ data Card = Card cardUpdatedAt :: !UTCTime, archived:: !Bool, cardColumnUrl:: !URL, - cardContenttUrl:: !(Maybe URL), + cardContentUrl:: !(Maybe URL), cardProjectUrl:: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) @@ -128,11 +128,3 @@ instance FromJSON Card where <*> o .: "column_url" <*> o .:? "content_url" <*> o .: "project_url" - -data Inertia - -instance GH.PreviewAccept Inertia where - previewContentType = Tagged "application/vnd.github.inertia-preview+json" - -instance FromJSON a => GH.PreviewParseResponse Inertia a where - previewParseResponse _ res = Tagged (GH.parseResponseJSON res) diff --git a/src/GitHub/Endpoints/Repos/Projects.hs b/src/GitHub/Endpoints/Repos/Projects.hs index 35c29e61..7d65842d 100644 --- a/src/GitHub/Endpoints/Repos/Projects.hs +++ b/src/GitHub/Endpoints/Repos/Projects.hs @@ -16,6 +16,7 @@ module GitHub.Endpoints.Repos.Projects ( import GitHub.Data import GitHub.Data.Request +import GitHub.Request import GitHub.Data.Projects import GitHub.Internal.Prelude import Prelude () diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs index 808f33a7..886645cf 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -68,6 +68,10 @@ module GitHub.Request ( -- They change accordingly, to make use of the library simpler. withOpenSSL, tlsManagerSettings, + + + -- preview types + Inertia ) where import GitHub.Internal.Prelude @@ -386,6 +390,16 @@ instance PreviewAccept p => Accept ('MtPreview p) where instance PreviewParseResponse p a => ParseResponse ('MtPreview p) a where parseResponse = previewParseResponse + +data Inertia + +instance PreviewAccept Inertia where + previewContentType = Tagged "application/vnd.github.inertia-preview+json" + +instance FromJSON a => PreviewParseResponse Inertia a where + previewParseResponse _ res = Tagged (parseResponseJSON res) + + ------------------------------------------------------------------------------- -- Status -------------------------------------------------------------------------------