From c64a7e5285bb119927c8cb1136db60c6ffa77220 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Tue, 7 Nov 2023 22:26:58 +0100
Subject: add `tags` command

---
 app/Main.hs | 56 +++++++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 41 insertions(+), 15 deletions(-)

(limited to 'app')

diff --git a/app/Main.hs b/app/Main.hs
index 9cb90ca..6f754da 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -336,20 +336,6 @@
 -- @topic rendering
 -- @topic options
 
--- TODO Add command for listing all topics
---
--- Running `anissue topics` should list all topics including the amount of
--- issues tagged with them.  By default the list should be ordered with the
--- topics first which have the most issues.
---
--- @difficulty easy
---
--- COMMENT Maybe `anissue tags @topic` could serve that purpose? I imagine
--- `anissue tags` (without a tag given) to list all tags.
---
--- \*Rationale: I would like to push for concepts out of anissue for as long as
--- feasible . Currently, there is no notion of "topics".*
-
 -- TODO Add HTTP server
 --
 -- When running `anissue server`, an HTTP server should be started,
@@ -371,6 +357,7 @@ import Data.Function ((&))
 import Data.List (find, intersperse, isPrefixOf)
 import Data.Map qualified as M
 import Data.Maybe (catMaybes)
+import Data.Set qualified as S
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
 import Data.Text.Lazy qualified as LT
@@ -387,6 +374,7 @@ import Issue.GroupBy qualified as I
 import Issue.Provenance qualified as I
 import Issue.Sort (Sort, applySorts)
 import Issue.Sort qualified as I
+import Issue.Tag qualified as I
 import Options.Applicative ((<**>))
 import Options.Applicative qualified as O
 import Prettyprinter ((<+>))
@@ -481,6 +469,7 @@ data Command
       { id :: String,
         edit :: Bool
       }
+  | Tags
   deriving (Show)
 
 cmd :: O.Parser Command
@@ -491,7 +480,9 @@ cmd =
       O.command "log" . O.info logCmd $
         O.progDesc "Show a log of all issues",
       O.command "show" . O.info showCmd $
-        O.progDesc "Show details of all issues"
+        O.progDesc "Show details of all issues",
+      O.command "tags" . O.info tagsCmd $
+        O.progDesc "Show all tags"
     ]
 
 listCmd :: O.Parser Command
@@ -512,6 +503,10 @@ showCmd =
     <$> idArg
     <*> editFlag
 
+tagsCmd :: O.Parser Command
+tagsCmd =
+  pure Tags
+
 filesArg :: O.Parser [String]
 filesArg = O.many (O.strArgument (O.metavar "FILE" <> O.action "file"))
 
@@ -679,6 +674,37 @@ main = do
                 ++ "\n@row "
                 ++ show issue.start.row
                 ++ "\n"
+    Options {colorize, noPager, width, internalTags, command = Tags} -> do
+      issues <- fst <$> getHistory
+      let tags =
+            concatMap
+              ( \issue ->
+                  issue.tags
+                    ++ ( if internalTags
+                           then issue.internalTags
+                           else []
+                       )
+              )
+              issues
+          tagsAndValues =
+            M.toList
+              . M.map (S.toList . S.fromList)
+              . foldl
+                ( flip
+                    ( \tag ->
+                        let vs = maybe [] (: []) (I.tagValue tag)
+                         in (M.alter (Just . maybe vs (vs ++))) (I.tagKey tag)
+                    )
+                )
+                M.empty
+              $ tags
+      putDoc colorize noPager width . P.vsep $
+        map
+          ( \(tagKey, tagValues) ->
+              P.annotate P.bold (P.pretty ("@" <> tagKey))
+                <+> P.hsep (map P.pretty tagValues)
+          )
+          tagsAndValues
 
 -- TODO Move `replaceText` to `Issue`
 
-- 
cgit v1.2.3