WIP

restyler.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 8d1edda7d8bbbc6bf5c232eda9efaf6192546ee0f92ca902ec2added08c281b0
+-- hash: 5ede4ed5b2251d3e877ec1aab20640a48bad9ef6d95a5dedb2ce4daa7366523b
 
 name:           restyler
 version:        0.2.0.0
@@ -38,6 +38,7 @@ library
       Restyler.Delimited
       Restyler.ErrorMetadata
       Restyler.Exit
+      Restyler.GHA
       Restyler.GHA.Main
       Restyler.GHA.Options
       Restyler.Git

src/Restyler/Commands/RestyleGHA.hs

@@ -14,6 +14,7 @@ import Restyler.App (runAppT)
 import Restyler.App.Class (MonadDownloadFile, MonadSystem)
 import Restyler.Commands.RestyleLocal qualified as RestyleLocal
 import Restyler.Config (loadConfig)
+import Restyler.GHA
 import Restyler.GitHub.Api
 import Restyler.GitHub.PullRequest.File
 import Restyler.GitHub.Repository
@@ -35,6 +36,9 @@ instance HasLogger App where
 instance HasGitHubToken App where
   githubTokenL = optionsL . githubTokenL
 
+instance HasGitHubOutput App where
+  githubOutputL = optionsL . githubOutputL
+
 instance HasManifestOption App where
   manifestOptionL = noManifestOptionL
 
@@ -49,13 +53,7 @@ main repo pr = do
             , options = options
             }
 
-    runAppT app $ do
-      result <- run repo pr
-
-      -- TODO:
-      -- write outputs
-
-      logRestyleResult result
+    void $ runAppT app $ run repo pr
 
 run
   :: ( MonadUnliftIO m
@@ -64,6 +62,7 @@ run
      , MonadDownloadFile m
      , MonadGitHub m
      , MonadReader env m
+     , HasGitHubOutput env
      , HasManifestOption env
      )
   => Repository
@@ -77,11 +76,20 @@ run repo pr = do
   logInfo $ "Handling PR" :# objectToPairs pullRequest
 
   -- TODO
-  -- before: check draft
-  -- before: check closed
-  -- before: check ignores
-  -- after: cleanup PR if no diff
+  -- check draft
+  -- check closed
+  -- check ignores
+  -- => skip and cleanup PR
 
   paths <- mapMaybe pullRequestFileToChangedPath <$> getPullRequestFiles repo pr
