diff options
| -rw-r--r-- | app/History/CommitInfo.hs | 6 | ||||
| -rw-r--r-- | app/Issue.hs | 20 | ||||
| -rw-r--r-- | app/Issue/GroupBy.hs | 5 | ||||
| -rw-r--r-- | app/Issue/Tag.hs | 19 |
4 files changed, 31 insertions, 19 deletions
diff --git a/app/History/CommitInfo.hs b/app/History/CommitInfo.hs index c24fcd9..865fcc4 100644 --- a/app/History/CommitInfo.hs +++ b/app/History/CommitInfo.hs @@ -59,7 +59,11 @@ fromPartialCommitInfos (partialCommitInfo : partialCommitInfos) = ) <$> old.provenance <*> new.provenance, - internalTags = I.internalTags new.title old.provenance + internalTags = + I.internalTags + new.title + old.provenance + (I.tagValuesOf "type" new.internalTags) } ) ( \old -> diff --git a/app/Issue.hs b/app/Issue.hs index 451b897..4326af1 100644 --- a/app/Issue.hs +++ b/app/Issue.hs @@ -7,11 +7,12 @@ module Issue ) where +import Control.Arrow qualified as W import Control.Exception (handle, throw) import Data.Aeson (eitherDecode) import Data.Binary (Binary) import Data.Function ((&)) -import Data.List (find, foldl') +import Data.List (find) import Data.Maybe (catMaybes) import Data.Text (Text) import Data.Text qualified as T @@ -73,13 +74,13 @@ fromMatch cwd result match = do start = match.start, end = match.end, tags = maybe [] I.extractTags description, - internalTags = I.internalTags title (Just provenance) + internalTags = I.internalTags title (Just provenance) markers } else Nothing ) where (title', description) = I.extractText result.file_type match.text - title = stripIssueMarkers title' + (markers, title) = stripIssueMarkers title' issueMarkers :: [Text] issueMarkers = @@ -88,13 +89,14 @@ issueMarkers = "QUESTION" ] -stripIssueMarkers :: Text -> Text +stripIssueMarkers :: Text -> ([Text], Text) stripIssueMarkers text = - foldl' (stripIssueMarker) text issueMarkers - -stripIssueMarker :: Text -> Text -> Text -stripIssueMarker text marker = - maybe text T.stripStart (T.stripPrefix marker text) + case [marker | marker <- issueMarkers, T.isPrefixOf marker text] of + (marker : _) -> + W.first (marker :) . stripIssueMarkers $ + T.drop (T.length marker) text + [] -> + ([], text) -- | Get all issues in the given directory and files. Runs -- parallelized. diff --git a/app/Issue/GroupBy.hs b/app/Issue/GroupBy.hs index 2b9e514..18859f2 100644 --- a/app/Issue/GroupBy.hs +++ b/app/Issue/GroupBy.hs @@ -13,11 +13,6 @@ import Issue.Tag (Tag (..)) import Issue.Tag qualified as I import Options.Applicative qualified as O --- TODO Add issues marker as internal tags --- --- The internal makers `TODO`, `FIXME`, etc. should be available via the --- internal tag @type - groupByArg :: O.Parser (Maybe T.Text) groupByArg = O.optional diff --git a/app/Issue/Tag.hs b/app/Issue/Tag.hs index c2358a8..90c7520 100644 --- a/app/Issue/Tag.hs +++ b/app/Issue/Tag.hs @@ -4,11 +4,12 @@ module Issue.Tag internalTags, tagKey, tagValue, + tagValuesOf, ) where import Data.Binary (Binary) -import Data.Maybe (catMaybes) +import Data.Maybe (catMaybes, mapMaybe) import Data.Text (Text, pack) import Data.Text qualified as T import Data.Time.Clock (UTCTime (utctDay)) @@ -23,6 +24,15 @@ tagKey (Tag k _) = k tagValue :: Tag -> Maybe Text tagValue (Tag _ v) = v +tagValuesOf :: Text -> [Tag] -> [Text] +tagValuesOf key = + mapMaybe + ( \tag -> + if tagKey tag == key + then tagValue tag + else Nothing + ) + extractTags :: Text -> [Tag] extractTags = catMaybes @@ -38,8 +48,8 @@ extractTags = ) . T.lines -internalTags :: Text -> Maybe Provenance -> [Tag] -internalTags title provenance' = +internalTags :: Text -> Maybe Provenance -> [T.Text] -> [Tag] +internalTags title provenance' markers = concat [ [ Tag "id" $ Just $ toSpinalCase title ], @@ -52,7 +62,8 @@ internalTags title provenance' = Tag "editor" $ Just $ provenance.last.author.name ] ) - provenance' + provenance', + map (Tag "type" . Just) markers ] toSpinalCase :: Text -> Text |