38341ca · typeable/compaREST

.github/workflows/haskell.yml+2

compare with master

unifiedsplit

@@ -12,6 +12,8 @@ jobs:

12

13 steps:

14 - uses: actions/checkout@v2

15+ with:

16+ submodules: recursive

15 - name: Cache

17 - name: Cache

16 uses: actions/cache@v1

18 uses: actions/cache@v1

17 with:

19 with:

.gitmodulesnew file+3

@@ -0,0 +1,3 @@

1+[submodule "awsm-css"]

2+ path = awsm-css

3+ url = https://github.com/igoradamenko/awsm.css.git

app/FormatHeuristic.hs+76−53

@@ -6,64 +6,87 @@ module FormatHeuristic

6 )

7where

8

9+import Data.ByteString.Lazy (ByteString)

9import Data.Char (toLower)

10import Data.Char (toLower)

11+import Data.Functor

12+import qualified Data.Map as M

13+import Data.Text (Text)

14+import qualified Data.Text.Lazy as TL

15+import qualified Data.Text.Lazy.Encoding as TL

16+import qualified OpenAPI.Checker.Report.Html.Template as Html

10import System.FilePath (takeExtension)

17import System.FilePath (takeExtension)

18+import Text.DocTemplates.Internal

11import Text.Pandoc

19import Text.Pandoc

12

20

13−formatFromFilePath :: PandocMonad m => FilePath -> Maybe (Writer m)

21+formatFromFilePath :: forall m. PandocMonad m => FilePath -> Maybe (Pandoc -> m ByteString)

14formatFromFilePath x =

22formatFromFilePath x =

15 case takeExtension (map toLower x) of

23 case takeExtension (map toLower x) of

16− ".adoc" -> f "asciidoc"

24+ ".adoc" -> f "asciidoc" def

17− ".asciidoc" -> f "asciidoc"

25+ ".asciidoc" -> f "asciidoc" def

18− ".context" -> f "context"

26+ ".context" -> f "context" def

19− ".ctx" -> f "context"

27+ ".ctx" -> f "context" def

20− ".db" -> f "docbook"

28+ ".db" -> f "docbook" def

21− ".doc" -> f "doc" -- so we get an "unknown reader" error

29+ ".doc" -> f "doc" def -- so we get an "unknown reader" error

22− ".docx" -> f "docx"

30+ ".docx" -> f "docx" def

23− ".dokuwiki" -> f "dokuwiki"

31+ ".dokuwiki" -> f "dokuwiki" def

24− ".epub" -> f "epub"

32+ ".epub" -> f "epub" def

25− ".fb2" -> f "fb2"

33+ ".fb2" -> f "fb2" def

26− ".htm" -> f "html"

34+ ".htm" -> html

27− ".html" -> f "html"

35+ ".html" -> html

28− ".icml" -> f "icml"

36+ ".icml" -> f "icml" def

29− ".json" -> f "json"

37+ ".json" -> f "json" def

30− ".latex" -> f "latex"

38+ ".latex" -> f "latex" def

31− ".lhs" -> f "markdown+lhs"

39+ ".lhs" -> f "markdown+lhs" def

32− ".ltx" -> f "latex"

40+ ".ltx" -> f "latex" def

33− ".markdown" -> f "markdown"

41+ ".markdown" -> markdown

34− ".mkdn" -> f "markdown"

42+ ".mkdn" -> markdown

35− ".mkd" -> f "markdown"

43+ ".mkd" -> markdown

36− ".mdwn" -> f "markdown"

44+ ".mdwn" -> markdown

37− ".mdown" -> f "markdown"

45+ ".mdown" -> markdown

38− ".Rmd" -> f "markdown"

46+ ".Rmd" -> markdown

39− ".md" -> f "markdown"

47+ ".md" -> markdown

40− ".ms" -> f "ms"

48+ ".ms" -> f "ms" def

41− ".muse" -> f "muse"

49+ ".muse" -> f "muse" def

42− ".native" -> f "native"

50+ ".native" -> f "native" def

43− ".odt" -> f "odt"

51+ ".odt" -> f "odt" def

44− ".opml" -> f "opml"

52+ ".opml" -> f "opml" def

45− ".org" -> f "org"

53+ ".org" -> f "org" def

46− ".pdf" -> f "pdf" -- so we get an "unknown reader" error

54+ -- so we get an "unknown reader" error

55+ ".pdf" -> f "pdf" def

47− ".pptx" -> f "pptx"

56+ ".pptx" -> f "pptx" def

48− ".roff" -> f "ms"

57+ ".roff" -> f "ms" def

49− ".rst" -> f "rst"

58+ ".rst" -> f "rst" def

50− ".rtf" -> f "rtf"

