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 -- ^ Original PR
    -> Text -- ^ Head ref used to find the Restyled PR
    -> SimplePullRequest -- ^ Found Restyled PR
    -> 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 -- ^ Created Restyled PR
    -> 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)

-- |
--
-- TODO: consider using results to update PR description.
--
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