@@ -0,0 +1,87 @@
1+module Main (main) where
2+
3+import CompaREST.GitHub.API
4+import CompaREST.GitHub.Action.Config
5+import Control.Exception
6+import Control.Monad.Freer
7+import Control.Monad.Freer.Error
8+import Control.Monad.Freer.GitHub
9+import Control.Monad.Freer.Reader
10+import Data.Text (Text)
11+import qualified Data.Yaml.Aeson as Yaml
12+import qualified GitHub as GH
13+import OpenAPI.Checker.Run
14+import System.Environment
15+import System.Envy (decodeEnv)
16+import System.FilePath ((</>))
17+import Text.Pandoc (runPure)
18+import Text.Pandoc.Builder
19+import Text.Pandoc.Options
20+import Text.Pandoc.Writers
21+
22+main :: IO ()
23+main = 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."
32+
33+runner :: Config -> Eff '[GitHub, Error GH.Error, Reader Config, IO] a -> IO a
34+runner cfg =
35+ runM @IO . runReader cfg
36+ . flip (handleError @GH.Error) (error . displayException)
37+ . runGitHub (githubToken cfg)
38+
39+runPre :: Config -> IO ()
40+runPre cfg =
41+ runner cfg $
42+ mapComment
43+ (markdown (header 4 "⏳ Report might not be accurate. Attempting to update." <> horizontalRule) <>)
44+
45+runRun :: Config -> FilePath -> FilePath -> IO ()
46+runRun cfg old' new' = runner cfg $ do
47+ old <- Yaml.decodeFileThrow old'
48+ new <- Yaml.decodeFileThrow new'
49+ let reportConfig =
50+ ReportConfig
51+ { treeStyle = FoldingBlockquotesTreeStyle
52+ , reportMode = All
53+ }
54+ (report, status) = runReport reportConfig (old, new)
55+
56+ summaryDetail s d =
57+ rawHtml "<details>"
58+ <> rawHtml "<summary>"
59+ <> s
60+ <> rawHtml "</summary>"
61+ <> d
62+ <> rawHtml "</details>"
63+ where
64+ rawHtml = rawBlock "html"
65+
66+ message =
67+ header 3 (text $ "⛄ compaREST – " <> projectName cfg)
68+ <> if old == new
69+ then header 1 "✅ The API did not change"
70+ else
71+ header
72+ 1
73+ ( case status of
74+ BreakingChanges -> "⚠️ Breaking changes found!"
75+ NoBreakingChanges -> "No breaking changes found ✨"
76+ OnlyUnsupportedChanges -> "🤷 Couldn't determine compatibility"
77+ )
78+ <> summaryDetail (plain "ℹ️ Details") report
79+ messageBody = markdown message <> "\n\n" <> footerText cfg
80+ createOrUpdateComment messageBody
81+
82+markdown :: Blocks -> Text
83+markdown =
84+ either (error . displayException) id
85+ . runPure
86+ . writeHtml5String def
87+ . doc