module Restyler.Main
    ( restylerMain
    ) where

import Restyler.Prelude

import Restyler.App.Class
import Restyler.App.Error
import Restyler.Comment
import Restyler.Config
import Restyler.Git
import Restyler.Options
import Restyler.PullRequest
import Restyler.PullRequest.Status
import Restyler.RemoteFile
import Restyler.RestyledPullRequest
import Restyler.Restyler.Run
import Restyler.RestylerResult

restylerMain
    :: ( HasLogFunc env
       , HasOptions env
       , HasConfig env
       , HasPullRequest env
       , HasRestyledPullRequest env
       , HasSystem env
       , HasExit env
       , HasProcess env
       , HasGit env
       , HasDownloadFile env
       , HasGitHub env
       )
    => RIO env a
restylerMain :: RIO env a
restylerMain = do
    Maybe URL
jobUrl <- 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
    (Config -> [RemoteFile])
-> ([RemoteFile] -> RIO env ()) -> RIO env ()
forall env a.
HasConfig env =>
(Config -> [a]) -> ([a] -> RIO env ()) -> RIO env ()
whenConfigNonEmpty Config -> [RemoteFile]
cRemoteFiles (([RemoteFile] -> RIO env ()) -> RIO env ())
-> ([RemoteFile] -> RIO env ()) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ (RemoteFile -> RIO env ()) -> [RemoteFile] -> RIO env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ RemoteFile -> RIO env ()
forall env.
(HasLogFunc env, HasDownloadFile env) =>
RemoteFile -> RIO env ()
downloadRemoteFile

    [RestylerResult]
results <- RIO env [RestylerResult]
forall env.
(HasLogFunc env, HasOptions env, HasConfig env, HasPullRequest env,
 HasSystem env, HasProcess env, HasGit env) =>
RIO env [RestylerResult]
restyle
    Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ "Restyling results: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder -> [RestylerResult] -> Utf8Builder
forall a. Display a => Utf8Builder -> [a] -> Utf8Builder
displayIntercalated ", " [RestylerResult]
results

    PullRequest
pullRequest <- Getting PullRequest env PullRequest -> RIO env PullRequest
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PullRequest env PullRequest
forall env. HasPullRequest env => Lens' env PullRequest
pullRequestL
    Maybe RestyledPullRequest
mRestyledPullRequest <- Getting (Maybe RestyledPullRequest) env (Maybe RestyledPullRequest)
-> RIO env (Maybe RestyledPullRequest)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe RestyledPullRequest) env (Maybe RestyledPullRequest)
forall env.
HasRestyledPullRequest env =>
Lens' env (Maybe RestyledPullRequest)
restyledPullRequestL

    RIO env Bool -> RIO env () -> RIO env ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM RIO env Bool
