feat: add experimental render api

5 files changed, 183 insertions, 14 deletions

diff --git a/app/Issue/Filter.hs b/app/Issue/Filter.hs
index e8209a7..68eda87 100644
--- a/app/Issue/Filter.hs
+++ b/app/Issue/Filter.hs
@@ -2,11 +2,14 @@ module Issue.Filter
   ( Filter,
     filterArg,
     applyFilters,
+    applyClosed,
+    applyPath,
   )
 where
 
 import Control.Applicative (liftA2, (<|>))
 import Data.Attoparsec.Text qualified as A
+import Data.List (isPrefixOf)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Issue (Issue (..))
@@ -132,3 +135,15 @@ op (Ge) = flip (>=)
 op (Gt) = flip (>)
 op (Le) = flip (<=)
 op (Lt) = flip (<)
+
+applyClosed :: Bool -> [Issue] -> [Issue]
+applyClosed closed = filter (\issue -> closed || not issue.closed)
+
+applyPath :: [FilePath] -> [Issue] -> [Issue]
+applyPath files =
+  filter
+    ( \issue ->
+        if null files
+          then True
+          else any (`isPrefixOf` issue.file) files
+    )
diff --git a/app/Issue/Group.hs b/app/Issue/Group.hs
index 69caf20..2f19a98 100644
--- a/app/Issue/Group.hs
+++ b/app/Issue/Group.hs
@@ -1,15 +1,13 @@
 module Issue.Group
   ( groupArg,
-    groupIssuesBy,
+    groupIssuesByTag,
   )
 where
 
 import Data.Map (Map)
 import Data.Map qualified as M
-import Data.Maybe (mapMaybe)
 import Data.Text qualified as T
 import Issue (Issue (..))
-import Issue.Tag (Tag (..))
 import Issue.Tag qualified as I
 import Options.Applicative qualified as O
 
@@ -28,20 +26,14 @@ groupArg =
       | "@" `T.isPrefixOf` s = Just (T.drop 1 s)
       | otherwise = Nothing
 
-groupIssuesBy :: T.Text -> [Issue] -> Map T.Text [Issue]
-groupIssuesBy group issues =
+groupIssuesByTag :: T.Text -> [Issue] -> Map T.Text [Issue]
+groupIssuesByTag tagKey issues =
   foldl
     ( \collected issue ->
         foldl
           (flip $ M.alter (Just . maybe [issue] (issue :)))
           collected
-          (groupsOfIssue group issue)
+          (I.tagValuesOf tagKey (issue.tags ++ issue.internalTags))
     )
     M.empty
     issues
-
-groupsOfIssue :: T.Text -> Issue -> [T.Text]
-groupsOfIssue group issue =
-  mapMaybe I.tagValue
-    . filter (\(Tag key _) -> key == group)
-    $ issue.tags ++ issue.internalTags
diff --git a/app/Issue/Meta.hs b/app/Issue/Meta.hs
index 19ccab3..6e3bbf0 100644
--- a/app/Issue/Meta.hs
+++ b/app/Issue/Meta.hs
@@ -4,8 +4,13 @@ module Issue.Meta
   )
 where
 
+import Data.List (intersperse)
+import Data.Text qualified as T
 import Issue (Issue (..))
-import Issue.Tag (Tag, tagValue)
+import Issue.Render ()
+import Issue.Tag (Tag, TagKey (..), tagValue)
+import Render ((<<<))
+import Render qualified as P
 
 data Meta = Meta
   { referencedBy :: [(Issue, Tag)]
@@ -24,3 +29,20 @@ getMeta issues issue =
           )
           issues
     }
