diff --git a/github.cabal b/github.cabal index 348a9345..5c1f2039 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 @@ -149,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/samples/Repos/ListProjects.hs b/samples/Repos/ListProjects.hs new file mode 100644 index 00000000..88b9f0ff --- /dev/null +++ b/samples/Repos/ListProjects.hs @@ -0,0 +1,36 @@ +{-# 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.Id +import GitHub.Data.Request +import Common +import qualified GitHub +import Prelude () + +main = do + auth <- getAuth + 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 + + + possibleColumns <- GitHub.executeRequestMaybe auth $ P.projectColumnsForR (Id 11963370) GitHub.FetchAll + 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/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.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 new file mode 100644 index 00000000..7ddaddbd --- /dev/null +++ b/src/GitHub/Data/Projects.hs @@ -0,0 +1,130 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- + +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +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 Data.Tagged (Tagged (..)) +-- import qualified GitHub.Request as GH + +import qualified Data.Text as T + +data ProjectState = ProjectStateOpen | ProjectStateClosed + 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 ProjectStateOpen + "closed" -> pure ProjectStateClosed + _ -> 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 :: !SimpleUser + , 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" + + +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" + + +data Card = Card + { cardUrl :: !URL, + cardId :: !(Id Column), + cardNote:: !(Maybe T.Text), + cardCreator:: !(SimpleUser), + cardCreatedAt :: !UTCTime, + cardUpdatedAt :: !UTCTime, + archived:: !Bool, + cardColumnUrl:: !URL, + cardContentUrl:: !(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" diff --git a/src/GitHub/Endpoints/Repos/Projects.hs b/src/GitHub/Endpoints/Repos/Projects.hs new file mode 100644 index 00000000..7d65842d --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Projects.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE CPP #-} + +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The repo commits API as described on +-- +module GitHub.Endpoints.Repos.Projects ( + repoProjectsForR + , orgProjectsForR + , projectColumnsForR + , columnCardsForR + ) where + +import GitHub.Data +import GitHub.Data.Request +import GitHub.Request +import GitHub.Data.Projects +import GitHub.Internal.Prelude +import Prelude () + +-- | List projects for a repository +-- See 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"] [] + + +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"] [] 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 -------------------------------------------------------------------------------