Added styling to HTML output (#84)

* Added html template * added awsm.css submodule * Embed styling * Removed extra dependency * checkout submodules on CI * Fixed wording * Rmoved file
2024-12-26 04:33:11 +03:00 · 2021-06-22 17:15:57 +03:00 · 2021-06-22 17:15:57 +03:00 · 38341ca51f
commit 38341ca51f
parent 2440f23829
8 changed files with 149 additions and 77 deletions
--- a/.github/workflows/haskell.yml
+++ b/.github/workflows/haskell.yml
@ -12,6 +12,8 @@ jobs:

    steps:
      - uses: actions/checkout@v2
+        with:
+          submodules: recursive
      - name: Cache
        uses: actions/cache@v1
        with:
--- a/.gitmodules
+++ b/.gitmodules
@ -0,0 +1,3 @@
+[submodule "awsm-css"]
+	path = awsm-css
+	url = https://github.com/igoradamenko/awsm.css.git
--- a/app/FormatHeuristic.hs
+++ b/app/FormatHeuristic.hs
@ -6,64 +6,87 @@ module FormatHeuristic
  )
 where

+import Data.ByteString.Lazy (ByteString)
 import Data.Char (toLower)
+import Data.Functor
+import qualified Data.Map as M
+import Data.Text (Text)
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TL
+import qualified OpenAPI.Checker.Report.Html.Template as Html
 import System.FilePath (takeExtension)
+import Text.DocTemplates.Internal
 import Text.Pandoc

-formatFromFilePath :: PandocMonad m => FilePath -> Maybe (Writer m)
+formatFromFilePath :: forall m. PandocMonad m => FilePath -> Maybe (Pandoc -> m ByteString)
 formatFromFilePath x =
  case takeExtension (map toLower x) of
-    ".adoc" -> f "asciidoc"
-    ".asciidoc" -> f "asciidoc"
-    ".context" -> f "context"
-    ".ctx" -> f "context"
-    ".db" -> f "docbook"
-    ".doc" -> f "doc" -- so we get an "unknown reader" error
-    ".docx" -> f "docx"
-    ".dokuwiki" -> f "dokuwiki"
-    ".epub" -> f "epub"
-    ".fb2" -> f "fb2"
-    ".htm" -> f "html"
-    ".html" -> f "html"
-    ".icml" -> f "icml"
-    ".json" -> f "json"
-    ".latex" -> f "latex"
-    ".lhs" -> f "markdown+lhs"
-    ".ltx" -> f "latex"
-    ".markdown" -> f "markdown"
-    ".mkdn" -> f "markdown"
-    ".mkd" -> f "markdown"
-    ".mdwn" -> f "markdown"
-    ".mdown" -> f "markdown"
-    ".Rmd" -> f "markdown"
-    ".md" -> f "markdown"
-    ".ms" -> f "ms"
-    ".muse" -> f "muse"
-    ".native" -> f "native"
-    ".odt" -> f "odt"
-    ".opml" -> f "opml"
-    ".org" -> f "org"
-    ".pdf" -> f "pdf" -- so we get an "unknown reader" error
-    ".pptx" -> f "pptx"
-    ".roff" -> f "ms"
-    ".rst" -> f "rst"
-    ".rtf" -> f "rtf"
-    ".s5" -> f "s5"
-    ".t2t" -> f "t2t"
-    ".tei" -> f "tei"
-    ".tei.xml" -> f "tei"
-    ".tex" -> f "latex"
-    ".texi" -> f "texinfo"
-    ".texinfo" -> f "texinfo"
-    ".text" -> f "markdown"
-    ".textile" -> f "textile"
-    ".txt" -> f "markdown"
-    ".wiki" -> f "mediawiki"
-    ".xhtml" -> f "html"
-    ".ipynb" -> f "ipynb"
-    ".csv" -> f "csv"
-    ".bib" -> f "biblatex"
-    ['.', y] | y `elem` ['1' .. '9'] -> f "man"
+    ".adoc" -> f "asciidoc" def
+    ".asciidoc" -> f "asciidoc" def
+    ".context" -> f "context" def
+    ".ctx" -> f "context" def
+    ".db" -> f "docbook" def
+    ".doc" -> f "doc" def -- so we get an "unknown reader" error
+    ".docx" -> f "docx" def
+    ".dokuwiki" -> f "dokuwiki" def
+    ".epub" -> f "epub" def
+    ".fb2" -> f "fb2" def
+    ".htm" -> html
+    ".html" -> html
+    ".icml" -> f "icml" def
+    ".json" -> f "json" def
+    ".latex" -> f "latex" def
+    ".lhs" -> f "markdown+lhs" def
+    ".ltx" -> f "latex" def
+    ".markdown" -> markdown
+    ".mkdn" -> markdown
+    ".mkd" -> markdown
+    ".mdwn" -> markdown
+    ".mdown" -> markdown
+    ".Rmd" -> markdown
+    ".md" -> markdown
+    ".ms" -> f "ms" def
+    ".muse" -> f "muse" def
+    ".native" -> f "native" def
+    ".odt" -> f "odt" def
+    ".opml" -> f "opml" def
+    ".org" -> f "org" def
+    -- so we get an "unknown reader" error
+    ".pdf" -> f "pdf" def
+    ".pptx" -> f "pptx" def
+    ".roff" -> f "ms" def
+    ".rst" -> f "rst" def
+    ".rtf" -> f "rtf" def
+    ".s5" -> f "s5" def
+    ".t2t" -> f "t2t" def
+    ".tei" -> f "tei" def
+    ".tei.xml" -> f "tei" def
+    ".tex" -> f "latex" def
+    ".texi" -> f "texinfo" def
+    ".texinfo" -> f "texinfo" def
+    ".text" -> markdown
+    ".textile" -> f "textile" def
+    ".txt" -> markdown
+    ".wiki" -> f "mediawiki" def
+    ".xhtml" -> f "html" def
+    ".ipynb" -> f "ipynb" def
+    ".csv" -> f "csv" def
+    ".bib" -> f "biblatex" def
+    ['.', y] | y `elem` ['1' .. '9'] -> f "man" def
    _ -> Nothing
  where