+
+instance P.Render Meta where
+  render meta =
+    if (not $ null meta.referencedBy)
+      then
+        P.styled [P.italicized]
+          . (P.vsep . intersperse P.hardline)
+          $ map
+            ( \(otherIssue, tag) ->
+                ("This commit was referenced by issue " :: T.Text)
+                  <<< P.Linked otherIssue
+                  <<< (" (" :: T.Text)
+                  <<< TagKey tag
+                  <<< (")." :: T.Text)
+            )
+            meta.referencedBy
+      else P.emptyDoc
diff --git a/app/Issue/Render.hs b/app/Issue/Render.hs
new file mode 100644
index 0000000..ea504d5
--- /dev/null
+++ b/app/Issue/Render.hs
@@ -0,0 +1,88 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Issue.Render
+  ( IssueTitle (..),
+    IssueDescription (..),
+    IssueTags (..),
+    IssueOpenedOn (..),
+    IssueOpenedBy (..),
+  )
+where
+
+import Data.List (intersperse)
+import Data.Map qualified as M
+import Data.Text qualified as T
+import Data.Time.Clock (UTCTime (utctDay))
+import Issue (Issue (..))
+import Issue.Provenance (Author (..), Commit (..), Provenance (..))
+import Render ((<<<))
+import Render qualified as P
+
+instance P.Render (P.Detailed Issue) where
+  render (P.Detailed issue) = P.renderAsMarkdown issue.rawText
+
+instance P.Render Issue where
+  render = P.render . P.Detailed
+
+newtype IssueTitle = IssueTitle {unIssueTitle :: Issue}
+
+instance P.Render IssueTitle where
+  render (IssueTitle issue)
+    | issue.closed = P.styled [P.colorDull P.Red] $ P.render issue.title
+    | otherwise = P.styled [(P.color P.Green)] $ P.render issue.title
+
+newtype IssueDescription = IssueDescription {unIssueDescription :: Issue}
+
+instance P.Render IssueDescription where
+  render (IssueDescription issue) = maybe P.emptyDoc P.pretty issue.description
+
+instance P.Render (P.Linked Issue) where
+  render (P.Linked issue)
+    | issue.closed =
+        P.styled [P.underlined, P.colorDull P.Red] $
+          ("(closed)" :: T.Text) <<< P.render issue.id
+    | otherwise =
+        P.styled [P.underlined, (P.color P.Green)] $
+          P.render issue.id
+
+instance P.Render (P.Summarized Issue) where
+  render (P.Summarized issue) =
+    P.nest 4 $
+      IssueTitle issue
+        <<< IssueTags issue
+        <<< IssueOpenedOn issue
+        <<< IssueOpenedBy issue
+
+newtype IssueTags = IssueTags {unIssueTags :: Issue}
+
+instance P.Render IssueTags where
+  render (IssueTags issue) = P.render issue.tags
+
+newtype IssueOpenedBy = IssueOpenedBy {unIssueOpenedBy :: Issue}
+
+instance P.Render IssueOpenedBy where
+  render (IssueOpenedBy issue) =
+    ("by" :: T.Text) <<< issue.provenance.first.author.name
+
+newtype IssueOpenedOn = IssueOpenedOn {unIssueOpenedOn :: Issue}
+
+instance P.Render IssueOpenedOn where
+  render (IssueOpenedOn issue) =
+    ("on" :: T.Text) <<< utctDay issue.provenance.first.date
+
+instance P.Render (T.Text, M.Map T.Text [Issue]) where
+  render (tagKey, groupedIssues) =
+    (P.vsep . intersperse ("" :: P.Doc ann)) $
+      concatMap
+        ( \(name, issues) ->
+            ( P.styled [P.underlined] $
+                ("@" <> tagKey)
+                  <<< name
+                  <<< P.parens @P.AnsiStyle (P.pretty (length issues))
+            )
+              : map
+                (P.indent 4)
+                ( map (P.render . IssueTitle) issues
+                )
+        )
+        (M.toList groupedIssues)
diff --git a/app/Issue/Tag.hs b/app/Issue/Tag.hs
index ca550aa..b0d4d3c 100644
--- a/app/Issue/Tag.hs
+++ b/app/Issue/Tag.hs
@@ -4,15 +4,22 @@ module Issue.Tag
     tagKey,
     tagValue,
     tagValuesOf,
+    TagKey (..),
+    TagValue (..),
   )
 where
 
 import CMark qualified as D
 import Data.Binary (Binary)
-import Data.Maybe (catMaybes, mapMaybe)
+import Data.List (intersperse)
+import Data.Map qualified as M
+import Data.Maybe (catMaybes, isJust, mapMaybe)
+import Data.Set qualified as S
 import Data.Text (Text)
 import Data.Text qualified as T
 import GHC.Generics (Generic)
+import Render ((<<<))
+import Render qualified as P
 
 data Tag = Tag Text (Maybe Text) deriving (Show, Generic, Binary, Eq)
 
@@ -53,3 +60,48 @@ extractTags = collect . D.commonmarkToNode []
               . T.words
           )
         . T.lines
+
+instance P.Render Tag where
+  render tag
+    | isJust (tagValue tag) = TagKey tag <<< (" " :: T.Text) <<< TagValue tag
+    | otherwise = P.render (TagKey tag)
+
+newtype TagKey = TagKey {unTagKey :: Tag}
+
+instance P.Render TagKey where
+  render (TagKey tag) =
+    P.styled [P.bold, P.color P.Yellow] $
+      P.render ("@" <> tagKey tag)
+
+newtype TagValue = TagValue {unTagValue :: Tag}
+
+instance P.Render TagValue where
+  render (TagValue tag) =
+    maybe P.emptyDoc (P.styled [P.color P.Yellow] . P.render) $
+      tagValue tag
+
+instance P.Render [Tag] where
+  render tags =
+    P.vsep $
+      map
+        ( \(tagKey, tagValues) ->
+            TagKey (Tag tagKey Nothing)
+              <<< (P.hcat . intersperse P.comma)
+                (map (P.render . TagValue) (map (Tag tagKey . Just) tagValues))
+        )
+        tagsAndValues
+    where
+      tagsAndValues :: [(T.Text, [T.Text])]
+      tagsAndValues =
+        (M.toList . M.map S.toList)
+          . foldl
+            ( flip
+                ( \tag ->
+                    let vs = maybe S.empty S.singleton (tagValue tag)
+                     in M.alter
+                          (Just . maybe vs (S.union vs))
+                          (tagKey tag)
+                )
+            )
+            M.empty
+          $ tags