compaREST-0.1.0.0: 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.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
  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