aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--app/Main.hs199
-rw-r--r--default.nix1
2 files changed, 145 insertions, 55 deletions
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)
diff --git a/default.nix b/default.nix
index 39a79f8..44a461a 100644
--- a/default.nix
+++ b/default.nix
@@ -22,7 +22,6 @@ let
dependencies = [
pkgs.coreutils
pkgs.git
- pkgs.mdcat
pkgs.tree-grepper
];
};
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-23 09:38:09 +0000