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
(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"
(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)