-    f k = lookup k writers
+    markdown, html :: Maybe (Pandoc -> m ByteString)
+    markdown = f "markdown" markdownOpt
+    html =
+      f
+        "html"
+        def
+          { writerTemplate = Just Html.template
+          , -- Not actually used. Needed to silence warning.
+            writerVariables = Context $ M.fromList [("pagetitle", toVal ("OpenApi Diff" :: Text))]
+          }
+    markdownOpt = def {writerExtensions = githubMarkdownExtensions}
+    f k opt =
+      lookup k writers <&> \case
+        TextWriter g -> fmap (TL.encodeUtf8 . TL.fromStrict) . g opt
+        ByteStringWriter g -> g opt
--- a/app/Main.hs
+++ b/app/Main.hs
@ -38,11 +38,7 @@ main = do
        StdoutMode -> lift . T.putStrLn <=< runPandocIO . writeMarkdown options
        FileMode f -> case formatFromFilePath f of
          Nothing -> \_ -> throwError UnknownOutputFormat
-          Just (TextWriter writer) -> lift . T.writeFile f <=< runPandocIO . writer options
-          Just (ByteStringWriter writer) -> lift . BSL.writeFile f <=< runPandocIO . writer options
-      -- output :: Either (PathsPrefixTree Behave AnIssue 'APILevel) () -> ExceptT Errors IO ()
-      -- output inp = do
-      --   undefined
+          Just writer -> lift . BSL.writeFile f <=< runPandocIO . writer
      (report, status) = runReport (a, b)
  either handler pure <=< runExceptT $ write report
  case status of
--- a/1
+++ b/1
@ -0,0 +1 @@
+Subproject commit ad03dcf22f6348d9c179cc5d0f82fe5d6b5961d4
--- a/openapi-diff.cabal
+++ b/openapi-diff.cabal
@ -105,6 +105,8 @@ library
                     , mtl
                     , aeson
                     , generic-data
+                     , doctemplates
+                     , file-embed
  hs-source-dirs:      src
  exposed-modules:  Data.HList
                  , OpenAPI.Checker.Behavior
@ -136,6 +138,7 @@ library
                  , Data.OpenUnion.Extra
                  , OpenAPI.Checker.Report.Jet
                  , OpenAPI.Checker.Run
+                  , OpenAPI.Checker.Report.Html.Template

 executable openapi-diff
  import:              common-options
@ -151,6 +154,8 @@ executable openapi-diff
    , optparse-applicative
    , mtl
    , aeson
+    , containers
+    , doctemplates
  ghc-options:         -threaded
                       -rtsopts
                       -with-rtsopts=-N
@ -177,7 +182,6 @@ test-suite openapi-diff-test
    , pandoc
    , data-default
    , lens
-    , openapi3
  ghc-options:         -threaded
                       -rtsopts
                       -with-rtsopts=-N
--- a/src/OpenAPI/Checker/Report.hs
+++ b/src/OpenAPI/Checker/Report.hs
@ -148,28 +148,32 @@ smartHeader i = do
 showErrs :: forall a. Typeable a => ProcessedChanges a -> ReportMonad ()
 showErrs x@(P.PathsPrefixNode currentIssues _) = do
  let -- Extract this pattern if more cases like this arise
-      ( removedPaths :: [Issue 'APILevel]
+      ( removedPaths :: Maybe (Orientation, [Issue 'APILevel])
        , otherIssues :: Set (FunctorTuple (Const Orientation) AnIssue a)
        ) = case eqT @a @'APILevel of
-          Just Refl ->
-            let (p, o) =
-                  S.partition
-                    (\(FunctorTuple _ (AnIssue u)) -> case u of
-                       NoPathsMatched {} -> True
-                       AllPathsFailed {} -> True)
-                    currentIssues
-                p' = S.toList p <&> (\(FunctorTuple _ (AnIssue i)) -> i)
-             in (p', o)
-          Nothing -> (mempty, currentIssues)
+          Just Refl
+            | (S.toList -> p@(FunctorTuple (Const ori) _ : _), o) <-
+                S.partition
+                  (\(FunctorTuple _ (AnIssue u)) -> case u of
+                     NoPathsMatched {} -> True
+                     AllPathsFailed {} -> True)
+                  currentIssues ->
+              let p' = p <&> (\(FunctorTuple _ (AnIssue i)) -> i)
+               in (Just (ori, p'), o)
+          _ -> (Nothing, currentIssues)
  jts <- asks sourceJets
  for_ otherIssues $ \(FunctorTuple (Const ori) (AnIssue i)) -> tell . describeIssue ori $ i
-  unless ([] == removedPaths) $ do
-    smartHeader "Removed paths"
-    tell $
-      bulletList $
-        removedPaths <&> \case
-          (NoPathsMatched p) -> para . code $ T.pack p
-          (AllPathsFailed p) -> para . code $ T.pack p
+  case removedPaths of
+    Just (ori, paths) -> do
+      smartHeader $ case ori of
+        Forward -> "Removed paths"
+        Backward -> "Added paths"
+      tell $
+        bulletList $
+          paths <&> \case
+            (NoPathsMatched p) -> para . code $ T.pack p
+            (AllPathsFailed p) -> para . code $ T.pack p
+    Nothing -> pure ()
  unfoldM x (observeJetShowErrs <$> jts) $ \(P.PathsPrefixNode _ subIssues) -> do
    for_ subIssues $ \(WrapTypeable (AStep m)) ->
      for_ (M.toList m) $ \(bhv, subErrors) -> do
--- a/src/OpenAPI/Checker/Report/Html/Template.hs
+++ b/src/OpenAPI/Checker/Report/Html/Template.hs
@ -0,0 +1,39 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module OpenAPI.Checker.Report.Html.Template
+  ( template
+  )
+where
+
+import Control.Monad.Identity
+import Data.ByteString (ByteString)
+import Data.FileEmbed
+import Data.Text (Text)
+import qualified Data.Text.Encoding as T
+import Text.DocTemplates
+
+template :: Template Text
+template =
+  either error id . runIdentity . compileTemplate "" $
+    "<!doctype html>\
+    \<html lang=\"en\">\
+    \<head>\
+    \<style>"
+      <> T.decodeUtf8 awsmCss
+      <> "</style>\
+         \<meta charset=\"utf-8\">\
+         \<title></title>\
+         \<meta name=\"description\" content=\"\">\
+         \<meta name=\"generator\" content=\"OpenApi Diff\" />\
+         \<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0, user-scalable=yes\" />\
+         \</head>\
+         \<body>\
+         \<header><h1>⛄ OpenApi Diff</h1></header>\
+         \<main>\
+         \$body$\
+         \</main>\
+         \</body>\
+         \</html>"
+
+awsmCss :: ByteString
+awsmCss = $(makeRelativeToProject "awsm-css/dist/awsm.min.css" >>= embedFile)
				`@ -0,0 +1 @@`
				`Subproject commit ad03dcf22f6348d9c179cc5d0f82fe5d6b5961d4`