From 3a76b6f0fc0c9c23000dd82870922c885c34ffa6 Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Sun, 3 Dec 2023 15:02:40 +0100 Subject: feat: drop mdcat --- app/Main.hs | 199 +++++++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 145 insertions(+), 54 deletions(-) (limited to 'app/Main.hs') diff --git a/app/Main.hs b/app/Main.hs index bf90a05..c1224f9 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -370,13 +370,14 @@ module Main where +import CMark qualified as D import Control.Applicative ((<|>)) import Control.Monad (when) import Data.Function ((&)) import Data.List (find, intersperse, isPrefixOf) import Data.List.Extra (list) import Data.Map qualified as M -import Data.Maybe (maybeToList) +import Data.Maybe (catMaybes, maybeToList) import Data.Set qualified as S import Data.Text qualified as T import Data.Text.IO qualified as T @@ -678,7 +679,7 @@ main = do es' ) (reverse ess') - Options {colorize, width, command = Show {id = Nothing}} -> do + Options {colorize, noPager, width, command = Show {id = Nothing}} -> do issues <- applySorts [] . applyFilters [] @@ -686,8 +687,8 @@ main = do . (._3) . last <$> getHistory - mapM_ (\issue -> showIssue colorize width issues issue) issues - Options {colorize, width, command = Show {id = Just id, edit}} -> do + mapM_ (\issue -> showIssue colorize noPager width issues issue) issues + Options {colorize, noPager, width, command = Show {id = Just id, edit}} -> do issues <- (._3) . last <$> getHistory issue <- case find ((==) id . T.unpack . I.id) issues of @@ -702,7 +703,7 @@ main = do sh_ (proc "${EDITOR-vi} -- %" fp) I.replaceText issue =<< T.readFile fp else do - showIssue colorize width issues issue + showIssue colorize noPager width issues issue Options {colorize, noPager, width, internalTags, command = Tags} -> do issues <- (._3) . last <$> getHistory let tags = @@ -735,56 +736,146 @@ main = do ) tagsAndValues -showIssue :: Color -> Maybe Int -> [Issue] -> Issue -> IO () -showIssue colorize width issues issue = do +showIssue :: Color -> Bool -> Maybe Int -> [Issue] -> Issue -> IO () +showIssue colorize noPager width issues issue = do let meta = I.getMeta issues issue - -- TODO Make `show` page-able - -- - -- We have to set `noPager` unconditionally to `True` for now, as not - -- all output is `mdcat` compatible. - -- - -- @topic markdown - putDoc colorize True width $ - P.annotate (P.color P.Green) $ - P.pretty $ - issue.file - ++ ":" - ++ show issue.start.row - ++ "\nvia " - ++ T.unpack (C.toText issue.provenance.first.hash) - ++ "\nby " - ++ T.unpack issue.provenance.first.author.name - ++ " <" - ++ T.unpack issue.provenance.first.author.email - ++ ">\nat " - ++ show issue.provenance.first.date - ++ "\n\n" - sh_ - ( ( case width of - Nothing -> "mdcat --local" - Just width' -> proc "mdcat --columns % --local" width' - ) - & P.setStdin (textInput (LT.fromStrict issue.rawText)) - ) - putDoc colorize True width $ - P.pretty $ - "\n@file " - ++ issue.file - ++ "\n@row " - ++ show issue.start.row - ++ "\n" - when (not $ null meta.referencedBy) $ - putDoc colorize True width . P.annotate (P.color P.Black) . P.vsep $ - P.pretty ("" :: T.Text) - : map - ( \(otherIssue, tag) -> - P.pretty ("This commit was referenced by issue " :: T.Text) - <> P.annotate P.bold (P.pretty otherIssue.id) - <> P.pretty (" (" :: T.Text) - <> P.annotate P.bold (P.pretty ("@" <> I.tagKey tag)) - <> P.pretty (")." :: T.Text) - ) - meta.referencedBy + putDoc colorize noPager width $ + P.vsep + [ P.annotate (P.color P.Green) $ + P.pretty $ + issue.file + ++ ":" + ++ show issue.start.row + ++ "\nvia " + ++ T.unpack (C.toText issue.provenance.first.hash) + ++ "\nby " + ++ T.unpack issue.provenance.first.author.name + ++ " <" + ++ T.unpack issue.provenance.first.author.email + ++ ">\nat " + ++ show issue.provenance.first.date + ++ "\n\n", + render (D.commonmarkToNode [] issue.rawText), + P.pretty $ + "\n@file " + ++ issue.file + ++ "\n@row " + ++ show issue.start.row + ++ "\n", + if (not $ null meta.referencedBy) + then + P.annotate (P.color P.Black) . P.vsep $ + P.pretty ("" :: T.Text) + : map + ( \(otherIssue, tag) -> + P.pretty ("This commit was referenced by issue " :: T.Text) + <> P.annotate P.bold (P.pretty otherIssue.id) + <> P.pretty (" (" :: T.Text) + <> P.annotate P.bold (P.pretty ("@" <> I.tagKey tag)) + <> P.pretty (")." :: T.Text) + ) + meta.referencedBy + else P.emptyDoc + ] + +render = maybe P.emptyDoc go . rec + where + rec (D.Node _ D.SOFTBREAK _) = Nothing + rec (D.Node _ D.THEMATIC_BREAK _) = Nothing + rec (D.Node p t ns) = Just $ D.Node p t (catMaybes $ map rec ns) + + go (D.Node _ D.DOCUMENT ns) = P.vsep (map go ns) + go (D.Node _ D.PARAGRAPH ns) = + P.hsep $ + map go ns + ++ [P.pretty ("\n" :: T.Text)] + go (D.Node _ D.BLOCK_QUOTE ns) = + P.annotate (P.color P.Black) . P.hsep $ + P.pretty (">" :: T.Text) + : [ P.align . P.hsep $ + map go ns + ++ [P.pretty ("\n" :: T.Text)] + ] + go (D.Node _ (D.HTML_BLOCK s) ns) = + P.annotate (P.color P.Green) $ + P.hsep + [ P.pretty (T.strip s), + P.pretty ("\n" :: T.Text) + ] + go (D.Node _ (D.CUSTOM_BLOCK _ _) ns) = + P.annotate (P.color P.Green) $ + P.hsep $ + map go ns + ++ [P.pretty ("\n" :: T.Text)] + go (D.Node _ (D.CODE_BLOCK _ s) ns) = + P.annotate (P.color P.Green) $ + P.hsep + [ P.pretty (T.strip s), + P.pretty ("\n" :: T.Text) + ] + go (D.Node _ (D.HEADING c) ns) = + P.annotate (P.color P.Magenta) . P.hsep $ + P.pretty (T.replicate c "#") + : map go ns + ++ [P.pretty ("\n" :: T.Text)] + go (D.Node _ (D.LIST as) ns) = + P.hsep (map ((P.pretty ("- " :: T.Text)) <>) (map go ns)) + go (D.Node _ D.ITEM ns) = P.hsep (map go ns) + go (D.Node _ (D.TEXT s) ns) = + P.hcat + . intersperse P.softline + . map (P.pretty . T.strip) + $ T.words s + go (D.Node _ D.LINEBREAK _) = P.hardline + go (D.Node _ (D.HTML_INLINE s) _) = + P.annotate (P.color P.Green) $ P.pretty (T.strip s) + go (D.Node _ (D.CUSTOM_INLINE _ _) ns) = + P.annotate (P.color P.Green) . P.hsep $ map go ns + go (D.Node _ (D.CODE s) _) = + P.annotate (P.color P.Green) $ P.pretty (T.strip s) + go (D.Node _ D.EMPH ns) = P.annotate P.italicized $ P.hsep (map go ns) + go (D.Node _ D.STRONG ns) = P.annotate P.bold $ P.hsep (map go ns) + go (D.Node _ D.SOFTBREAK _) = P.emptyDoc + go (D.Node _ (D.LINK url "") ns) = + P.annotate (P.color P.Blue) $ + P.hcat + [ P.pretty ("[" :: T.Text), + P.hsep (map go ns), + P.pretty ("](" :: T.Text), + P.pretty url, + P.pretty (")" :: T.Text) + ] + go (D.Node _ (D.LINK url title) ns) = + P.annotate (P.color P.Blue) $ + P.hcat + [ P.pretty ("[" :: T.Text), + P.hsep (map go ns), + P.pretty ("](" :: T.Text), + P.pretty url, + P.pretty (" \"" :: T.Text), + P.pretty title, + P.pretty ("\")" :: T.Text) + ] + go (D.Node _ (D.IMAGE url "") ns) = + P.annotate (P.color P.Blue) $ + P.hcat + [ P.pretty ("![" :: T.Text), + P.hsep (map go ns), + P.pretty ("](" :: T.Text), + P.pretty url, + P.pretty (")" :: T.Text) + ] + go (D.Node _ (D.IMAGE url title) ns) = + P.annotate (P.color P.Blue) $ + P.hcat + [ P.pretty ("![" :: T.Text), + P.hsep (map go ns), + P.pretty ("](" :: T.Text), + P.pretty url, + P.pretty (" \"" :: T.Text), + P.pretty title, + P.pretty ("\")" :: T.Text) + ] applyClosed :: Bool -> [Issue] -> [Issue] applyClosed closed = filter (\issue -> closed || not issue.closed) -- cgit v1.2.3