{-# LANGUAGE TypeFamilies #-}

module Hercules.CLI.Project where

import qualified Data.Attoparsec.Text as A
import Data.Has (Has)
import qualified Data.UUID
import Hercules.API (ClientAuth, Id, enterApiE)
import Hercules.API.Id (Id (Id))
import Hercules.API.Name (Name (Name))
import Hercules.API.Projects (ProjectResourceGroup, ProjectsAPI (byProjectName), findProjects)
import qualified Hercules.API.Projects as Projects
import Hercules.API.Projects.Project (Project)
import qualified Hercules.API.Projects.Project as Project
import qualified Hercules.API.Repos as Repos
import qualified Hercules.API.Repos.RepoKey as RepoKey
import Hercules.CLI.Client (HerculesClientEnv, HerculesClientToken, projectsClient, reposClient, runHerculesClient, runHerculesClientEither)
import Hercules.CLI.Common (exitMsg)
import qualified Hercules.CLI.Git as Git
import Hercules.CLI.Options (attoparsecReader, packSome)
import Hercules.Error (escalate, escalateAs)
import Network.HTTP.Types (Status (Status, statusCode))
import Options.Applicative (bashCompleter, completer, help, long, metavar, option, strOption)
import qualified Options.Applicative as Optparse
import Protolude hiding (option)
import RIO (RIO)
import Servant.Client.Core (ClientError (FailureResponse), ResponseF (responseStatusCode))
import Servant.Client.Core.Response (ResponseF (Response))
import Servant.Client.Generic (AsClientT)
import Servant.Client.Streaming (ClientM)
import UnliftIO.Environment (lookupEnv)
import qualified Prelude

data ProjectPath = ProjectPath
  { ProjectPath -> Text
projectPathSite :: Text,
    ProjectPath -> Text
projectPathOwner :: Text,
    ProjectPath -> Text
projectPathProject :: Text
  }

instance Prelude.Show ProjectPath where
  show :: ProjectPath -> FilePath
show = Text -> FilePath
forall a b. ConvertText a b => a -> b
toS (Text -> FilePath)
-> (ProjectPath -> Text) -> ProjectPath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectPath -> Text
projectPathText

projectPathText :: ProjectPath -> Text
projectPathText :: ProjectPath -> Text
projectPathText = ProjectPath -> Text
projectPathSite (ProjectPath -> Text)
-> (ProjectPath -> Text) -> ProjectPath -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> ProjectPath -> Text
forall a b. a -> b -> a
const Text
"/" (ProjectPath -> Text)
-> (ProjectPath -> Text) -> ProjectPath -> Text
forall a. Semigroup a => a -> a -> a
<> ProjectPath -> Text
projectPathOwner (ProjectPath -> Text)
-> (ProjectPath -> Text) -> ProjectPath -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> ProjectPath -> Text
forall a b. a -> b -> a
const Text
"/" (ProjectPath -> Text)
-> (ProjectPath -> Text) -> ProjectPath -> Text
forall a. Semigroup a => a -> a -> a
<> ProjectPath -> Text
projectPathProject

projectOption :: Optparse.Parser ProjectPath
projectOption :: Parser ProjectPath
projectOption =
  ReadM ProjectPath
-> Mod OptionFields ProjectPath -> Parser ProjectPath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM ProjectPath
projectPathReadM (Mod OptionFields ProjectPath -> Parser ProjectPath)
-> Mod OptionFields ProjectPath -> Parser ProjectPath
forall a b. (a -> b) -> a -> b
$
    FilePath -> Mod OptionFields ProjectPath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"project" Mod OptionFields ProjectPath
-> Mod OptionFields ProjectPath -> Mod OptionFields ProjectPath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields ProjectPath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PROJECT" Mod OptionFields ProjectPath
-> Mod OptionFields ProjectPath -> Mod OptionFields ProjectPath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields ProjectPath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Project path, e.g. github/my-org/my-project"

nameOption :: Optparse.Parser Text
nameOption :: Parser Text
nameOption = Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields Text -> Parser Text)
-> Mod OptionFields Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"name" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Name of the state file"

