{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module GitLab.API.Projects where
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Control.Monad.Trans.Reader
import Data.Aeson
import qualified Data.ByteString.Lazy as BSL
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time.Clock
import GHC.Generics
import Network.HTTP.Conduit
import Network.HTTP.Types.Status
import Network.HTTP.Types.URI
import System.IO
import UnliftIO.Async
import GitLab.API.Commits
import GitLab.API.Issues
import GitLab.API.Pipelines
import GitLab.API.Users
import GitLab.Types
import GitLab.WebRequests.GitLabWebCalls
allProjects :: (MonadIO m) => GitLab m [Project]
allProjects =
gitlab "/projects"
projectForks :: (MonadUnliftIO m, MonadIO m)
=> Text
-> GitLab m [Project]
projectForks projectName = do
let path =
"/projects/" <>
T.decodeUtf8 (urlEncode False (T.encodeUtf8 projectName)) <>
"/forks"
gitlab path
searchProjectId :: (MonadIO m)
=> Int
-> GitLab m (Maybe Project)
searchProjectId projectId = do
let path = T.pack ("/projects/" <> show projectId)
gitlabOne path
projectsWithName :: (MonadUnliftIO m, MonadIO m)
=> Text
-> GitLab m [Project]
projectsWithName projectName =
filter (\project -> projectName == project_path project) <$>
gitlabWithAttrs "/projects" ("&search=" <> projectName)
projectsWithNameAndUser ::
(MonadUnliftIO m, MonadIO m) => Text -> Text -> GitLab m (Maybe Project)
projectsWithNameAndUser username projectName =
gitlabOne
("/projects/" <>
T.decodeUtf8
(urlEncode False (T.encodeUtf8 (username <> "/" <> projectName))))
multipleCommitters :: (MonadUnliftIO m, MonadIO m) => Project -> GitLab m Bool
multipleCommitters project = do
emailAddresses <- commitsEmailAddresses project
return (length (nub emailAddresses) > 1)
commitsEmailAddresses ::
(MonadUnliftIO m, MonadIO m) => Project -> GitLab m [Text]
commitsEmailAddresses = commitsEmailAddresses' . project_id
commitsEmailAddresses' :: (MonadUnliftIO m, MonadIO m) => Int -> GitLab m [Text]
commitsEmailAddresses' projectId = do
(commits :: [Commit]) <- projectCommits' projectId
return (map author_email commits)
userProjects ::
(MonadUnliftIO m, MonadIO m) => Text -> GitLab m (Maybe [Project])
userProjects username = do
userMaybe <- searchUser username
case userMaybe of
Nothing -> return Nothing
Just user -> Just <$> gitlab (path (user_id user))
where
path userId = "/users/" <> T.pack (show userId) <> "/projects"
projectOfIssue :: (MonadIO m) => Issue -> GitLab m Project
projectOfIssue issue =
fromJust <$> searchProjectId (issue_project_id issue)
issuesCreatedByUser :: (MonadUnliftIO m, MonadIO m) => Text -> GitLab m (Maybe (User,[Project]))
issuesCreatedByUser username = do
user <- searchUser username
case user of
Nothing -> return Nothing
Just usr -> do
issues <- userIssues usr
projects <- mapConcurrently projectOfIssue issues
return (Just (usr, projects))
issuesOnForks ::
(MonadUnliftIO m, MonadIO m)
=> Text
-> GitLab m [(Project, [Issue], [User])]
issuesOnForks projectName = do
projects <- projectsWithName projectName
mapM processProject projects
where
processProject proj = do
issues <- projectOpenedIssues proj
let authors = map issue_author issues
return (proj, issues, authors)
projectMemebersCount :: (MonadIO m) => Project -> GitLab m (Text,[(Text,Text)])
projectMemebersCount project = do
friends <- count
return (namespace_name (namespace project), friends)
where
count = do
let addr =
"/projects/" <> T.pack (show (project_id project)) <> "/members/all"
(res :: [Member]) <- gitlab addr
return (map (\x -> (member_username x, member_name x)) res)
projectCISuccess ::
(MonadIO m)
=> Project
-> GitLab m Bool
projectCISuccess project = do
pipes <- pipelines project
case pipes of
[] -> return False
(x:xs) -> return (pipeline_status x == "success")
namespacePathToUserId :: (MonadIO m)
=> Text
-> GitLab m (Maybe Int)
namespacePathToUserId namespacePath = do
user <- searchUser namespacePath
case user of
Nothing -> return Nothing
Just user -> return (Just (user_id user))