module Restyler.RestyledPullRequest
( RestyledPullRequest
, restyledPullRequestHeadRef
, restyledPullRequestHtmlUrl
, HasRestyledPullRequest(..)
, findRestyledPullRequest
, createRestyledPullRequest
, updateRestyledPullRequest
, closeRestyledPullRequest
)
where
import Restyler.Prelude
import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
import qualified Data.Set as Set
import GitHub.Endpoints.GitData.References.Delete (deleteReferenceR)
import GitHub.Endpoints.Issues.Labels (addLabelsToIssueR)
import GitHub.Endpoints.PullRequests
( CreatePullRequest(..)
, EditPullRequest(..)
, Issue
, IssueNumber
, IssueState(..)
, Owner
, Repo
, SimplePullRequest(..)
, createPullRequestR
, optionsBase
, optionsHead
, pullRequestsForR
, toPathPart
, unIssueNumber
, updatePullRequestR
)
import GitHub.Endpoints.PullRequests.ReviewRequests
(createReviewRequestR, requestOneReviewer)
import Restyler.App.Class (HasGitHub, runGitHub, runGitHubFirst, runGitHub_)
import Restyler.App.Error (warnIgnore)
import Restyler.Comment (leaveRestyledComment)
import Restyler.Config
import qualified Restyler.Content as Content
import Restyler.Git (HasGit, gitPushForce)
import Restyler.Options
import Restyler.PullRequest
import Restyler.PullRequestSpec
import Restyler.RestylerResult
data RestyledPullRequest = RestyledPullRequest
{ RestyledPullRequest -> Name Owner
restyledPullRequestOwnerName :: Name Owner
, RestyledPullRequest -> Name Repo
restyledPullRequestRepoName :: Name Repo
, RestyledPullRequest -> IssueNumber
restyledPullRequestNumber :: IssueNumber
, RestyledPullRequest -> IssueState
restyledPullRequestState :: IssueState
, RestyledPullRequest -> Text
restyledPullRequestHeadRef :: Text
, RestyledPullRequest -> URL
restyledPullRequestHtmlUrl :: URL
}
restyledPullRequestIssueId :: RestyledPullRequest -> Id Issue
restyledPullRequestIssueId :: RestyledPullRequest -> Id Issue
restyledPullRequestIssueId =
Proxy Issue -> Int -> Id Issue
forall (proxy :: * -> *) entity. proxy entity -> Int -> Id entity
mkId Proxy Issue
forall k (t :: k). Proxy t
Proxy (Int -> Id Issue)
-> (RestyledPullRequest -> Int) -> RestyledPullRequest -> Id Issue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IssueNumber -> Int
unIssueNumber (IssueNumber -> Int)
-> (RestyledPullRequest -> IssueNumber)
-> RestyledPullRequest
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RestyledPullRequest -> IssueNumber
restyledPullRequestNumber
existingRestyledPullRequest
:: PullRequest
-> Text
-> SimplePullRequest
-> RestyledPullRequest
existingRestyledPullRequest :: PullRequest -> Text -> SimplePullRequest -> RestyledPullRequest
existingRestyledPullRequest pullRequest :: PullRequest
pullRequest ref :: Text
ref simplePullRequest :: SimplePullRequest
simplePullRequest =
RestyledPullRequest :: Name Owner
-> Name Repo
-> IssueNumber
-> IssueState
-> Text
-> URL
-> RestyledPullRequest
RestyledPullRequest
{ restyledPullRequestOwnerName :: Name Owner
restyledPullRequestOwnerName = HasCallStack => PullRequest -> Name Owner
PullRequest -> Name Owner
pullRequestOwnerName PullRequest
pullRequest
, restyledPullRequestRepoName :: Name Repo
restyledPullRequestRepoName = HasCallStack => PullRequest -> Name Repo
PullRequest -> Name Repo
pullRequestRepoName PullRequest
pullRequest
, restyledPullRequestNumber :: IssueNumber
restyledPullRequestNumber = SimplePullRequest -> IssueNumber
simplePullRequestNumber SimplePullRequest
simplePullRequest
, restyledPullRequestState :: IssueState
restyledPullRequestState = SimplePullRequest -> IssueState
simplePullRequestState SimplePullRequest
simplePullRequest
, restyledPullRequestHeadRef :: Text
restyledPullRequestHeadRef = Text
ref
, restyledPullRequestHtmlUrl :: URL
restyledPullRequestHtmlUrl = SimplePullRequest -> URL
simplePullRequestHtmlUrl
SimplePullRequest
simplePullRequest
}
createdRestyledPullRequest
:: PullRequest
-> RestyledPullRequest
createdRestyledPullRequest :: PullRequest -> RestyledPullRequest
createdRestyledPullRequest restyledPullRequest :: PullRequest
restyledPullRequest = RestyledPullRequest :: Name Owner
-> Name Repo
-> IssueNumber
-> IssueState
-> Text
-> URL
-> RestyledPullRequest
RestyledPullRequest
{ restyledPullRequestOwnerName :: Name Owner
restyledPullRequestOwnerName = HasCallStack => PullRequest -> Name Owner
PullRequest -> Name Owner
pullRequestOwnerName PullRequest
restyledPullRequest
, restyledPullRequestRepoName :: Name Repo
restyledPullRequestRepoName = HasCallStack => PullRequest -> Name Repo
PullRequest -> Name Repo
pullRequestRepoName PullRequest
restyledPullRequest
, restyledPullRequestNumber :: IssueNumber
restyledPullRequestNumber = PullRequest -> IssueNumber
pullRequestNumber PullRequest
restyledPullRequest
, restyledPullRequestState :: IssueState
restyledPullRequestState = PullRequest -> IssueState
pullRequestState PullRequest
restyledPullRequest
, restyledPullRequestHeadRef :: Text
restyledPullRequestHeadRef = PullRequest -> Text
pullRequestHeadRef PullRequest
restyledPullRequest
, restyledPullRequestHtmlUrl :: URL
restyledPullRequestHtmlUrl = PullRequest -> URL
pullRequestHtmlUrl PullRequest
restyledPullRequest
}
instance Display RestyledPullRequest where
textDisplay :: RestyledPullRequest -> Text
textDisplay restyledPullRequest :: RestyledPullRequest
restyledPullRequest = PullRequestSpec -> Text
forall a. Display a => a -> Text
textDisplay PullRequestSpec :: Name Owner -> Name Repo -> IssueNumber -> PullRequestSpec
PullRequestSpec
{ prsOwner :: Name Owner
prsOwner = RestyledPullRequest -> Name Owner
restyledPullRequestOwnerName RestyledPullRequest
restyledPullRequest
, prsRepo :: Name Repo
prsRepo = RestyledPullRequest -> Name Repo
restyledPullRequestRepoName RestyledPullRequest
restyledPullRequest
, prsPullRequest :: IssueNumber
prsPullRequest = RestyledPullRequest -> IssueNumber
restyledPullRequestNumber RestyledPullRequest
restyledPullRequest
}
class HasRestyledPullRequest env where
restyledPullRequestL :: Lens' env (Maybe RestyledPullRequest)
findRestyledPullRequest
:: HasGitHub env => PullRequest -> RIO env (Maybe RestyledPullRequest)
findRestyledPullRequest :: PullRequest -> RIO env (Maybe RestyledPullRequest)
findRestyledPullRequest pullRequest :: PullRequest
pullRequest =
MaybeT (RIO env) RestyledPullRequest
-> RIO env (Maybe RestyledPullRequest)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (RIO env) RestyledPullRequest
-> RIO env (Maybe RestyledPullRequest))
-> MaybeT (RIO env) RestyledPullRequest
-> RIO env (Maybe RestyledPullRequest)
forall a b. (a -> b) -> a -> b
$ Text -> MaybeT (RIO env) RestyledPullRequest
findExisting Text
ref MaybeT (RIO env) RestyledPullRequest
-> MaybeT (RIO env) RestyledPullRequest
-> MaybeT (RIO env) RestyledPullRequest
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> MaybeT (RIO env) RestyledPullRequest
findExisting Text
legacyRef
where
ref :: Text
ref = PullRequest -> Text
pullRequestRestyledHeadRef PullRequest
pullRequest
legacyRef :: Text
legacyRef = PullRequest -> Text
pullRequestLocalHeadRef PullRequest
pullRequest Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "-restyled"
findExisting :: Text -> MaybeT (RIO env) RestyledPullRequest
findExisting r :: Text
r = PullRequest -> Text -> SimplePullRequest -> RestyledPullRequest
existingRestyledPullRequest PullRequest
pullRequest Text
r
(SimplePullRequest -> RestyledPullRequest)
-> MaybeT (RIO env) SimplePullRequest
-> MaybeT (RIO env) RestyledPullRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO env (Maybe SimplePullRequest)
-> MaybeT (RIO env) SimplePullRequest
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (PullRequest -> Text -> RIO env (Maybe SimplePullRequest)
forall env.
HasGitHub env =>
PullRequest -> Text -> RIO env (Maybe SimplePullRequest)
findSiblingPullRequest PullRequest
pullRequest Text
r)
createRestyledPullRequest
:: ( HasLogFunc env
, HasOptions env
, HasConfig env
, HasGit env
, HasGitHub env
)
=> PullRequest
-> [RestylerResult]
-> RIO env RestyledPullRequest
createRestyledPullRequest :: PullRequest -> [RestylerResult] -> RIO env RestyledPullRequest
createRestyledPullRequest pullRequest :: PullRequest
pullRequest results :: [RestylerResult]
results = do
String -> RIO env ()
forall env. HasGit env => String -> RIO env ()
gitPushForce (String -> RIO env ()) -> String -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ PullRequest -> Text
pullRequestRestyledHeadRef PullRequest
pullRequest
Maybe URL
mJobUrl <- Options -> Maybe URL
oJobUrl (Options -> Maybe URL) -> RIO env Options -> RIO env (Maybe URL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Options env Options -> RIO env Options
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Options env Options
forall env. HasOptions env => Lens' env Options
optionsL
let restyledTitle :: Text
restyledTitle = "Restyle " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PullRequest -> Text
pullRequestTitle PullRequest
pullRequest
restyledBody :: Text
restyledBody =
Maybe URL -> PullRequest -> [RestylerResult] -> Text
Content.pullRequestDescription Maybe URL
mJobUrl PullRequest
pullRequest [RestylerResult]
results
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo "Creating Restyled PR"
RestyledPullRequest
restyledPullRequest <-
(PullRequest -> RestyledPullRequest)
-> RIO env PullRequest -> RIO env RestyledPullRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PullRequest -> RestyledPullRequest
createdRestyledPullRequest (RIO env PullRequest -> RIO env RestyledPullRequest)
-> RIO env PullRequest -> RIO env RestyledPullRequest
forall a b. (a -> b) -> a -> b
$ GenRequest 'MtJSON 'RW PullRequest -> RIO env PullRequest
forall env (m :: MediaType *) a (k :: RW).
(HasGitHub env, ParseResponse m a) =>
GenRequest m k a -> RIO env a
runGitHub (GenRequest 'MtJSON 'RW PullRequest -> RIO env PullRequest)
-> GenRequest 'MtJSON 'RW PullRequest -> RIO env PullRequest
forall a b. (a -> b) -> a -> b
$ Name Owner
-> Name Repo
-> CreatePullRequest
-> GenRequest 'MtJSON 'RW PullRequest
createPullRequestR
(HasCallStack => PullRequest -> Name Owner
PullRequest -> Name Owner
pullRequestOwnerName PullRequest
pullRequest)
(HasCallStack => PullRequest -> Name Repo
PullRequest -> Name Repo
pullRequestRepoName PullRequest
pullRequest)
$WCreatePullRequest :: Text -> Text -> Text -> Text -> CreatePullRequest
CreatePullRequest
{ createPullRequestTitle :: Text
createPullRequestTitle = Text
restyledTitle
, createPullRequestBody :: Text
createPullRequestBody = Text
restyledBody
, createPullRequestBase :: Text
createPullRequestBase = PullRequest -> Text
pullRequestRestyledBaseRef PullRequest
pullRequest
, createPullRequestHead :: Text
createPullRequestHead = PullRequest -> Text
pullRequestRestyledHeadRef PullRequest
pullRequest
}
(Config -> [Name IssueLabel])
-> ([Name IssueLabel] -> RIO env ()) -> RIO env ()
forall env a.
HasConfig env =>
(Config -> [a]) -> ([a] -> RIO env ()) -> RIO env ()
whenConfigNonEmpty (Set (Name IssueLabel) -> [Name IssueLabel]
forall a. Set a -> [a]
Set.toList (Set (Name IssueLabel) -> [Name IssueLabel])
-> (Config -> Set (Name IssueLabel)) -> Config -> [Name IssueLabel]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Set (Name IssueLabel)
cLabels) (([Name IssueLabel] -> RIO env ()) -> RIO env ())
-> ([Name IssueLabel] -> RIO env ()) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ \labels :: [Name IssueLabel]
labels -> do
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ "Adding labels to Restyled PR (" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> [Name IssueLabel] -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow [Name IssueLabel]
labels Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> ")"
GenRequest 'MtJSON 'RW (Vector IssueLabel) -> RIO env ()
forall env (m :: MediaType *) a (k :: RW).
(HasGitHub env, ParseResponse m a) =>
GenRequest m k a -> RIO env ()
runGitHub_ (GenRequest 'MtJSON 'RW (Vector IssueLabel) -> RIO env ())
-> GenRequest 'MtJSON 'RW (Vector IssueLabel) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Name Owner
-> Name Repo
-> Id Issue
-> [Name IssueLabel]
-> GenRequest 'MtJSON 'RW (Vector IssueLabel)
forall (f :: * -> *).
Foldable f =>
Name Owner
-> Name Repo
-> Id Issue
-> f (Name IssueLabel)
-> GenRequest 'MtJSON 'RW (Vector IssueLabel)
addLabelsToIssueR
(RestyledPullRequest -> Name Owner
restyledPullRequestOwnerName RestyledPullRequest
restyledPullRequest)
(RestyledPullRequest -> Name Repo
restyledPullRequestRepoName RestyledPullRequest
restyledPullRequest)
(RestyledPullRequest -> Id Issue
restyledPullRequestIssueId RestyledPullRequest
restyledPullRequest)
[Name IssueLabel]
labels
(Config -> Maybe (Name User))
-> (Name User -> RIO env ()) -> RIO env ()
forall env a.
HasConfig env =>
(Config -> Maybe a) -> (a -> RIO env ()) -> RIO env ()
whenConfigJust (PullRequest -> Config -> Maybe (Name User)
configPullRequestReviewer PullRequest
pullRequest) ((Name User -> RIO env ()) -> RIO env ())
-> (Name User -> RIO env ()) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ \user :: Name User
user -> do
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ "Requesting review of Restyled PR from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Name User -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow Name User
user
GenRequest 'MtJSON 'RW ReviewRequest -> RIO env ()
forall env (m :: MediaType *) a (k :: RW).
(HasGitHub env, ParseResponse m a) =>
GenRequest m k a -> RIO env ()
runGitHub_ (GenRequest 'MtJSON 'RW ReviewRequest -> RIO env ())
-> GenRequest 'MtJSON 'RW ReviewRequest -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Name Owner
-> Name Repo
-> IssueNumber
-> RequestReview
-> GenRequest 'MtJSON 'RW ReviewRequest
createReviewRequestR
(RestyledPullRequest -> Name Owner
restyledPullRequestOwnerName RestyledPullRequest
restyledPullRequest)
(RestyledPullRequest -> Name Repo
restyledPullRequestRepoName RestyledPullRequest
restyledPullRequest)
(RestyledPullRequest -> IssueNumber
restyledPullRequestNumber RestyledPullRequest
restyledPullRequest)
(Name User -> RequestReview
requestOneReviewer Name User
user)
(Config -> Bool) -> RIO env () -> RIO env ()
forall env.
HasConfig env =>
(Config -> Bool) -> RIO env () -> RIO env ()
whenConfig Config -> Bool
cComments (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ do
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo "Leaving comment of Restyled PR"
PullRequest -> IssueNumber -> RIO env ()
forall env.
(HasCallStack, HasGitHub env) =>
PullRequest -> IssueNumber -> RIO env ()
leaveRestyledComment PullRequest
pullRequest
(IssueNumber -> RIO env ()) -> IssueNumber -> RIO env ()
forall a b. (a -> b) -> a -> b
$ RestyledPullRequest -> IssueNumber
restyledPullRequestNumber RestyledPullRequest
restyledPullRequest
RestyledPullRequest
restyledPullRequest
RestyledPullRequest -> RIO env () -> RIO env RestyledPullRequest
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo ("Opened Restyled PR " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RestyledPullRequest -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RestyledPullRequest
restyledPullRequest)
updateRestyledPullRequest
:: HasGit env
=> RestyledPullRequest
-> [RestylerResult]
-> RIO env RestyledPullRequest
updateRestyledPullRequest :: RestyledPullRequest
-> [RestylerResult] -> RIO env RestyledPullRequest
updateRestyledPullRequest restyledPullRequest :: RestyledPullRequest
restyledPullRequest _results :: [RestylerResult]
_results = do
String -> RIO env ()
forall env. HasGit env => String -> RIO env ()
gitPushForce (String -> RIO env ()) -> String -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ RestyledPullRequest -> Text
restyledPullRequestHeadRef RestyledPullRequest
restyledPullRequest
RestyledPullRequest -> RIO env RestyledPullRequest
forall (f :: * -> *) a. Applicative f => a -> f a
pure RestyledPullRequest
restyledPullRequest
closeRestyledPullRequest
:: (HasLogFunc env, HasGitHub env) => RestyledPullRequest -> RIO env ()
closeRestyledPullRequest :: RestyledPullRequest -> RIO env ()
closeRestyledPullRequest pr :: RestyledPullRequest
pr = do
IssueState -> RestyledPullRequest -> RIO env ()
forall env.
(HasLogFunc env, HasGitHub env) =>
IssueState -> RestyledPullRequest -> RIO env ()
editRestyledPullRequestState IssueState
StateClosed RestyledPullRequest
pr
(SomeException -> RIO env ()) -> RIO env () -> RIO env ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(SomeException -> m a) -> m a -> m a
handleAny SomeException -> RIO env ()
forall a env. (Display a, HasLogFunc env) => a -> RIO env ()
warnIgnore (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ GenRequest 'MtUnit 'RW () -> RIO env ()
forall env (m :: MediaType *) a (k :: RW).
(HasGitHub env, ParseResponse m a) =>
GenRequest m k a -> RIO env ()
runGitHub_ (GenRequest 'MtUnit 'RW () -> RIO env ())
-> GenRequest 'MtUnit 'RW () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Name Owner
-> Name Repo -> Name GitReference -> GenRequest 'MtUnit 'RW ()
deleteReferenceR
(RestyledPullRequest -> Name Owner
restyledPullRequestOwnerName RestyledPullRequest
pr)
(RestyledPullRequest -> Name Repo
restyledPullRequestRepoName RestyledPullRequest
pr)
(Proxy GitReference -> Text -> Name GitReference
forall (proxy :: * -> *) entity.
proxy entity -> Text -> Name entity
mkName Proxy GitReference
forall k (t :: k). Proxy t
Proxy (Text -> Name GitReference) -> Text -> Name GitReference
forall a b. (a -> b) -> a -> b
$ "heads/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RestyledPullRequest -> Text
restyledPullRequestHeadRef RestyledPullRequest
pr)
editRestyledPullRequestState
:: (HasLogFunc env, HasGitHub env)
=> IssueState
-> RestyledPullRequest
-> RIO env ()
editRestyledPullRequestState :: IssueState -> RestyledPullRequest -> RIO env ()
editRestyledPullRequestState state :: IssueState
state pr :: RestyledPullRequest
pr
| RestyledPullRequest -> IssueState
restyledPullRequestState RestyledPullRequest
pr IssueState -> IssueState -> Bool
forall a. Eq a => a -> a -> Bool
== IssueState
state
= Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn
(Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ "Redundant update of Restyled PR "
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RestyledPullRequest -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RestyledPullRequest
pr
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> " to "
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> IssueState -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow IssueState
state
| Bool
otherwise
= do
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo
(Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ "Updating Restyled PR "
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> RestyledPullRequest -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display RestyledPullRequest
pr
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> " to "
Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> IssueState -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow IssueState
state
GenRequest 'MtJSON 'RW PullRequest -> RIO env ()
forall env (m :: MediaType *) a (k :: RW).
(HasGitHub env, ParseResponse m a) =>
GenRequest m k a -> RIO env ()
runGitHub_ (GenRequest 'MtJSON 'RW PullRequest -> RIO env ())
-> GenRequest 'MtJSON 'RW PullRequest -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Name Owner
-> Name Repo
-> IssueNumber
-> EditPullRequest
-> GenRequest 'MtJSON 'RW PullRequest
updatePullRequestR
(RestyledPullRequest -> Name Owner
restyledPullRequestOwnerName RestyledPullRequest
pr)
(RestyledPullRequest -> Name Repo
restyledPullRequestRepoName RestyledPullRequest
pr)
(RestyledPullRequest -> IssueNumber
restyledPullRequestNumber RestyledPullRequest
pr)
$WEditPullRequest :: Maybe Text
-> Maybe Text
-> Maybe IssueState
-> Maybe Text
-> Maybe Bool
-> EditPullRequest
EditPullRequest
{ editPullRequestTitle :: Maybe Text
editPullRequestTitle = Maybe Text
forall a. Maybe a
Nothing
, editPullRequestBody :: Maybe Text
editPullRequestBody = Maybe Text
forall a. Maybe a
Nothing
, editPullRequestState :: Maybe IssueState
editPullRequestState = IssueState -> Maybe IssueState
forall a. a -> Maybe a
Just IssueState
state
, editPullRequestBase :: Maybe Text
editPullRequestBase = Maybe Text
forall a. Maybe a
Nothing
, editPullRequestMaintainerCanModify :: Maybe Bool
editPullRequestMaintainerCanModify = Maybe Bool
forall a. Maybe a
Nothing
}
findSiblingPullRequest
:: HasGitHub env => PullRequest -> Text -> RIO env (Maybe SimplePullRequest)
findSiblingPullRequest :: PullRequest -> Text -> RIO env (Maybe SimplePullRequest)
findSiblingPullRequest pr :: PullRequest
pr ref :: Text
ref =
(FetchCount -> GenRequest 'MtJSON Any (Vector SimplePullRequest))
-> RIO env (Maybe SimplePullRequest)
forall env (m :: MediaType *) a (k :: RW).
(HasGitHub env, ParseResponse m (Vector a)) =>
(FetchCount -> GenRequest m k (Vector a)) -> RIO env (Maybe a)
runGitHubFirst
((FetchCount -> GenRequest 'MtJSON Any (Vector SimplePullRequest))
-> RIO env (Maybe SimplePullRequest))
-> (FetchCount
-> GenRequest 'MtJSON Any (Vector SimplePullRequest))
-> RIO env (Maybe SimplePullRequest)
forall a b. (a -> b) -> a -> b
$ Name Owner
-> Name Repo
-> PullRequestMod
-> FetchCount
-> GenRequest 'MtJSON Any (Vector SimplePullRequest)
forall (k :: RW).
Name Owner
-> Name Repo
-> PullRequestMod
-> FetchCount
-> Request k (Vector SimplePullRequest)
pullRequestsForR Name Owner
owner Name Repo
repo
(PullRequestMod
-> FetchCount -> GenRequest 'MtJSON Any (Vector SimplePullRequest))
-> PullRequestMod
-> FetchCount
-> GenRequest 'MtJSON Any (Vector SimplePullRequest)
forall a b. (a -> b) -> a -> b
$ Text -> PullRequestMod
optionsBase (PullRequest -> Text
pullRequestRestyledBaseRef PullRequest
pr)
PullRequestMod -> PullRequestMod -> PullRequestMod
forall a. Semigroup a => a -> a -> a
<> Text -> PullRequestMod
optionsHead Text
qualifiedRef
where
owner :: Name Owner
owner = HasCallStack => PullRequest -> Name Owner
PullRequest -> Name Owner
pullRequestOwnerName PullRequest
pr
repo :: Name Repo
repo = HasCallStack => PullRequest -> Name Repo
PullRequest -> Name Repo
pullRequestRepoName PullRequest
pr
qualifiedRef :: Text
qualifiedRef = Name Owner -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Owner
owner Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref
pullRequestRestyledBaseRef :: PullRequest -> Text
pullRequestRestyledBaseRef :: PullRequest -> Text
pullRequestRestyledBaseRef pullRequest :: PullRequest
pullRequest
| PullRequest -> Bool
pullRequestIsFork PullRequest
pullRequest = PullRequest -> Text
pullRequestBaseRef PullRequest
pullRequest
| Bool
otherwise = PullRequest -> Text
pullRequestHeadRef PullRequest
pullRequest