+  traverse_ (logDebug . ("Path" :#) . objectToPairs) paths
+
+  result <- RestyleLocal.run paths
+
+  -- Move to RestyleLocal
+  -- logRestyleResult result
+
+  _differences <- setRestylerResultOutputs pullRequest result
+  -- TODO no differences? cleanup PR
 
-  RestyleLocal.run paths
+  pure result

src/Restyler/Content.hs

@@ -6,8 +6,6 @@ module Restyler.Content
 
 import Restyler.Prelude
 
-import GitHub.Data (unIssueNumber)
-import Restyler.PullRequest
 import Restyler.Restyler
 import Restyler.RestylerResult
 import Restyler.Wiki qualified as Wiki
@@ -18,50 +16,12 @@ import Text.Shakespeare.Text (st)
 pullRequestDescription
   :: Maybe URL
   -- ^ Job URL, if we have it
-  -> PullRequest
-  -- ^ Original PR
+  -> Int
+  -- ^ Original PR Number
   -> [RestylerResult]
   -> Text
-pullRequestDescription mJobUrl pullRequest results
-  | pullRequestIsFork pullRequest =
-      [st|
-A duplicate of ##{n} with additional commits that automatically address
-incorrect style, created by [Restyled][].
-
-:warning: Even though this PR is not a Fork, it contains outside contributions.
-Please review accordingly.
-
-Since the original Pull Request was opened as a fork in a contributor's
-repository, we are unable to create a Pull Request branching from it with only
-the style fixes.
-
-The following Restylers #{madeFixes}:
-
-#{resultsList}
-
-To incorporate these changes, you can either:
-
-1. Merge this Pull Request *instead of* the original, or
-
-1. Ask your contributor to locally incorporate these commits and push them to
-   the original Pull Request
-
-   <details>
-       <summary>Expand for example instructions</summary>
-
-       ```console
-       git remote add upstream #{getUrl $ pullRequestCloneUrl pullRequest}
-       git fetch upstream pull/<this PR number>/head
-       git merge --ff-only FETCH_HEAD
-       git push
-       ```
-
-   </details>
-
-#{footer}
-|]
-  | otherwise =
-      [st|
+pullRequestDescription mJobUrl n results =
+  [st|
 Automated style fixes for ##{n}, created by [Restyled][].
 
 The following restylers #{madeFixes}:
@@ -74,10 +34,6 @@ recommend using the Squash or Rebase strategies.
 #{footer}
 |]
  where
-  -- This variable is just so that we can wrap our content above such that
-  -- when the link is rendered at ~3 digits, it looks OK.
-  n = unIssueNumber $ pullRequestNumber pullRequest
-
   -- Link the "made fixes" line to the Job log, if we can
   madeFixes = case mJobUrl of
     Nothing -> "made fixes"

src/Restyler/GHA.hs

@@ -0,0 +1,46 @@
+module Restyler.GHA
+  ( GitHubOutput (..)
+  , envGitHubOutput
+  , HasGitHubOutput (..)
+  , setGitHubOutput
+  , setGitHubOutputLn
+  ) where
+
+import Restyler.Prelude
+
+import Env qualified
+
+newtype GitHubOutput = GitHubOutput
+  { unwrap :: FilePath
+  }
+  deriving newtype (IsString)
+
+class HasGitHubOutput env where
+  githubOutputL :: Lens' env GitHubOutput
+
+envGitHubOutput :: Env.Parser Env.Error GitHubOutput
+envGitHubOutput = Env.var Env.nonempty "GITHUB_OUTPUT" mempty
+
+setGitHubOutput
+  :: (MonadIO m, MonadReader env m, HasGitHubOutput env)
+  => Text
+  -> ByteString
+  -> m ()
+setGitHubOutput name value = do
+  path <- view $ githubOutputL . to (.unwrap)
+  liftIO $ do
+    writeFileText path $ name <> "="
+    writeFileBS path value
+    writeFileText path "\n"
+
+setGitHubOutputLn
+  :: (MonadIO m, MonadReader env m, HasGitHubOutput env)
+  => Text
+  -> ByteString
+  -> m ()
+setGitHubOutputLn name value = do
+  path <- view $ githubOutputL . to (.unwrap)
+  liftIO $ do
+    writeFileText path $ name <> "<<EOM\n"
+    writeFileBS path value
+    writeFileText path "\nEOM\n"

src/Restyler/GitHub/PullRequest.hs

@@ -16,6 +16,7 @@ import Data.Aeson
 
 data PullRequest = PullRequest
   { number :: Int
+  , title :: Text
   , state :: PullRequestState
   , labels :: [Label]
   , head :: Commit

src/Restyler/Options/RestyleGHA.hs

@@ -9,17 +9,22 @@ import Restyler.Prelude
 
 import Env qualified
 import Options.Applicative
+import Restyler.GHA
 import Restyler.GitHub.Api (GitHubToken, HasGitHubToken (..), envGitHubToken)
 import Restyler.LogSettingsOption
 
 data Options = Options
   { logSettings :: LogSettings
   , githubToken :: GitHubToken
+  , githubOutput :: GitHubOutput
   }
 
 instance HasGitHubToken Options where
   githubTokenL = lens (.githubToken) $ \x y -> x {githubToken = y}
 
+instance HasGitHubOutput Options where
+  githubOutputL = lens (.githubOutput) $ \x y -> x {githubOutput = y}
+
 getOptions :: IO Options
 getOptions = do
   env <- envOptions
@@ -29,11 +34,13 @@ getOptions = do
     $ Options
       { logSettings = resolveLogSettings $ env.logSettings <> opt.logSettings
       , githubToken = env.githubToken
+      , githubOutput = env.githubOutput
       }
 
 -- | Options as read from the environment
 data EnvOptions = EnvOptions
   { githubToken :: GitHubToken
+  , githubOutput :: GitHubOutput
   , logSettings :: LogSettingsOption
   }
 
@@ -42,6 +49,7 @@ envOptions =
   Env.parse id
     $ EnvOptions
     <$> envGitHubToken
+    <*> envGitHubOutput
     <*> envLogSettingsOption
 
 -- | Options as read via the CLI

src/Restyler/RestyleResult.hs

@@ -2,10 +2,14 @@ module Restyler.RestyleResult
   ( RestyleResult (..)
   , logRestyleResult
   , logRestylerResult
+  , setRestylerResultOutputs
   ) where
 
 import Restyler.Prelude
 
+import Restyler.Content qualified as Content
+import Restyler.GHA
+import Restyler.GitHub.PullRequest
 import Restyler.Ignore
 import Restyler.Restyler
 import Restyler.RestylerResult
@@ -39,5 +43,33 @@ logRestylerResult RestylerResult {..} =
            ]
     x -> logDebug $ "" :# ["result" .= x]
 
+setRestylerResultOutputs
+  :: (MonadIO m, MonadReader env m, HasGitHubOutput env)
+  => PullRequest
+  -> RestyleResult
+  -> m Bool
+setRestylerResultOutputs pr = \case
+  Restyled results | any restylerCommittedChanges results -> setDifferences pr results
+  _ -> setNoDifferences
+
+setNoDifferences
+  :: (MonadIO m, MonadReader env m, HasGitHubOutput env) => m Bool
+setNoDifferences = False <$ setGitHubOutput "differences" "false"
+
+setDifferences
+  :: (MonadIO m, MonadReader env m, HasGitHubOutput env)
+  => PullRequest
+  -> NonEmpty RestylerResult
+  -> m Bool
+setDifferences pr results =
+  True <$ do
+    setGitHubOutput "differences" "true"
+    setGitHubOutput "restyle-branch-name" $ encodeUtf8 $ "restyled/" <> pr.head.ref
+    setGitHubOutput "restyle-pr-title" $ encodeUtf8 $ "Restyle " <> pr.title
+    setGitHubOutputLn "restyle-pr-body"
+      $ encodeUtf8
+      $ Content.pullRequestDescription Nothing pr.number
+      $ toList results
+
 t :: Text -> Text
 t = id

src/Restyler/RestyledPullRequest.hs

@@ -130,7 +130,10 @@ createRestyledPullRequest pullRequest results = do
   let
     restyledTitle = "Restyle " <> pullRequestTitle pullRequest
     restyledBody =
-      Content.pullRequestDescription mJobUrl pullRequest results
+      Content.pullRequestDescription
+        mJobUrl
+        (unIssueNumber $ pullRequestNumber pullRequest)
+        results
 
   logInfo "Creating Restyled PR"
   restyledPullRequest <-
@@ -189,7 +192,10 @@ updateRestyledPullRequest pullRequest restyledPullRequest results = do
     edit
       { editPullRequestBody =
           Just
-            $ Content.pullRequestDescription mJobUrl pullRequest results
+            $ Content.pullRequestDescription
+              mJobUrl
+              (unIssueNumber $ pullRequestNumber pullRequest)
+              results
       }
 
   logInfo