git.iko.soy/typeable/compaREST
on master help sign in
typeable/compaREST/github-action/Main.hs
72 lines 2.0 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.Text as T
13import qualified Data.Yaml.Aeson as Yaml
14import qualified GitHub as GH
15import System.Environment
16import System.Envy (decodeEnv)
17import System.FilePath ((</>))
18import Text.Pandoc (runPure)
19import Text.Pandoc.Builder
20import Text.Pandoc.Options
21import Text.Pandoc.Writers
23main :: IO ()
24main = do
25 cfg <- decodeEnv >>= either error pure
26 case sha cfg of
27 x | T.null . T.strip . GH.untagName $ x -> do
28 putStrLn "SHA not specified. Exiting without doing anything."
29 pure ()
30 _ ->
31 getArgs >>= \case
32 ["pre"] -> runPre cfg
33 ["run"] -> do
34 oldFile <- getEnv "OLD"
35 newFile <- getEnv "NEW"
36 runRun cfg (root cfg </> oldFile) (root cfg </> newFile)
37 _ -> error "Invalid arguments."
39runner :: Config -> Eff '[GitHub, Error GH.Error, Reader Config, IO] a -> IO a
40runner cfg =
41 runM @IO . runReader cfg
42 . flip (handleError @GH.Error) (error . displayException)
43 . runGitHub (githubToken cfg)
45runPre :: Config -> IO ()
46runPre cfg = runner cfg postStatusProcessing
48runRun :: Config -> FilePath -> FilePath -> IO ()
49runRun cfg old' new' = runner cfg $ do
50 old <- Yaml.decodeFileThrow old'
51 new <- Yaml.decodeFileThrow new'
52 let reportConfig =
53 ReportConfig
54 { treeStyle = FoldingBlockquotesTreeStyle
55 , reportMode = All
56 }
57 (report, status) = runReport reportConfig (old, new)
59 body = markdown report <> "\n\n" <> footerText cfg
61 result =
62 if old == new
63 then Nothing
64 else Just (body, status)
65 postStatus result
67markdown :: Blocks -> Text
68markdown =
69 either (error . displayException) id
70 . runPure
71 . writeHtml5String def
72 . doc