improve list output

3 files changed, 52 insertions, 30 deletions

diff --git a/anissue.cabal b/anissue.cabal
index 4b068e6..af662c2 100644
--- a/anissue.cabal
+++ b/anissue.cabal
@@ -66,6 +66,7 @@ executable anissue
 
     -- Modules included in this executable, other than Main.
     other-modules:
+      Data.List.Extra
       Debug
       Die
       Exception
diff --git a/app/Data/List/Extra.hs b/app/Data/List/Extra.hs
new file mode 100644
index 0000000..d01beb9
--- /dev/null
+++ b/app/Data/List/Extra.hs
@@ -0,0 +1,5 @@
+module Data.List.Extra (list) where
+
+list :: b -> ([a] -> b) -> [a] -> b
+list y _ [] = y
+list _ f xs = f xs
diff --git a/app/Main.hs b/app/Main.hs
index 0a6d6c1..1aff48b 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -415,8 +415,9 @@ module Main where
 import Control.Applicative ((<|>))
 import Data.Function ((&))
 import Data.List (find, intersperse, isPrefixOf)
+import Data.List.Extra (list)
 import Data.Map qualified as M
-import Data.Maybe (catMaybes)
+import Data.Maybe (catMaybes, maybeToList)
 import Data.Set qualified as S
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
@@ -620,41 +621,30 @@ main = do
                     issues
           )
           (M.toList groupedIssues)
-    Options {colorize, noPager, width, command = List {sort, filters, files, groupBy = Nothing}} -> do
+    Options {internalTags, colorize, noPager, width, command = List {sort, filters, files, groupBy = Nothing}} -> do
       let withinPath issue = if null files then True else any (\file -> file `isPrefixOf` issue.file) files
       issues <- applySorts sort . applyFilters filters . filter withinPath . fst <$> getHistory
       putDoc colorize noPager width . P.vsep $
         map
           ( \issue ->
-              let title = P.annotate P.bold $ P.pretty issue.title
-                  fileAndRow =
-                    keyword "in"
-                      <+> value (T.pack issue.file <> ":" <> T.pack (show issue.start.row))
-                  commit = fromProvenanceDef (keyword "via" <+> value (T.pack "HEAD")) $
-                    \I.Provenance {first} -> keyword "via" <+> value (T.take 7 first.hash)
-                  author = fromProvenance $
-                    \I.Provenance {first} ->
-                      ( keyword "by" <+> value (first.author.name <> " <" <> first.author.email <> ">")
-                      )
-                  createdAt = fromProvenance $
-                    \I.Provenance {first} -> keyword "on" <+> value (show (utctDay first.date))
-                  modifiedAt = fromProvenance $
-                    \I.Provenance {last = last'} -> keyword "modified" <+> value (show (utctDay last'.date))
-
-                  fromProvenanceDef def = flip (maybe def) issue.provenance
+              let title = map (P.annotate P.bold . P.pretty) (T.words issue.title)
+                  tags = prettyTags (issue.tags ++ if internalTags then issue.internalTags else [])
+                  openedBy =
+                    fromProvenance $
+                      P.annotate (P.color P.Black) . ("by" <+>) . P.pretty . (.first.author.name)
+                  openedOn =
+                    fromProvenance $
+                      P.annotate (P.color P.Black) . ("on" <+>) . P.pretty . show . utctDay . (.first.date)
                   fromProvenance = flip fmap issue.provenance
-                  keyword :: T.Text -> P.Doc P.AnsiStyle
-                  keyword = P.annotate (P.colorDull P.Green) . P.pretty
-                  value :: P.Pretty a => a -> P.Doc P.AnsiStyle
-                  value = P.annotate (P.color P.Green) . P.pretty
-               in P.nest 4 . P.vsep . catMaybes $
-                    [ Just title,
-                      Just fileAndRow,
-                      Just commit,
-                      author,
-                      createdAt,
-                      modifiedAt
-                    ]
+               in P.nest 4 $
+                    P.fillSep
+                      ( concat $
+                          [ title,
+                            tags,
+                            maybeToList openedOn,
+                            maybeToList openedBy
+                          ]
+                      )
           )
           issues
     Options {colorize, noPager, width, command = Log} -> do
@@ -766,6 +756,32 @@ main = do
           )
           tagsAndValues
 
+prettyTags :: [I.Tag] -> [P.Doc P.AnsiStyle]
+prettyTags =
+  map
+    ( \(key, values) ->
+        maybe
+          ( P.annotate P.bold
+              . P.annotate (P.color P.Yellow)
+              $ P.pretty ("@" <> key)
+          )
+          ( P.annotate P.bold
+              . P.annotate (P.color P.Yellow)
+              . (P.pretty ("@" <> key) <+>)
+              . P.annotate (P.color P.Yellow)
+              . P.pretty
+          )
+          (list Nothing (Just . T.intercalate ",") values)
+    )
+    . M.toList
+    . M.map S.toList
+    . foldl
+      ( \dict tag ->
+          let value = S.fromList (maybeToList (I.tagValue tag))
+           in M.alter (Just . maybe value (S.union value)) (I.tagKey tag) dict
+      )
+      M.empty
+
 -- TODO Move `replaceText` to `Issue`
 
 -- TODO `replaceFile` hardcodes comment