module Hix.Managed.BuildOutput.GithubActionsPr where

import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import Exon (exon)
import Path (parseAbsFile)
import System.Environment (getEnv)
import System.Posix (epochTime)

import Hix.Data.Error (Error (Client, Fatal))
import Hix.Data.Monad (M)
import Hix.Data.OutputTarget (OutputTarget)
import Hix.Managed.BuildOutput.CommitMsg (commit)
import Hix.Managed.Data.BuildOutput (BuildOutput)
import Hix.Monad (note, throwM, tryIOMAs)
import qualified Hix.OutputWriter
import Hix.OutputWriter (OutputWriter, fileWriter, outputWriterM)

envVarWriter :: M OutputWriter
envVarWriter :: M OutputWriter
envVarWriter = do
  String
var <- Error -> IO String -> M String
forall a. Error -> IO a -> M a
tryIOMAs Error
envVarError (String -> IO String
getEnv String
"GITHUB_OUTPUT")
  Path Abs File
outFile <- Error -> Maybe (Path Abs File) -> M (Path Abs File)
forall a. Error -> Maybe a -> M a
note Error
envVarError (String -> Maybe (Path Abs File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseAbsFile String
var)
  pure ((WriteError -> M ()) -> Path Abs File -> OutputWriter
fileWriter WriteError -> M ()
forall {r} {a}. HasField "msg" r Text => r -> M a
writeError Path Abs File
outFile)
  where
    envVarError :: Error
envVarError = Text -> Error
Client Text
"The variable $GITHUB_OUTPUT does not contain a file path"
    writeError :: r -> M a
writeError r
err = Error -> M a
forall a. Error -> M a
throwM (Text -> Error
Fatal [exon|Couldn't write to $GITHUB_OUTPUT: #{err.msg}|])

formatOutput :: Text -> [Text] -> [Text]
formatOutput :: Text -> [Text] -> [Text]
formatOutput Text
key = \case
  [Item [Text]
value] -> [Item [Text]
[exon|#{key}=#{value}|]]
  [Text]
value -> [exon|#{key}<<EOF|] Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
value [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
Item [Text]
"EOF"]

formatOutputs :: Map Text [Text] -> [Text]
formatOutputs :: Map Text [Text] -> [Text]
formatOutputs =
  ((Text, [Text]) -> [Text]) -> [(Text, [Text])] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Text -> [Text] -> [Text]) -> (Text, [Text]) -> [Text]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> [Text] -> [Text]
formatOutput) ([(Text, [Text])] -> [Text])
-> (Map Text [Text] -> [(Text, [Text])])
-> Map Text [Text]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text [Text] -> [(Text, [Text])]
forall k a. Map k a -> [(k, a)]
Map.toList

writeOutputs :: OutputWriter -> Map Text [Text] -> M ()
writeOutputs :: OutputWriter -> Map Text [Text] -> M ()
writeOutputs OutputWriter
writer Map Text [Text]
values =
  OutputWriter
writer.textAppend ([Text] -> Text
Text.unlines (Map Text [Text] -> [Text]
formatOutputs Map Text [Text]
values))

modifiedOutputs :: Text -> Text -> [Text] -> Map Text [Text]
modifiedOutputs :: Text -> Text -> [Text] -> Map Text [Text]
modifiedOutputs Text
date Text
msg [Text]
body =
  [
    (Text
"branch", [Item [Text]
[exon|hix-managed/bump-#{date}|]]),
    (Text
"commit-message", [Text
Item [Text]
msg, Text
Item [Text]
""] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
body),
    (Text
"title", [Text
Item [Text]
msg]),
    (Text
"body", [Text]
body),
    (Text
"committer", [Text
Item [Text]
"hix <noreply@github.com>"]),
    (Text
"signoff", [Text
Item [Text]
"false"]),
    (Text
"delete-branch", [Text
Item [Text]
"true"])
  ]

githubActionsPr :: BuildOutput -> OutputTarget -> M ()
githubActionsPr :: BuildOutput -> OutputTarget -> M ()
githubActionsPr BuildOutput
output OutputTarget
target =
  Maybe (Text, [Text]) -> ((Text, [Text]) -> M ()) -> M ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (BuildOutput -> Maybe (Text, [Text])
commit BuildOutput
output) \ (Text
msg, [Text]
body) -> do
    EpochTime
date <- IO EpochTime -> M EpochTime
forall a. IO a -> M a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO EpochTime
epochTime
    OutputWriter
writer <- M OutputWriter -> OutputTarget -> M OutputWriter
outputWriterM M OutputWriter
envVarWriter OutputTarget
target
    OutputWriter -> Map Text [Text] -> M ()
writeOutputs OutputWriter
writer (Text -> Text -> [Text] -> Map Text [Text]
modifiedOutputs (EpochTime -> Text
forall b a. (Show a, IsString b) => a -> b
show EpochTime
date) Text
msg [Text]
body)