Support projects

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

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

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
+
+

src/GitHub.hs

@@ -413,6 +413,13 @@ module GitHub (
  -- | See <https://developer.github.com/v3/rate_limit/>
  rateLimitR,
 
+ -- ** Projects
+ -- | See <https://docs.github.com/en/rest/reference/projects>
+ 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

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
 

src/GitHub/Data/Projects.hs

@@ -0,0 +1,130 @@
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>
+--
+
+{-# 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"

src/GitHub/Endpoints/Repos/Projects.hs

@@ -0,0 +1,43 @@
+{-# LANGUAGE CPP #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- License : BSD-3-Clause
+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>
+--
+-- The repo commits API as described on
+-- <https://docs.github.com/en/rest/reference/projects>
+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 <https ://docs.github.com/en/rest/reference/projects#list-repository-projects
+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"] []
+
+
+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"] []

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
 -------------------------------------------------------------------------------