59+ ".rtf" -> f "rtf" def

51− ".s5" -> f "s5"

60+ ".s5" -> f "s5" def

52− ".t2t" -> f "t2t"

61+ ".t2t" -> f "t2t" def

53− ".tei" -> f "tei"

62+ ".tei" -> f "tei" def

54− ".tei.xml" -> f "tei"

63+ ".tei.xml" -> f "tei" def

55− ".tex" -> f "latex"

64+ ".tex" -> f "latex" def

56− ".texi" -> f "texinfo"

65+ ".texi" -> f "texinfo" def

57− ".texinfo" -> f "texinfo"

66+ ".texinfo" -> f "texinfo" def

58− ".text" -> f "markdown"

67+ ".text" -> markdown

59− ".textile" -> f "textile"

68+ ".textile" -> f "textile" def

60− ".txt" -> f "markdown"

69+ ".txt" -> markdown

61− ".wiki" -> f "mediawiki"

70+ ".wiki" -> f "mediawiki" def

62− ".xhtml" -> f "html"

71+ ".xhtml" -> f "html" def

63− ".ipynb" -> f "ipynb"

72+ ".ipynb" -> f "ipynb" def

64− ".csv" -> f "csv"

73+ ".csv" -> f "csv" def

65− ".bib" -> f "biblatex"

74+ ".bib" -> f "biblatex" def

66− ['.', y] | y `elem` ['1' .. '9'] -> f "man"

75+ ['.', y] | y `elem` ['1' .. '9'] -> f "man" def

67 _ -> Nothing

76 _ -> Nothing

68 where

77 where

78+ markdown, html :: Maybe (Pandoc -> m ByteString)

79+ markdown = f "markdown" markdownOpt

80+ html =

81+ f

82+ "html"

83+ def

84+ { writerTemplate = Just Html.template

85+ , -- Not actually used. Needed to silence warning.

86+ writerVariables = Context $ M.fromList [("pagetitle", toVal ("OpenApi Diff" :: Text))]

87+ }

88+ markdownOpt = def {writerExtensions = githubMarkdownExtensions}

89+ f k opt =

69− f k = lookup k writers

90+ lookup k writers <&> \case

91+ TextWriter g -> fmap (TL.encodeUtf8 . TL.fromStrict) . g opt

92+ ByteStringWriter g -> g opt

app/Main.hs+1−5

@@ -38,11 +38,7 @@ main = do

38 StdoutMode -> lift . T.putStrLn <=< runPandocIO . writeMarkdown options

39 FileMode f -> case formatFromFilePath f of

40 Nothing -> \_ -> throwError UnknownOutputFormat

41− Just (TextWriter writer) -> lift . T.writeFile f <=< runPandocIO . writer options

42− Just (ByteStringWriter writer) -> lift . BSL.writeFile f <=< runPandocIO . writer options

41+ Just writer -> lift . BSL.writeFile f <=< runPandocIO . writer

