From 1233f05c59fd7ccb8ebe2113eff4ae5c5f3f4612 Mon Sep 17 00:00:00 2001 From: "Restyled.io" Date: Fri, 12 Jul 2024 15:27:53 +0000 Subject: [PATCH] Restyled by fourmolu --- src/Restyler/App.hs | 62 +++++++++++++++---------------- src/Restyler/Config.hs | 18 ++++----- src/Restyler/Main.hs | 26 ++++++------- src/Restyler/Options.hs | 22 +++++------ src/Restyler/PullRequest/File.hs | 16 ++++---- src/Restyler/Restrictions.hs | 44 +++++++++++----------- src/Restyler/Restyler/Run.hs | 50 ++++++++++++------------- src/Restyler/Setup.hs | 34 ++++++++--------- test/Restyler/Restyler/RunSpec.hs | 20 +++++----- 9 files changed, 146 insertions(+), 146 deletions(-) diff --git a/src/Restyler/App.hs b/src/Restyler/App.hs index 6fbdf5101..bb51c9901 100644 --- a/src/Restyler/App.hs +++ b/src/Restyler/App.hs @@ -110,46 +110,46 @@ instance (MonadUnliftIO m, HasLogger app) => MonadProcess (AppT app m) where liftIO $ Process.callProcess cmd args callProcessExitCode cmd args = do - logDebug $ - "callProcessExitCode" - :# ["command" .= cmd, "arguments" .= args] + logDebug + $ "callProcessExitCode" + :# ["command" .= cmd, "arguments" .= args] ec <- liftIO $ Process.withCreateProcess proc $ \_ _ _ p -> Process.waitForProcess p - (if ec == ExitSuccess then logDebug else logWarn) $ - "callProcessExitCode" - :# [ "command" .= cmd - , "arguments" .= args - , "exitCode" .= exitCodeInt ec - ] + (if ec == ExitSuccess then logDebug else logWarn) + $ "callProcessExitCode" + :# [ "command" .= cmd + , "arguments" .= args + , "exitCode" .= exitCodeInt ec + ] pure ec where proc = (Process.proc cmd args) {Process.delegate_ctlc = True} readProcess cmd args = do - logDebug $ - "readProcess" - :# ["command" .= cmd, "arguments" .= args] + logDebug + $ "readProcess" + :# ["command" .= cmd, "arguments" .= args] output <- liftIO $ Process.readProcess cmd args "" - logDebug $ - "readProcess" - :# [ "command" .= cmd - , "arguments" .= args - , "output" .= output - ] + logDebug + $ "readProcess" + :# [ "command" .= cmd + , "arguments" .= args + , "output" .= output + ] pure output readProcessExitCode cmd args = do - logDebug $ - "readProcess" - :# ["command" .= cmd, "arguments" .= args] + logDebug + $ "readProcess" + :# ["command" .= cmd, "arguments" .= args] (ec, output, err) <- liftIO $ Process.readProcessWithExitCode cmd args "" - (if ec == ExitSuccess then logDebug else logWarn) $ - "readProcessExitCode" - :# [ "command" .= cmd - , "arguments" .= args - , "output" .= output - , "errorOutput" .= err - ] + (if ec == ExitSuccess then logDebug else logWarn) + $ "readProcessExitCode" + :# [ "command" .= cmd + , "arguments" .= args + , "output" .= output + , "errorOutput" .= err + ] pure (ec, output) instance (MonadUnliftIO m, HasLogger app) => MonadExit (AppT app m) where @@ -186,9 +186,9 @@ runGitHubInternal => GenRequest m k a -> n a runGitHubInternal req = do - logDebug $ - "runGitHub" - :# ["request" .= show @Text (displayGitHubRequest req)] + logDebug + $ "runGitHub" + :# ["request" .= show @Text (displayGitHubRequest req)] auth <- OAuth . encodeUtf8 . oAccessToken <$> view optionsL result <- liftIO $ do mgr <- getGlobalManager diff --git a/src/Restyler/Config.hs b/src/Restyler/Config.hs index e933c7c05..8899ff278 100644 --- a/src/Restyler/Config.hs +++ b/src/Restyler/Config.hs @@ -220,11 +220,11 @@ loadConfig ) => m Config loadConfig = - loadConfigFrom (map ConfigPath configPaths) $ - handleTo ConfigErrorInvalidRestylersYaml - . getAllRestylersVersioned - . runIdentity - . cfRestylersVersion + loadConfigFrom (map ConfigPath configPaths) + $ handleTo ConfigErrorInvalidRestylersYaml + . getAllRestylersVersioned + . runIdentity + . cfRestylersVersion loadConfigFrom :: (MonadUnliftIO m, MonadSystem m) @@ -284,10 +284,10 @@ decodeThrow = either throwIO pure . Yaml.decodeThrow resolveRestylers :: MonadIO m => ConfigF Identity -> [Restyler] -> m Config resolveRestylers ConfigF {..} allRestylers = do restylers <- - either (throwIO . ConfigErrorInvalidRestylers) pure $ - overrideRestylers allRestylers $ - unSketchy $ - runIdentity cfRestylers + either (throwIO . ConfigErrorInvalidRestylers) pure + $ overrideRestylers allRestylers + $ unSketchy + $ runIdentity cfRestylers pure Config diff --git a/src/Restyler/Main.hs b/src/Restyler/Main.hs index 13fdbee4d..999d6f758 100644 --- a/src/Restyler/Main.hs +++ b/src/Restyler/Main.hs @@ -56,9 +56,9 @@ restylerMain = do logInfo "Restyling produced differences" patch <- getRestyledPatch - withThreadContext ["patch" .= True] $ - traverse_ (logInfo . (:# [])) $ - T.lines patch + withThreadContext ["patch" .= True] + $ traverse_ (logInfo . (:# [])) + $ T.lines patch -- This message only makes sense in the context of a Job for_ mJobUrl $ \jobUrl -> do @@ -75,20 +75,20 @@ restylerMain = do then logWarn "Ignoring auto:true because PR is a fork" else do logInfo "Pushing changes directly to PR branch" - gitPush $ - unpack $ - pullRequestLocalHeadRef pullRequest - <> ":" - <> pullRequestHeadRef pullRequest + gitPush + $ unpack + $ pullRequestLocalHeadRef pullRequest + <> ":" + <> pullRequestHeadRef pullRequest exitWithInfo "Restyling successful" -- NB there is the edge-case of switching this off mid-PR. A previously -- opened Restyle PR would stop updating at that point. whenConfig (not . cPullRequests) $ do sendPullRequestStatus $ DifferencesStatus mJobUrl - logInfo $ - "Not creating Restyle PR" - :# ["reason" .= ("disabled by config" :: Text)] + logInfo + $ "Not creating Restyle PR" + :# ["reason" .= ("disabled by config" :: Text)] exitWithInfo "Please correct style using the process described above" let @@ -150,8 +150,8 @@ getRestyledPatch = do getChangedPaths :: MonadGitHub m => PullRequest -> m [FilePath] getChangedPaths pullRequest = do files <- - runGitHub $ - pullRequestFilesR + runGitHub + $ pullRequestFilesR (pullRequestOwnerName pullRequest) (pullRequestRepoName pullRequest) (pullRequestNumber pullRequest) diff --git a/src/Restyler/Options.hs b/src/Restyler/Options.hs index ea081eb50..32e8535ed 100644 --- a/src/Restyler/Options.hs +++ b/src/Restyler/Options.hs @@ -61,16 +61,16 @@ instance HasOptions Options where optionsL = id instance HasManifestOption Options where - manifestOptionL = lens (toManifestOption . oManifest) $ - \x y -> x {oManifest = unManifestOption y} + manifestOptionL = lens (toManifestOption . oManifest) + $ \x y -> x {oManifest = unManifestOption y} instance HasHostDirectoryOption Options where - hostDirectoryOptionL = lens (toHostDirectoryOption . oHostDirectory) $ - \x y -> x {oHostDirectory = unHostDirectoryOption y} + hostDirectoryOptionL = lens (toHostDirectoryOption . oHostDirectory) + $ \x y -> x {oHostDirectory = unHostDirectoryOption y} instance HasImageCleanupOption Options where - imageCleanupOptionL = lens (toImageCleanupOption . oImageCleanup) $ - \x y -> x {oImageCleanup = unImageCleanupOption y} + imageCleanupOptionL = lens (toImageCleanupOption . oImageCleanup) + $ \x y -> x {oImageCleanup = unImageCleanupOption y} instance HasRestrictions Options where restrictionsL = lens oRestrictions $ \x y -> x {oRestrictions = y} @@ -82,11 +82,11 @@ parseOptions :: IO Options parseOptions = do EnvOptions {..} <- Env.parse id envParser CLIOptions {..} <- - execParser $ - info (optionsParser <**> helper) $ - fullDesc - <> progDesc - "Restyle a GitHub Pull Request" + execParser + $ info (optionsParser <**> helper) + $ fullDesc + <> progDesc + "Restyle a GitHub Pull Request" pure Options diff --git a/src/Restyler/PullRequest/File.hs b/src/Restyler/PullRequest/File.hs index 6399303fa..04c19c562 100644 --- a/src/Restyler/PullRequest/File.hs +++ b/src/Restyler/PullRequest/File.hs @@ -61,13 +61,13 @@ pullRequestFileStatusToText = \case pullRequestFileToChangedPath :: PullRequestFile -> Maybe FilePath pullRequestFileToChangedPath file = do - guard $ - file.status - `elem` [ PullRequestFileAdded - , PullRequestFileCopied - , PullRequestFileChanged - , PullRequestFileRenamed - , PullRequestFileModified - ] + guard + $ file.status + `elem` [ PullRequestFileAdded + , PullRequestFileCopied + , PullRequestFileChanged + , PullRequestFileRenamed + , PullRequestFileModified + ] pure $ file.filename diff --git a/src/Restyler/Restrictions.hs b/src/Restyler/Restrictions.hs index 995655a69..79ccc1901 100644 --- a/src/Restyler/Restrictions.hs +++ b/src/Restyler/Restrictions.hs @@ -34,8 +34,8 @@ data Restrictions = Restrictions restrictionOptions :: Restrictions -> [String] restrictionOptions Restrictions {..} = - concat $ - catMaybes + concat + $ catMaybes [ (\b -> if b then ["--net", "none"] else []) <$> getLast netNone , (\b -> if b then ["--cap-drop", "all"] else []) <$> getLast capDropAll , (\n -> ["--cpu-shares", show n]) <$> getLast cpuShares @@ -54,26 +54,26 @@ envRestrictions = parseOverrides :: Env.Parser Env.Error Restrictions parseOverrides = - Env.prefixed "RESTYLER_" $ - Restrictions - <$> ( fmap not - <$> lastSwitch - "NO_NET_NONE" - "Run restylers without --net=none" - ) - <*> ( fmap not - <$> lastSwitch - "NO_CAP_DROP_ALL" - "Run restylers without --cap-drop=all" - ) - <*> lastReader - readNat - "CPU_SHARES" - "Run restylers with --cpu-shares=" - <*> lastReader - readBytes - "MEMORY" - "Run restylers with --memory=[b|k|m|g]" + Env.prefixed "RESTYLER_" + $ Restrictions + <$> ( fmap not + <$> lastSwitch + "NO_NET_NONE" + "Run restylers without --net=none" + ) + <*> ( fmap not + <$> lastSwitch + "NO_CAP_DROP_ALL" + "Run restylers without --cap-drop=all" + ) + <*> lastReader + readNat + "CPU_SHARES" + "Run restylers with --cpu-shares=" + <*> lastReader + readBytes + "MEMORY" + "Run restylers with --memory=[b|k|m|g]" where lastSwitch :: String diff --git a/src/Restyler/Restyler/Run.hs b/src/Restyler/Restyler/Run.hs index b0230b786..0b16eb34d 100644 --- a/src/Restyler/Restyler/Run.hs +++ b/src/Restyler/Restyler/Run.hs @@ -146,9 +146,9 @@ runRestylersWith run config@Config {..} allPaths = do if lenPaths > maxPaths then case cpcOutcome cChangedPaths of MaximumChangedPathsOutcomeSkip -> do - logWarn $ - "Number of changed paths is greater than configured maximum" - :# ["paths" .= lenPaths, "maximum" .= maxPaths] + logWarn + $ "Number of changed paths is greater than configured maximum" + :# ["paths" .= lenPaths, "maximum" .= maxPaths] pure [] MaximumChangedPathsOutcomeError -> throwIO $ TooManyChangedPaths lenPaths maxPaths @@ -185,16 +185,16 @@ withFilteredPaths restylers paths run = do else rInclude r included = includePath includes path - logDebug $ - "Matching paths" - :# [ "name" .= rName r - , "path" .= path - , "matched" .= matched - , "includes" .= includes - , "included" .= included - , "interpreter" .= mInterpreter - -- , "filtered" .= filtered - ] + logDebug + $ "Matching paths" + :# [ "name" .= rName r + , "path" .= path + , "matched" .= matched + , "includes" .= includes + , "included" .= included + , "interpreter" .= mInterpreter + -- , "filtered" .= filtered + ] pure $ if included then Just path else Nothing @@ -322,12 +322,12 @@ dockerRunRestyler r@Restyler {..} WithProgress {..} = do -- to avoid out-of-space errors. withImageCleanup f = if imageCleanup then f `finally` cleanupImage else f - logInfo $ - "Restyling" - :# [ "restyler" .= rName - , "run" .= progress - , "style" .= rRunStyle - ] + logInfo + $ "Restyling" + :# [ "restyler" .= rName + , "run" .= progress + , "style" .= rRunStyle + ] flushLogger -- so docker stdout is not interleaved ec <- withImageCleanup $ case pItem of @@ -353,15 +353,15 @@ dockerRunRestyler r@Restyler {..} WithProgress {..} = do eec <- tryAny $ callProcessExitCode "docker" ["image", "rm", "--force", rImage] case eec of Left ex -> - logWarn $ - "Exception removing Restyler image" - :# ["exception" .= displayException ex] + logWarn + $ "Exception removing Restyler image" + :# ["exception" .= displayException ex] Right ExitSuccess -> logInfo "Removed Restyler image" Right (ExitFailure i) -> - logWarn $ - "Error removing Restyler image" - :# ["status" .= i] + logWarn + $ "Error removing Restyler image" + :# ["status" .= i] fixNewline :: Text -> Text fixNewline = (<> "\n") . T.dropWhileEnd (== '\n') diff --git a/src/Restyler/Setup.hs b/src/Restyler/Setup.hs index bba510d56..c222162f6 100644 --- a/src/Restyler/Setup.hs +++ b/src/Restyler/Setup.hs @@ -27,14 +27,14 @@ data PlanUpgradeRequired = PlanUpgradeRequired Text (Maybe URL) instance Exception PlanUpgradeRequired where displayException (PlanUpgradeRequired message mUpgradeUrl) = - unpack $ - message - <> "\nFor additional help, please see: " - <> Wiki.commonError "Plan Upgrade Required" - <> maybe - "" - (("\nYou can upgrade your plan at " <>) . getUrl) - mUpgradeUrl + unpack + $ message + <> "\nFor additional help, please see: " + <> Wiki.commonError "Plan Upgrade Required" + <> maybe + "" + (("\nYou can upgrade your plan at " <>) . getUrl) + mUpgradeUrl restylerSetup :: ( HasCallStack @@ -55,16 +55,16 @@ restylerSetup restylerSetup = do Options {..} <- view optionsL - logInfo $ - "Restyler started" - :# ["owner" .= oOwner, "repo" .= oRepo, "pull" .= oPullRequest] + logInfo + $ "Restyler started" + :# ["owner" .= oOwner, "repo" .= oRepo, "pull" .= oPullRequest] - when oRepoDisabled $ - exitWithInfo $ - fromString $ - "This repository has been disabled for possible abuse." - <> " If you believe this is an error, please reach out to" - <> " support@restyled.io" + when oRepoDisabled + $ exitWithInfo + $ fromString + $ "This repository has been disabled for possible abuse." + <> " If you believe this is an error, please reach out to" + <> " support@restyled.io" pullRequest <- runGitHub $ pullRequestR oOwner oRepo oPullRequest diff --git a/test/Restyler/Restyler/RunSpec.hs b/test/Restyler/Restyler/RunSpec.hs index f08093f9c..64b0c477f 100644 --- a/test/Restyler/Restyler/RunSpec.hs +++ b/test/Restyler/Restyler/RunSpec.hs @@ -48,16 +48,16 @@ spec = withTestApp $ do runChangedPaths (mkPaths 1001) setOutcomeSkip `shouldReturn` () describe "runRestyler_" $ do - it "treats non-zero exit codes as RestylerExitFailure" $ - testAppExample $ - do - local (\x -> x {taProcessExitCodes = ExitFailure 99}) $ do - runRestyler_ (someRestyler "foo") ["bar"] - `shouldThrow` ( == - RestylerExitFailure - (someRestyler "foo") - 99 - ) + it "treats non-zero exit codes as RestylerExitFailure" + $ testAppExample + $ do + local (\x -> x {taProcessExitCodes = ExitFailure 99}) $ do + runRestyler_ (someRestyler "foo") ["bar"] + `shouldThrow` ( == + RestylerExitFailure + (someRestyler "foo") + 99 + ) describe "findFiles" $ do it "expands and excludes" $ testAppExample $ do