forall env. (HasPullRequest env, HasGit env) => RIO env Bool
wasRestyled (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ do
        PullRequest -> RIO env ()
forall env.
(HasCallStack, HasLogFunc env, HasGitHub env) =>
PullRequest -> RIO env ()
clearRestyledComments PullRequest
pullRequest
        (RestyledPullRequest -> RIO env ())
-> Maybe RestyledPullRequest -> RIO env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ RestyledPullRequest -> RIO env ()
forall env.
(HasLogFunc env, HasGitHub env) =>
RestyledPullRequest -> RIO env ()
closeRestyledPullRequest Maybe RestyledPullRequest
mRestyledPullRequest
        PullRequestStatus -> RIO env ()
forall env.
(HasLogFunc env, HasConfig env, HasPullRequest env,
 HasGitHub env) =>
PullRequestStatus -> RIO env ()
sendPullRequestStatus (PullRequestStatus -> RIO env ())
-> PullRequestStatus -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Maybe URL -> PullRequestStatus
NoDifferencesStatus Maybe URL
jobUrl
        Utf8Builder -> RIO env ()
forall env a.
(HasLogFunc env, HasExit env) =>
Utf8Builder -> RIO env a
exitWithInfo "No style differences found"

    RIO env Bool -> RIO env () -> RIO env ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM RIO env Bool
forall env. (HasConfig env, HasPullRequest env) => RIO env Bool
isAutoPush (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 "Pushing Restyle commits to original PR"
        String -> RIO env ()
forall env. HasProcess env => String -> RIO env ()
gitCheckoutExisting (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
pullRequestLocalHeadRef PullRequest
pullRequest
        String -> RIO env ()
forall env. HasGit env => String -> RIO env ()
gitMerge (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

        -- This will fail if other changes came in while we were restyling, but
        -- it also means that we should be working on a Job for those changes
        -- already
        (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
$ String -> RIO env ()
forall env. HasGit env => String -> RIO env ()
gitPush (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
pullRequestHeadRef PullRequest
pullRequest
        Utf8Builder -> RIO env ()
forall env a.
(HasLogFunc env, HasExit env) =>
Utf8Builder -> RIO env a
exitWithInfo "Pushed Restyle commits to original PR"

    -- NB there is the edge-case of switching this off mid-PR. A previously
    -- opened Restyle PR would stop updating at that point.
    (Config -> Bool) -> RIO env () -> RIO env ()
forall env.
HasConfig env =>
(Config -> Bool) -> RIO env () -> RIO env ()
whenConfig (Bool -> Bool
not (Bool -> Bool) -> (Config -> Bool) -> Config -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Bool
cPullRequests) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ do
        PullRequestStatus -> RIO env ()
forall env.
(HasLogFunc env, HasConfig env, HasPullRequest env,
 HasGitHub env) =>
PullRequestStatus -> RIO env ()
sendPullRequestStatus (PullRequestStatus -> RIO env ())
-> PullRequestStatus -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Maybe URL -> PullRequestStatus
DifferencesStatus Maybe URL
jobUrl
        Utf8Builder -> RIO env ()
forall env a.
(HasLogFunc env, HasExit env) =>
Utf8Builder -> RIO env a
exitWithInfo "Not creating (or updating) Restyle PR, disabled by config"

    URL
url <- RestyledPullRequest -> URL
restyledPullRequestHtmlUrl (RestyledPullRequest -> URL)
-> RIO env RestyledPullRequest -> RIO env URL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe RestyledPullRequest
mRestyledPullRequest of
        Nothing -> PullRequest -> [RestylerResult] -> RIO env RestyledPullRequest
forall env.
(HasLogFunc env, HasOptions env, HasConfig env, HasGit env,
 HasGitHub env) =>
PullRequest -> [RestylerResult] -> RIO env RestyledPullRequest
createRestyledPullRequest PullRequest
pullRequest [RestylerResult]
results
        Just pr :: RestyledPullRequest
pr -> RestyledPullRequest
-> [RestylerResult] -> RIO env RestyledPullRequest
forall env.
HasGit env =>
RestyledPullRequest
-> [RestylerResult] -> RIO env RestyledPullRequest
updateRestyledPullRequest RestyledPullRequest
pr [RestylerResult]
results

    PullRequestStatus -> RIO env ()
forall env.
(HasLogFunc env, HasConfig env, HasPullRequest env,
 HasGitHub env) =>
PullRequestStatus -> RIO env ()
sendPullRequestStatus (PullRequestStatus -> RIO env ())
-> PullRequestStatus -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Maybe URL -> PullRequestStatus
DifferencesStatus (Maybe URL -> PullRequestStatus) -> Maybe URL -> PullRequestStatus
forall a b. (a -> b) -> a -> b
$ URL -> Maybe URL
forall a. a -> Maybe a
Just URL
url
    Utf8Builder -> RIO env a
forall env a.
(HasLogFunc env, HasExit env) =>
Utf8Builder -> RIO env a
exitWithInfo "Restyling successful"

restyle
    :: ( HasLogFunc env
       , HasOptions env
       , HasConfig env
       , HasPullRequest env
       , HasSystem env
       , HasProcess env
       , HasGit env
       )
    => RIO env [RestylerResult]
restyle :: RIO env [RestylerResult]
restyle = do
    Config
config <- Getting Config env Config -> RIO env Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config env Config
forall env. HasConfig env => Lens' env Config
configL
    PullRequest
pullRequest <- Getting PullRequest env PullRequest -> RIO env PullRequest
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PullRequest env PullRequest
forall env. HasPullRequest env => Lens' env PullRequest
pullRequestL
    [String]
pullRequestPaths <- Text -> RIO env [String]
forall env. HasGit env => Text -> RIO env [String]
changedPaths (Text -> RIO env [String]) -> Text -> RIO env [String]
forall a b. (a -> b) -> a -> b
$ PullRequest -> Text
pullRequestBaseRef PullRequest
pullRequest
    Config -> [String] -> RIO env [RestylerResult]
forall env.
(HasLogFunc env, HasOptions env, HasSystem env, HasProcess env,
 HasGit env) =>
Config -> [String] -> RIO env [RestylerResult]
runRestylers Config
config [String]
pullRequestPaths

wasRestyled :: (HasPullRequest env, HasGit env) => RIO env Bool
wasRestyled :: RIO env Bool
wasRestyled = do
    Text
headRef <- PullRequest -> Text
pullRequestLocalHeadRef (PullRequest -> Text) -> RIO env PullRequest -> RIO env Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting PullRequest env PullRequest -> RIO env PullRequest
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PullRequest env PullRequest
forall env. HasPullRequest env => Lens' env PullRequest
pullRequestL
    Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> RIO env [String] -> RIO env Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RIO env [String]
forall env. HasGit env => Text -> RIO env [String]
changedPaths Text
headRef

changedPaths :: HasGit env => Text -> RIO env [FilePath]
changedPaths :: Text -> RIO env [String]
changedPaths branch :: Text
branch = do
    Text
ref <- Text -> (String -> Text) -> Maybe String -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
branch String -> Text
pack (Maybe String -> Text) -> RIO env (Maybe String) -> RIO env Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> RIO env (Maybe String)
forall env. HasGit env => String -> RIO env (Maybe String)
gitMergeBase (Text -> String
unpack Text
branch)
    Maybe String -> RIO env [String]
forall env. HasGit env => Maybe String -> RIO env [String]
gitDiffNameOnly (Maybe String -> RIO env [String])
-> Maybe String -> RIO env [String]
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
ref

isAutoPush :: (HasConfig env, HasPullRequest env) => RIO env Bool
isAutoPush :: RIO env Bool
isAutoPush = do
    Bool
isAuto <- Config -> Bool
cAuto (Config -> Bool) -> RIO env Config -> RIO env Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Config env Config -> RIO env Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config env Config
forall env. HasConfig env => Lens' env Config
configL
    PullRequest
pullRequest <- Getting PullRequest env PullRequest -> RIO env PullRequest
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PullRequest env PullRequest
forall env. HasPullRequest env => Lens' env PullRequest
pullRequestL
    Bool -> RIO env Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> RIO env Bool) -> Bool -> RIO env Bool
forall a b. (a -> b) -> a -> b
$ Bool
isAuto Bool -> Bool -> Bool
&& Bool -> Bool
not (PullRequest -> Bool
pullRequestIsFork PullRequest
pullRequest)