fileOption :: Optparse.Parser FilePath
fileOption :: Parser FilePath
fileOption = Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"file" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILE" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Local path of the state file or - for stdio" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (FilePath -> Completer
bashCompleter FilePath
"file")

projectPathReadM :: Optparse.ReadM ProjectPath
projectPathReadM :: ReadM ProjectPath
projectPathReadM = Parser ProjectPath -> ReadM ProjectPath
forall a. Parser a -> ReadM a
attoparsecReader Parser ProjectPath
parseProjectPath

parseProjectPath :: A.Parser ProjectPath
parseProjectPath :: Parser ProjectPath
parseProjectPath =
  (Text -> Text -> Text -> ProjectPath)
-> Parser Text (Text -> Text -> Text -> ProjectPath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text -> Text -> Text -> ProjectPath
ProjectPath
    Parser Text (Text -> Text -> Text -> ProjectPath)
-> Parser Text Text -> Parser Text (Text -> Text -> ProjectPath)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Char -> Parser Text Text
packSome ((Char -> Bool) -> Parser Char
A.satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/'))
    Parser Text (Text -> Text -> ProjectPath)
-> Parser Char -> Parser Text (Text -> Text -> ProjectPath)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char Char
'/'
    Parser Text (Text -> Text -> ProjectPath)
-> Parser Text Text -> Parser Text (Text -> ProjectPath)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Char -> Parser Text Text
packSome ((Char -> Bool) -> Parser Char
A.satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/'))
    Parser Text (Text -> ProjectPath)
-> Parser Char -> Parser Text (Text -> ProjectPath)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char Char
'/'
    Parser Text (Text -> ProjectPath)
-> Parser Text Text -> Parser ProjectPath
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Char -> Parser Text Text
packSome ((Char -> Bool) -> Parser Char
A.satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/'))

parseProjectPathFromText :: Text -> Either [Char] ProjectPath
parseProjectPathFromText :: Text -> Either FilePath ProjectPath
parseProjectPathFromText = Parser ProjectPath -> Text -> Either FilePath ProjectPath
forall a. Parser a -> Text -> Either FilePath a
A.parseOnly Parser ProjectPath
parseProjectPath

getProjectPath :: (Has HerculesClientToken r, Has HerculesClientEnv r) => Maybe ProjectPath -> RIO r ProjectPath
getProjectPath :: forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
Maybe ProjectPath -> RIO r ProjectPath
getProjectPath Maybe ProjectPath
maybeProjectPathParam =
  case Maybe ProjectPath
maybeProjectPathParam of
    Maybe ProjectPath
Nothing -> (Maybe (Id Project), ProjectPath) -> ProjectPath
forall a b. (a, b) -> b
snd ((Maybe (Id Project), ProjectPath) -> ProjectPath)
-> RIO r (Maybe (Id Project), ProjectPath) -> RIO r ProjectPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO r (Maybe (Id Project), ProjectPath)
forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
RIO r (Maybe (Id Project), ProjectPath)
findProjectContextually
    Just ProjectPath
projectKey -> ProjectPath -> RIO r ProjectPath
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectPath
projectKey

getProjectIdAndPath :: (Has HerculesClientToken r, Has HerculesClientEnv r) => Maybe ProjectPath -> RIO r (Maybe (Id Project), ProjectPath)
getProjectIdAndPath :: forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
Maybe ProjectPath -> RIO r (Maybe (Id Project), ProjectPath)
getProjectIdAndPath Maybe ProjectPath
maybeProjectPathParam = do
  case Maybe ProjectPath
maybeProjectPathParam of
    Maybe ProjectPath
Nothing -> RIO r (Maybe (Id Project), ProjectPath)
forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
RIO r (Maybe (Id Project), ProjectPath)
findProjectContextually
    Just ProjectPath
projectKey -> do
      Maybe Project
project <- ProjectPath -> RIO r (Maybe Project)
forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
ProjectPath -> RIO r (Maybe Project)
findProjectByKey ProjectPath
projectKey
      (Maybe (Id Project), ProjectPath)
-> RIO r (Maybe (Id Project), ProjectPath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Project -> Id Project
Project.id (Project -> Id Project) -> Maybe Project -> Maybe (Id Project)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Project
project, ProjectPath
projectKey)

findProjectByKey :: (Has HerculesClientToken r, Has HerculesClientEnv r) => ProjectPath -> RIO r (Maybe Project.Project)
findProjectByKey :: forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
ProjectPath -> RIO r (Maybe Project)
findProjectByKey ProjectPath
path =
  (Token -> ClientM [Project]) -> RIO r [Project]
forall a r.
(NFData a, Has HerculesClientToken r, Has HerculesClientEnv r) =>
(Token -> ClientM a) -> RIO r a
runHerculesClient
    ( ProjectsAPI ClientAuth (AsClientT ClientM)
-> AsClientT ClientM
   :- (Summary "Find projects"
       :> ("projects"
           :> (QueryParam' '[Optional] "site" (Name SourceHostingSite)
               :> (QueryParam' '[Optional] "account" (Name Account)
                   :> (QueryParam' '[Optional] "project" (Name Project)
                       :> (ClientAuth :> Get '[JSON] [Project]))))))
forall auth f.
ProjectsAPI auth f
-> f
   :- (Summary "Find projects"
       :> ("projects"
           :> (QueryParam' '[Optional] "site" (Name SourceHostingSite)
               :> (QueryParam' '[Optional] "account" (Name Account)
                   :> (QueryParam' '[Optional] "project" (Name Project)
                       :> (auth :> Get '[JSON] [Project]))))))
Projects.findProjects
        ProjectsAPI ClientAuth (AsClientT ClientM)
projectsClient
        (Name SourceHostingSite -> Maybe (Name SourceHostingSite)
forall a. a -> Maybe a
Just (Name SourceHostingSite -> Maybe (Name SourceHostingSite))
-> Name SourceHostingSite -> Maybe (Name SourceHostingSite)
forall a b. (a -> b) -> a -> b
$ Text -> Name SourceHostingSite
forall k (a :: k). Text -> Name a
Name (Text -> Name SourceHostingSite) -> Text -> Name SourceHostingSite
forall a b. (a -> b) -> a -> b
$ ProjectPath -> Text
projectPathSite ProjectPath
path)
        (Name Account -> Maybe (Name Account)
forall a. a -> Maybe a
Just (Name Account -> Maybe (Name Account))
-> Name Account -> Maybe (Name Account)
forall a b. (a -> b) -> a -> b
$ Text -> Name Account
forall k (a :: k). Text -> Name a
Name (Text -> Name Account) -> Text -> Name Account
forall a b. (a -> b) -> a -> b
$ ProjectPath -> Text
projectPathOwner ProjectPath
path)
        (Name Project -> Maybe (Name Project)
forall a. a -> Maybe a
Just (Name Project -> Maybe (Name Project))
-> Name Project -> Maybe (Name Project)
forall a b. (a -> b) -> a -> b
$ Text -> Name Project
forall k (a :: k). Text -> Name a
Name (Text -> Name Project) -> Text -> Name Project
forall a b. (a -> b) -> a -> b
$ ProjectPath -> Text
projectPathProject ProjectPath
path)
    )
    RIO r [Project]
-> ([Project] -> Maybe Project) -> RIO r (Maybe Project)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Project] -> Maybe Project
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head

findProjectContextually :: (Has HerculesClientToken r, Has HerculesClientEnv r) => RIO r (Maybe (Id Project), ProjectPath)
findProjectContextually :: forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
RIO r (Maybe (Id Project), ProjectPath)
findProjectContextually = do
  Maybe FilePath
projectIdMaybe <- FilePath -> RIO r (Maybe FilePath)
forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe FilePath)
lookupEnv FilePath
"HERCULES_CI_PROJECT_ID"
  Maybe FilePath
projectIdPathMaybe <- FilePath -> RIO r (Maybe FilePath)
forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe FilePath)
lookupEnv FilePath
"HERCULES_CI_PROJECT_PATH"
  case (,) (FilePath -> FilePath -> (FilePath, FilePath))
-> Maybe FilePath -> Maybe (FilePath -> (FilePath, FilePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
projectIdMaybe Maybe (FilePath -> (FilePath, FilePath))
-> Maybe FilePath -> Maybe (FilePath, FilePath)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe FilePath
projectIdPathMaybe of
    Maybe (FilePath, FilePath)
Nothing -> RIO r (Maybe (Id Project), ProjectPath)
forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
RIO r (Maybe (Id Project), ProjectPath)
findProjectByCurrentRepo
    Just (FilePath
id, FilePath
pathText) -> do
      ProjectPath
projectPath <- Text -> Either FilePath ProjectPath
parseProjectPathFromText (FilePath -> Text
forall a b. ConvertText a b => a -> b
toS FilePath
pathText) Either FilePath ProjectPath
-> (Either FilePath ProjectPath -> RIO r ProjectPath)
-> RIO r ProjectPath
forall a b. a -> (a -> b) -> b
& (FilePath -> FatalError)
-> Either FilePath ProjectPath -> RIO r ProjectPath
forall exc (m :: * -> *) l a.
(Exception exc, MonadThrow m) =>
(l -> exc) -> Either l a -> m a
escalateAs (\FilePath
e -> Text -> FatalError
FatalError (Text -> FatalError) -> Text -> FatalError
forall a b. (a -> b) -> a -> b
$ Text
"Invalid HERCULES_CI_PROJECT_PATH supplied: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a b. ConvertText a b => a -> b
toS FilePath
e)
      UUID
uuid <- FilePath -> Maybe UUID
Data.UUID.fromString FilePath
id Maybe UUID
-> (Maybe UUID -> Either FatalError UUID) -> Either FatalError UUID
forall a b. a -> (a -> b) -> b
& FatalError -> Maybe UUID -> Either FatalError UUID
forall e a. e -> Maybe a -> Either e a
maybeToEither (Text -> FatalError
FatalError Text
"Invalid UUID in HERCULES_CI_PROJECT_ID") Either FatalError UUID
-> (Either FatalError UUID -> RIO r UUID) -> RIO r UUID
forall a b. a -> (a -> b) -> b
& Either FatalError UUID -> RIO r UUID
forall exc (m :: * -> *) a.
(Exception exc, MonadThrow m) =>
Either exc a -> m a
escalate
      (Maybe (Id Project), ProjectPath)
-> RIO r (Maybe (Id Project), ProjectPath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Id Project -> Maybe (Id Project)
forall a. a -> Maybe a
Just (UUID -> Id Project
forall k (a :: k). UUID -> Id a
Id UUID
uuid), ProjectPath
projectPath)

findProjectByCurrentRepo :: (Has HerculesClientToken r, Has HerculesClientEnv r) => RIO r (Maybe (Id Project), ProjectPath)
findProjectByCurrentRepo :: forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
RIO r (Maybe (Id Project), ProjectPath)
findProjectByCurrentRepo = do
  Text
url <- IO Text -> RIO r Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Text
Git.getUpstreamURL
  Either ClientError RepoKey
rs <- (Token -> ClientM RepoKey) -> RIO r (Either ClientError RepoKey)
forall a r.
(NFData a, Has HerculesClientToken r, Has HerculesClientEnv r) =>
(Token -> ClientM a) -> RIO r (Either ClientError a)
runHerculesClientEither (ReposAPI ClientAuth (AsClientT ClientM)
-> AsClientT ClientM
   :- (Summary
         "Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
       :> ("parse-git-url"
           :> (QueryParam' '[Required, Strict] "gitURL" Text
               :> (ClientAuth :> Get '[JSON] RepoKey))))
forall auth f.
ReposAPI auth f
-> f
   :- (Summary
         "Parse a git remote URL into site, owner and repo. Returns 400 if invalid, 404 if the site can not be determined. Does provide any guarantee that the repository exists."
       :> ("parse-git-url"
           :> (QueryParam' '[Required, Strict] "gitURL" Text
               :> (auth :> Get '[JSON] RepoKey))))
Repos.parseGitURL ReposAPI ClientAuth (AsClientT ClientM)
reposClient Text
url)
  case Either ClientError RepoKey
rs of
    Left (FailureResponse RequestF () (BaseUrl, ByteString)
_req Response {responseStatusCode :: forall a. ResponseF a -> Status
responseStatusCode = Status {statusCode :: Status -> Int
statusCode = Int
404}}) -> do
      Text -> RIO r (Maybe (Id Project), ProjectPath)
forall (m :: * -> *) a. MonadIO m => Text -> m a
exitMsg Text
"Repository not recognized by Hercules CI. Make sure you're in the right repository, and if you're running Hercules CI Enterprise, make sure you're using the right HERCULES_CI_API_BASE_URL. Alternatively, use the --project option."
    Left ClientError
e -> ClientError -> RIO r (Maybe (Id Project), ProjectPath)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ClientError
e
    Right RepoKey
r ->
      (Maybe (Id Project), ProjectPath)
-> RIO r (Maybe (Id Project), ProjectPath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( RepoKey -> Maybe (Id Project)
RepoKey.projectId RepoKey
r,
          ProjectPath :: Text -> Text -> Text -> ProjectPath
ProjectPath
            { projectPathSite :: Text
projectPathSite = RepoKey -> Text
RepoKey.siteName RepoKey
r,
              projectPathOwner :: Text
projectPathOwner = RepoKey -> Text
RepoKey.ownerName RepoKey
r,
              projectPathProject :: Text
projectPathProject = RepoKey -> Text
RepoKey.repoName RepoKey
r
            }
        )

findProject :: (Has HerculesClientToken r, Has HerculesClientEnv r) => ProjectPath -> RIO r Project.Project
findProject :: forall r.
(Has HerculesClientToken r, Has HerculesClientEnv r) =>
ProjectPath -> RIO r Project
findProject ProjectPath
project = do
  [Project]
rs <-
    (Token -> ClientM [Project]) -> RIO r [Project]
forall a r.
(NFData a, Has HerculesClientToken r, Has HerculesClientEnv r) =>
(Token -> ClientM a) -> RIO r a
runHerculesClient
      ( ProjectsAPI ClientAuth (AsClientT ClientM)
-> AsClientT ClientM
   :- (Summary "Find projects"
       :> ("projects"
           :> (QueryParam' '[Optional] "site" (Name SourceHostingSite)
               :> (QueryParam' '[Optional] "account" (Name Account)
                   :> (QueryParam' '[Optional] "project" (Name Project)
                       :> (ClientAuth :> Get '[JSON] [Project]))))))
forall auth f.
ProjectsAPI auth f
-> f
   :- (Summary "Find projects"
       :> ("projects"
           :> (QueryParam' '[Optional] "site" (Name SourceHostingSite)
               :> (QueryParam' '[Optional] "account" (Name Account)
                   :> (QueryParam' '[Optional] "project" (Name Project)
                       :> (auth :> Get '[JSON] [Project]))))))
findProjects
          ProjectsAPI ClientAuth (AsClientT ClientM)
projectsClient
          (Name SourceHostingSite -> Maybe (Name SourceHostingSite)
forall a. a -> Maybe a
Just (Name SourceHostingSite -> Maybe (Name SourceHostingSite))
-> Name SourceHostingSite -> Maybe (Name SourceHostingSite)
forall a b. (a -> b) -> a -> b
$ Text -> Name SourceHostingSite
forall k (a :: k). Text -> Name a
Name (Text -> Name SourceHostingSite) -> Text -> Name SourceHostingSite
forall a b. (a -> b) -> a -> b
$ ProjectPath -> Text
projectPathSite ProjectPath
project)
          (Name Account -> Maybe (Name Account)
forall a. a -> Maybe a
Just (Name Account -> Maybe (Name Account))
-> Name Account -> Maybe (Name Account)
forall a b. (a -> b) -> a -> b
$ Text -> Name Account
forall k (a :: k). Text -> Name a
Name (Text -> Name Account) -> Text -> Name Account
forall a b. (a -> b) -> a -> b
$ ProjectPath -> Text
projectPathOwner ProjectPath
project)
          (Name Project -> Maybe (Name Project)
forall a. a -> Maybe a
Just (Name Project -> Maybe (Name Project))
-> Name Project -> Maybe (Name Project)
forall a b. (a -> b) -> a -> b
$ Text -> Name Project
forall k (a :: k). Text -> Name a
Name (Text -> Name Project) -> Text -> Name Project
forall a b. (a -> b) -> a -> b
$ ProjectPath -> Text
projectPathProject ProjectPath
project)
      )
  case [Project]
rs of
    [] -> do
      Text -> RIO r Project
forall (m :: * -> *) a. MonadIO m => Text -> m a
exitMsg (Text -> RIO r Project) -> Text -> RIO r Project
forall a b. (a -> b) -> a -> b
$ Text
"Project not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ProjectPath -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show ProjectPath
project
    [Project
p] -> Project -> RIO r Project
forall (f :: * -> *) a. Applicative f => a -> f a
pure Project
p
    [Project]
_ -> do
      Text -> RIO r Project
forall (m :: * -> *) a. MonadIO m => Text -> m a
exitMsg (Text -> RIO r Project) -> Text -> RIO r Project
forall a b. (a -> b) -> a -> b
$ Text
"Project ambiguous: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ProjectPath -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show ProjectPath
project

projectResourceClientByPath :: ProjectPath -> ProjectResourceGroup ClientAuth (AsClientT ClientM)
projectResourceClientByPath :: ProjectPath -> ProjectResourceGroup ClientAuth (AsClientT ClientM)
projectResourceClientByPath ProjectPath
projectPath =
  ProjectsAPI ClientAuth (AsClientT ClientM)
projectsClient ProjectsAPI ClientAuth (AsClientT ClientM)
-> (ProjectsAPI ClientAuth (AsClientT ClientM)
    -> ToServant (ProjectResourceGroup ClientAuth) (AsClientT ClientM))
-> ProjectResourceGroup ClientAuth (AsClientT ClientM)
forall {k} (subapi :: k -> * -> *) (api :: k -> * -> *) mode
       (a :: k).
(GenericServant (api a) mode, GenericServant (subapi a) mode) =>
api a mode
-> (api a mode -> ToServant (subapi a) mode) -> subapi a mode
`enterApiE` \ProjectsAPI ClientAuth (AsClientT ClientM)
api ->
    ProjectsAPI ClientAuth (AsClientT ClientM)
-> AsClientT ClientM
   :- Substitute
        ("site"
         :> (Capture' '[Required, Strict] "site" (Name SourceHostingSite)
             :> ("account"
                 :> (Capture' '[Required, Strict] "account" (Name Account)
                     :> ("project"
                         :> (Capture' '[Required, Strict] "project" (Name Project)
                             :> Placeholder))))))
        (ToServantApi (ProjectResourceGroup ClientAuth))
forall auth f.
ProjectsAPI auth f
-> f
   :- Substitute
        ("site"
         :> (Capture' '[Required, Strict] "site" (Name SourceHostingSite)
             :> ("account"
                 :> (Capture' '[Required, Strict] "account" (Name Account)
                     :> ("project"
                         :> (Capture' '[Required, Strict] "project" (Name Project)
                             :> Placeholder))))))
        (ToServantApi (ProjectResourceGroup auth))
byProjectName
      ProjectsAPI ClientAuth (AsClientT ClientM)
api
      (Text -> Name SourceHostingSite
forall k (a :: k). Text -> Name a
Name (Text -> Name SourceHostingSite) -> Text -> Name SourceHostingSite
forall a b. (a -> b) -> a -> b
$ ProjectPath -> Text
projectPathSite ProjectPath
projectPath)
      (Text -> Name Account
forall k (a :: k). Text -> Name a
Name (Text -> Name Account) -> Text -> Name Account
forall a b. (a -> b) -> a -> b
$ ProjectPath -> Text
projectPathOwner ProjectPath
projectPath)
      (Text -> Name Project
forall k (a :: k). Text -> Name a
Name (Text -> Name Project) -> Text -> Name Project
forall a b. (a -> b) -> a -> b
$ ProjectPath -> Text
projectPathProject ProjectPath
projectPath)