43− -- output :: Either (PathsPrefixTree Behave AnIssue 'APILevel) () -> ExceptT Errors IO ()

44− -- output inp = do

45− -- undefined

46 (report, status) = runReport (a, b)

42 (report, status) = runReport (a, b)

47 either handler pure <=< runExceptT $ write report

43 either handler pure <=< runExceptT $ write report

48 case status of

44 case status of

awsm-cssnew file+1

Submodule changed.

openapi-diff.cabal+5−1

@@ -105,6 +105,8 @@ library

105 , mtl

106 , aeson

107 , generic-data

108+ , doctemplates

109+ , file-embed

108 hs-source-dirs: src

110 hs-source-dirs: src

109 exposed-modules: Data.HList

111 exposed-modules: Data.HList

110 , OpenAPI.Checker.Behavior

112 , OpenAPI.Checker.Behavior

@@ -136,6 +138,7 @@ library

136 , Data.OpenUnion.Extra

138 , Data.OpenUnion.Extra

137 , OpenAPI.Checker.Report.Jet

139 , OpenAPI.Checker.Report.Jet

138 , OpenAPI.Checker.Run

140 , OpenAPI.Checker.Run

141+ , OpenAPI.Checker.Report.Html.Template

139

142

140executable openapi-diff

143executable openapi-diff

141 import: common-options

144 import: common-options

@@ -151,6 +154,8 @@ executable openapi-diff

151 , optparse-applicative

154 , optparse-applicative

152 , mtl

155 , mtl

153 , aeson

156 , aeson

157+ , containers

158+ , doctemplates

154 ghc-options: -threaded

159 ghc-options: -threaded

155 -rtsopts

160 -rtsopts

156 -with-rtsopts=-N

161 -with-rtsopts=-N

@@ -177,7 +182,6 @@ test-suite openapi-diff-test

177 , pandoc

182 , pandoc

178 , data-default

183 , data-default

179 , lens

184 , lens

180− , openapi3

181 ghc-options: -threaded

185 ghc-options: -threaded

182 -rtsopts

186 -rtsopts

183 -with-rtsopts=-N

187 -with-rtsopts=-N

src/OpenAPI/Checker/Report.hs+22−18

@@ -148,28 +148,32 @@ smartHeader i = do

148showErrs :: forall a. Typeable a => ProcessedChanges a -> ReportMonad ()

149showErrs x@(P.PathsPrefixNode currentIssues _) = do

150 let -- Extract this pattern if more cases like this arise

151− ( removedPaths :: [Issue 'APILevel]

151+ ( removedPaths :: Maybe (Orientation, [Issue 'APILevel])

152 , otherIssues :: Set (FunctorTuple (Const Orientation) AnIssue a)

153 ) = case eqT @a @'APILevel of

154− Just Refl ->

154+ Just Refl

155− let (p, o) =

155+ | (S.toList -> p@(FunctorTuple (Const ori) _ : _), o) <-

156− S.partition

156+ S.partition

157− (\(FunctorTuple _ (AnIssue u)) -> case u of

157+ (\(FunctorTuple _ (AnIssue u)) -> case u of

158− NoPathsMatched {} -> True

158+ NoPathsMatched {} -> True

159− AllPathsFailed {} -> True)

159+ AllPathsFailed {} -> True)

160− currentIssues

160+ currentIssues ->

161− p' = S.toList p <&> (\(FunctorTuple _ (AnIssue i)) -> i)

161+ let p' = p <&> (\(FunctorTuple _ (AnIssue i)) -> i)

162− in (p', o)

162+ in (Just (ori, p'), o)

163− Nothing -> (mempty, currentIssues)

163+ _ -> (Nothing, currentIssues)

164 jts <- asks sourceJets

165 for_ otherIssues $ \(FunctorTuple (Const ori) (AnIssue i)) -> tell . describeIssue ori $ i

166− unless ([] == removedPaths) $ do

166+ case removedPaths of

167+ Just (ori, paths) -> do

168+ smartHeader $ case ori of

167− smartHeader "Removed paths"

169+ Forward -> "Removed paths"

170+ Backward -> "Added paths"

168− tell $

171+ tell $

169− bulletList $

172+ bulletList $

170− removedPaths <&> \case

173+ paths <&> \case

171− (NoPathsMatched p) -> para . code $ T.pack p

174+ (NoPathsMatched p) -> para . code $ T.pack p

172− (AllPathsFailed p) -> para . code $ T.pack p

175+ (AllPathsFailed p) -> para . code $ T.pack p

176+ Nothing -> pure ()

173 unfoldM x (observeJetShowErrs <$> jts) $ \(P.PathsPrefixNode _ subIssues) -> do

177 unfoldM x (observeJetShowErrs <$> jts) $ \(P.PathsPrefixNode _ subIssues) -> do

174 for_ subIssues $ \(WrapTypeable (AStep m)) ->

178 for_ subIssues $ \(WrapTypeable (AStep m)) ->

175 for_ (M.toList m) $ \(bhv, subErrors) -> do

179 for_ (M.toList m) $ \(bhv, subErrors) -> do

src/OpenAPI/Checker/Report/Html/Template.hsnew file+39

@@ -0,0 +1,39 @@

1+{-# LANGUAGE TemplateHaskell #-}

2+

3+module OpenAPI.Checker.Report.Html.Template

4+ ( template

5+ )

6+where

7+

8+import Control.Monad.Identity

9+import Data.ByteString (ByteString)

10+import Data.FileEmbed

11+import Data.Text (Text)

12+import qualified Data.Text.Encoding as T

13+import Text.DocTemplates

14+

15+template :: Template Text

16+template =

17+ either error id . runIdentity . compileTemplate "" $

18+ "<!doctype html>\

19+ \<html lang=\"en\">\

20+ \<head>\

21+ \<style>"

22+ <> T.decodeUtf8 awsmCss

23+ <> "</style>\

24+ \<meta charset=\"utf-8\">\

25+ \<title></title>\

26+ \<meta name=\"description\" content=\"\">\

27+ \<meta name=\"generator\" content=\"OpenApi Diff\" />\

28+ \<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0, user-scalable=yes\" />\

29+ \</head>\

30+ \<body>\

31+ \<header><h1>⛄ OpenApi Diff</h1></header>\

32+ \<main>\

33+ \$body$\

34+ \</main>\

35+ \</body>\

36+ \</html>"

37+

38+awsmCss :: ByteString

39+awsmCss = $(makeRelativeToProject "awsm-css/dist/awsm.min.css" >>= embedFile)