aboutsummaryrefslogtreecommitdiffstats
path: root/app/Issue
diff options
context:
space:
mode:
Diffstat (limited to 'app/Issue')
-rw-r--r--app/Issue/Filter.hs15
-rw-r--r--app/Issue/Group.hs16
-rw-r--r--app/Issue/Meta.hs24
-rw-r--r--app/Issue/Render.hs88
-rw-r--r--app/Issue/Tag.hs54
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
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-23 15:33:13 +0000