close separate-database-issues-and-history-issues

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