compaREST-0.1.0.1: github-action/Main.hs

module Main (main) where

import CompaREST.GitHub.API
import CompaREST.GitHub.Action.Config
import Control.Exception
import Control.Monad.Freer
import Control.Monad.Freer.Error
import Control.Monad.Freer.GitHub
import Control.Monad.Freer.Reader
import Data.OpenApi.Compare.Run
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Yaml.Aeson as Yaml
import qualified GitHub as GH
import System.Environment
import System.Envy (decodeEnv)
import System.FilePath ((</>))
import Text.Pandoc (runPure)
import Text.Pandoc.Builder
import Text.Pandoc.Options
import Text.Pandoc.Writers

main :: IO ()
main = do
  cfg <- decodeEnv >>= either error pure
  case sha cfg of
    x | T.null . T.strip . GH.untagName $ x -> do
      putStrLn "SHA not specified. Exiting without doing anything."
      pure ()
    _ ->
      getArgs >>= \case
        ["pre"] -> runPre cfg
        ["run"] -> do
          oldFile <- getEnv "OLD"
          newFile <- getEnv "NEW"
          runRun cfg (root cfg </> oldFile) (root cfg </> newFile)
        _ -> error "Invalid arguments."

runner :: Config -> Eff '[GitHub, Error GH.Error, Reader Config, IO] a -> IO a
runner cfg =
  runM @IO . runReader cfg
    . flip (handleError @GH.Error) (error . displayException)
    . runGitHub (githubToken cfg)

runPre :: Config -> IO ()
runPre cfg = runner cfg postStatusProcessing

runRun :: Config -> FilePath -> FilePath -> IO ()
runRun cfg old' new' = runner cfg $ do
  old <- Yaml.decodeFileThrow old'
  new <- Yaml.decodeFileThrow new'
  let reportConfig =
        ReportConfig
          { treeStyle = FoldingBlockquotesTreeStyle
          , reportMode = All
          }
      (report, status) = runReport reportConfig (old, new)

      body = markdown report <> "\n\n" <> footerText cfg

      result =
        if old == new
          then Nothing
          else Just (body, status)
  postStatus result

markdown :: Blocks -> Text
markdown =
  either (error . displayException) id
    . runPure
    . writeHtml5String def
    . doc