diff options
| -rw-r--r-- | app/History/CommitInfo.hs | 1 | ||||
| -rw-r--r-- | app/History/PartialCommitInfo.hs | 44 | ||||
| -rw-r--r-- | app/Issue.hs | 67 | ||||
| -rw-r--r-- | app/Issue/Text.hs | 25 | ||||
| -rw-r--r-- | app/Main.hs | 39 |
5 files changed, 66 insertions, 110 deletions
diff --git a/app/History/CommitInfo.hs b/app/History/CommitInfo.hs index 3c371d1..bea0cd3 100644 --- a/app/History/CommitInfo.hs +++ b/app/History/CommitInfo.hs @@ -16,7 +16,6 @@ import History.IssueEvent (IssueEvent (..)) import History.PartialCommitInfo (PartialCommitInfo (..)) import Issue (Issue (..), id) import Issue.Provenance qualified as I -import TreeGrepper.Match (Position (..)) import Prelude hiding (id) -- TODO Change `CommitInfo` -> `CommitIssuesAll` diff --git a/app/History/PartialCommitInfo.hs b/app/History/PartialCommitInfo.hs index cd8cd46..b37ada5 100644 --- a/app/History/PartialCommitInfo.hs +++ b/app/History/PartialCommitInfo.hs @@ -4,11 +4,12 @@ module History.PartialCommitInfo ) where -import Control.Exception (catch) +import Control.Exception (catch, handle) import Data.Binary (Binary) import Data.ByteString.Lazy.Char8 qualified as LB8 import Data.Function ((&)) import Data.List.NonEmpty qualified as N +import Data.Maybe (catMaybes) import Data.Text qualified as T import Die (die) import Exception qualified as E @@ -16,13 +17,17 @@ import GHC.Generics (Generic) import Git qualified import History.Cache (cached) import History.CommitHash (CommitHash (..)) -import Issue (Issue, getIssues) +import Issue (Issue (..)) +import Issue.Provenance qualified as I +import Issue.Tag qualified as I +import Issue.Text qualified as I import Parallel (parMapM) import Process (proc, sh) import System.Directory (getCurrentDirectory) import System.FilePath ((</>)) import System.IO.Temp (withSystemTempDirectory) import System.Process.Typed (setWorkingDir) +import TreeGrepper.Comment qualified as G -- | `PartialCommitInfo` records the complete issues ONLY in files that have -- been changed in the commit. @@ -68,6 +73,41 @@ getIssuesAndFilesCommitChanged hash = do issues <- concat <$> catch (mapM (getIssues cwd) files) dieOfInvalidTreeGrepperResult pure (issues, files) +-- | Get all issues in the given directory and file. +getIssues :: FilePath -> FilePath -> IO [Issue] +getIssues cwd filename = + handle (\(_ :: E.UnknownFileExtension) -> pure []) $ + fmap catMaybes . mapM (fromComment cwd) + =<< G.getComments cwd filename + +-- | Note that `provenance` is trivial and needs to be fixed up later. +fromComment :: FilePath -> G.Comment -> IO (Maybe Issue) +fromComment cwd comment = do + commit <- I.commitFromHEAD cwd + let provenance = I.Provenance commit commit + + pure + ( if any (\marker -> T.isPrefixOf marker title') I.issueMarkers + then + Just + Issue + { title = title, + description = description, + file = comment.file, + provenance = provenance, + start = comment.start, + end = comment.end, + tags = maybe [] I.extractTags description, + markers = markers, + rawText = rawText + } + else Nothing + ) + where + rawText = comment.text + (title', description) = I.extractText comment.file_type rawText + (markers, title) = I.stripIssueMarkers title' + dieOfInvalidTreeGrepperResult :: E.InvalidTreeGrepperResult -> IO a dieOfInvalidTreeGrepperResult (E.InvalidTreeGrepperResult e) = die e diff --git a/app/Issue.hs b/app/Issue.hs index 6d8746d..9d5a102 100644 --- a/app/Issue.hs +++ b/app/Issue.hs @@ -1,29 +1,19 @@ module Issue ( Issue (..), Provenance (..), - fromComment, id, internalTags, - getIssues, ) where -import Control.Arrow qualified as W -import Control.Exception (handle) import Data.Binary (Binary) import Data.List (find) -import Data.Maybe (catMaybes) import Data.Text qualified as T import Data.Time.Clock (UTCTime (utctDay)) -import Exception qualified as E import GHC.Generics (Generic) import GHC.Records (HasField (..)) -import Issue.Provenance (Author (..), Commit (..), Provenance (..), commitFromHEAD) +import Issue.Provenance (Author (..), Commit (..), Provenance (..)) import Issue.Tag (Tag (..)) -import Issue.Tag qualified as I -import Issue.Text qualified as I -import TreeGrepper.Comment (Comment (..)) -import TreeGrepper.Comment qualified as G import TreeGrepper.Match qualified as G import Prelude hiding (id) @@ -65,58 +55,3 @@ toSpinalCase :: T.Text -> T.Text toSpinalCase = T.replace " " "-" . T.filter keep . T.toLower where keep = (`elem` (concat [[' ', '-'], ['a' .. 'z'], ['0' .. '9']])) - --- TODO Refactor non-issues --- --- This does not return an issue, as provenance is not computed over its --- history. Maybe this should return a different type, or be internal to --- `History`? -fromComment :: FilePath -> Comment -> IO (Maybe Issue) -fromComment cwd comment = do - commit <- commitFromHEAD cwd - let provenance = Provenance commit commit - - pure - ( if any (\marker -> T.isPrefixOf marker title') issueMarkers - then - Just - Issue - { title = title, - description = description, - file = comment.file, - provenance = provenance, - start = comment.start, - end = comment.end, - tags = maybe [] I.extractTags description, - markers = markers, - rawText = rawText - } - else Nothing - ) - where - rawText = comment.text - (title', description) = I.extractText comment.file_type rawText - (markers, title) = stripIssueMarkers title' - -issueMarkers :: [T.Text] -issueMarkers = - [ "TODO", - "FIXME", - "QUESTION" - ] - -stripIssueMarkers :: T.Text -> ([T.Text], T.Text) -stripIssueMarkers text = - case [marker | marker <- issueMarkers, T.isPrefixOf marker text] of - (marker : _) -> - W.first (marker :) . stripIssueMarkers $ - T.stripStart (T.drop (T.length marker) text) - [] -> - ([], text) - --- | Get all issues in the given directory and file. -getIssues :: FilePath -> FilePath -> IO [Issue] -getIssues cwd filename = - handle (\(_ :: E.UnknownFileExtension) -> pure []) $ - fmap catMaybes . mapM (fromComment cwd) - =<< G.getComments cwd filename diff --git a/app/Issue/Text.hs b/app/Issue/Text.hs index 7c81c91..5d1dddb 100644 --- a/app/Issue/Text.hs +++ b/app/Issue/Text.hs @@ -1,6 +1,11 @@ -module Issue.Text (extractText) where +module Issue.Text + ( extractText, + stripIssueMarkers, + issueMarkers, + ) +where -import Control.Arrow (second) +import Control.Arrow (first, second) import Data.List (find) import Data.Maybe (fromMaybe) import Data.Text (Text) @@ -46,3 +51,19 @@ stripBlockComment blockStart blockEnd text = . (fromMaybe text . T.stripSuffix blockEnd) . (fromMaybe text . T.stripPrefix blockStart) $ text + +issueMarkers :: [T.Text] +issueMarkers = + [ "TODO", + "FIXME", + "QUESTION" + ] + +stripIssueMarkers :: T.Text -> ([T.Text], T.Text) +stripIssueMarkers text = + case [marker | marker <- issueMarkers, T.isPrefixOf marker text] of + (marker : _) -> + first (marker :) . stripIssueMarkers $ + T.stripStart (T.drop (T.length marker) text) + [] -> + ([], text) diff --git a/app/Main.hs b/app/Main.hs index 5fea8dc..4491747 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,42 +1,3 @@ --- TODO Separate database issues and history issues --- --- History code re-uses the issue concept which leads to undesirable effects. --- --- (1) History issues don't hold up to the guarantee that provenance is --- computed over the history, because we compute issues with trivial provenance --- per commit, and then later merge those trivial provenance in an --- history-encompassing provenance. --- --- (2) Internal tags depend on provenance, and thus, have to re-computed after --- the final provenance has been generated. --- --- (3) We need to compare issues in history code, and several fields of issue --- prevent us from doing that cleanly. --- --- To remedy, history should introduce its own notion (data type) of issue, --- and operate on that. --- --- @supersedes fix-issue-comparison --- @supersedes refactor-non-issues --- --- @difficulty medium --- @priority high --- --- @assigned aforemny --- @status in-progress --- --- COMMENT I've attempted this, and have not been happy with the outcome. --- Short of separating provenance from issues, ie. maintaining a separate --- structure to track provenance, we cannot overcome (1) since it is part --- of the algorithm. --- --- I've overcome (2) by not memoizing `internalTags` and overcome (3) by --- capturing `rawText` and comparing that. --- --- I am as of now not convinced that separating provenance into an --- external structure is the way forward (nor am I convinced that is is --- not). - -- TODO Parse issues as markdown -- -- There are several issues related to the fact that we are not parsing |