git.iko.soy/typeable/compaREST
on 0.1.0.0 help sign in
typeable/compaREST/github-action/Main.hs
66 lines 1.8 kB history raw
1module Main (main) where
3import CompaREST.GitHub.API
4import CompaREST.GitHub.Action.Config
5import Control.Exception
6import Control.Monad.Freer
7import Control.Monad.Freer.Error
8import Control.Monad.Freer.GitHub
9import Control.Monad.Freer.Reader
10import Data.OpenApi.Compare.Run
11import Data.Text (Text)
12import qualified Data.Yaml.Aeson as Yaml
13import qualified GitHub as GH
14import System.Environment
15import System.Envy (decodeEnv)
16import System.FilePath ((</>))
17import Text.Pandoc (runPure)
18import Text.Pandoc.Builder
19import Text.Pandoc.Options
20import Text.Pandoc.Writers
22main :: IO ()
23main = do
24 cfg <- decodeEnv >>= either error pure
25 getArgs >>= \case
26 ["pre"] -> runPre cfg
27 ["run"] -> do
28 oldFile <- getEnv "OLD"
29 newFile <- getEnv "NEW"
30 runRun cfg (root cfg </> oldFile) (root cfg </> newFile)
31 _ -> error "Invalid arguments."
33runner :: Config -> Eff '[GitHub, Error GH.Error, Reader Config, IO] a -> IO a
34runner cfg =
35 runM @IO . runReader cfg
36 . flip (handleError @GH.Error) (error . displayException)
37 . runGitHub (githubToken cfg)
39runPre :: Config -> IO ()
40runPre cfg = runner cfg postStatusProcessing
42runRun :: Config -> FilePath -> FilePath -> IO ()
43runRun cfg old' new' = runner cfg $ do
44 old <- Yaml.decodeFileThrow old'
45 new <- Yaml.decodeFileThrow new'
46 let reportConfig =
47 ReportConfig
48 { treeStyle = FoldingBlockquotesTreeStyle
49 , reportMode = All
50 }
51 (report, status) = runReport reportConfig (old, new)
53 body = markdown report <> "\n\n" <> footerText cfg
55 result =
56 if old == new
57 then Nothing
58 else Just (body, status)
59 postStatus result
61markdown :: Blocks -> Text
62markdown =
63 either (error . displayException) id
64 . runPure
65 . writeHtml5String def
66 . doc