record both creation and update in provenance

6 files changed, 72 insertions, 31 deletions

diff --git a/app/Exception.hs b/app/Exception.hs
index 83d624d..ddaef5a 100644
--- a/app/Exception.hs
+++ b/app/Exception.hs
@@ -1,6 +1,7 @@
 module Exception
   ( AnyException (..),
     InvalidTreeGrepperResult (..),
+    NoCommits (..),
     ProcessException (..),
     UnknownFileExtension (..),
   )
@@ -12,6 +13,7 @@ import System.Exit (ExitCode)
 
 data AnyException
   = InvalidTreeGrepperResult' InvalidTreeGrepperResult
+  | NoCommits' NoCommits
   | ProcessException' ProcessException
   | UnknownFileExtension' UnknownFileExtension
   deriving (Show)
@@ -25,6 +27,11 @@ data InvalidTreeGrepperResult = InvalidTreeGrepperResult
 
 instance Exception InvalidTreeGrepperResult
 
+data NoCommits = NoCommits
+  deriving (Show)
+
+instance Exception NoCommits
+
 data ProcessException = ProcessException String ExitCode LB.ByteString
   deriving (Show)
 
diff --git a/app/History/CommitInfo.hs b/app/History/CommitInfo.hs
index 8461b8e..b42e1ba 100644
--- a/app/History/CommitInfo.hs
+++ b/app/History/CommitInfo.hs
@@ -15,6 +15,7 @@ import History.CommitHash (CommitHash)
 import History.IssueEvent (IssueEvent (..))
 import History.PartialCommitInfo (PartialCommitInfo (..))
 import Issue (Issue (..), id)
+import Issue.Provenance qualified as I
 import Issue.Tag qualified as I
 import TreeGrepper.Match (Position (..))
 import Prelude hiding (id)
@@ -44,7 +45,15 @@ fromPartialCommitInfos (partialCommitInfo : partialCommitInfos) =
                 ( \old new ->
                     Just
                       new
-                        { provenance = old.provenance,
+                        { provenance =
+                            (\oldProvenance newProvenance ->
+                              ( I.Provenance
+                                  { first = oldProvenance.first,
+                                    last = newProvenance.last
+                                  }
+                              )
+                            )
+                            <$> old.provenance <*> new.provenance,
                           internalTags = I.internalTags new.title old.provenance
                         }
                 )
diff --git a/app/Issue.hs b/app/Issue.hs
index a4e2d73..451b897 100644
--- a/app/Issue.hs
+++ b/app/Issue.hs
@@ -17,7 +17,7 @@ import Data.Text (Text)
 import Data.Text qualified as T
 import Exception qualified as E
 import GHC.Generics (Generic)
-import Issue.Provenance (Provenance (..), provenanceFromHEAD)
+import Issue.Provenance (Provenance (..), commitFromHEAD)
 import Issue.Tag (Tag (..))
 import Issue.Tag qualified as I
 import Issue.Text qualified as I
@@ -35,6 +35,9 @@ data Issue = Issue
   { title :: Text,
     description :: Maybe Text,
     file :: String,
+    -- TODO Make provenance obligatory
+    --
+    -- I cannot think of instances where an issue exists without a provenance..
     provenance :: Maybe Provenance,
     start :: G.Position,
     end :: G.Position,
@@ -48,9 +51,15 @@ id issue =
   (\(Tag _ v) -> T.unpack <$> v)
     =<< find (\(Tag k _) -> k == "id") (issue.tags ++ issue.internalTags)
 
+-- 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`? Also, `internalTags` suffer.
 fromMatch :: FilePath -> G.Result -> G.Match -> IO (Maybe Issue)
 fromMatch cwd result match = do
-  provenance <- provenanceFromHEAD cwd
+  commit <- commitFromHEAD cwd
+  let provenance = Provenance commit commit
 
   pure
     ( if any (\marker -> T.isPrefixOf marker title') issueMarkers
@@ -60,11 +69,11 @@ fromMatch cwd result match = do
               { title = title,
                 description = description,
                 file = result.file,
-                provenance = provenance,
+                provenance = Just provenance,
                 start = match.start,
                 end = match.end,
                 tags = maybe [] I.extractTags description,
-                internalTags = I.internalTags title provenance
+                internalTags = I.internalTags title (Just provenance)
               }
         else Nothing
     )
diff --git a/app/Issue/Provenance.hs b/app/Issue/Provenance.hs
index f3d382c..4d69472 100644
--- a/app/Issue/Provenance.hs
+++ b/app/Issue/Provenance.hs
@@ -2,28 +2,45 @@
 
 module Issue.Provenance
   ( Provenance (..),
-    provenanceFromHEAD,
+    Commit (..),
+    Author (..),
+    commitFromHEAD,
   )
 where
 
+import Control.Exception (throwIO)
 import Data.Binary (Binary, Put, get, put)
 import Data.ByteString.Lazy.Char8 (toStrict)
 import Data.Fixed (Pico)
 import Data.Function ((&))
-import Data.Text (Text, lines, splitOn, unpack)
+import Data.Text (lines, splitOn, unpack)
+import Data.Text qualified as T
 import Data.Text.Encoding (decodeUtf8)
 import Data.Time.Calendar (Day (..), toModifiedJulianDay)
 import Data.Time.Clock (DiffTime, UTCTime (..), picosecondsToDiffTime)
+import Exception qualified as E
 import GHC.Generics (Generic)
 import Process (sh)
 import System.Process.Typed (setWorkingDir)
 import Prelude hiding (lines)
 
 data Provenance = Provenance
-  { firstCommit :: Text,
+  { first :: Commit,
+    last :: Commit
+  }
+  deriving (Show, Generic, Binary, Eq)
+
+data Commit = Commit
+  { -- TODO `T.Text` -> `CommitHash`
+    hash :: T.Text,
     date :: UTCTime,
-    authorEmail :: Text,
-    authorName :: Text
+    author :: Author
+  }
+  deriving (Show, Generic, Binary, Eq)
+
+data Author = Author
+  { name :: T.Text,
+    email :: T.Text
   }
   deriving (Show, Generic, Binary, Eq)
 
@@ -43,22 +60,20 @@ instance Binary DiffTime where
   get = fmap picosecondsToDiffTime get
   put = (put :: Pico -> Put) . realToFrac
 
-provenanceFromHEAD :: FilePath -> IO (Maybe Provenance)
-provenanceFromHEAD cwd = do
+commitFromHEAD :: FilePath -> IO Commit
+commitFromHEAD cwd = do
   rawProvenance <-
     fmap (splitOn "\NUL" . head . lines . decodeUtf8 . toStrict) $
       sh $
         "git show --quiet --format='%H%x00%ai%x00%ae%x00%an'"
           & setWorkingDir cwd
-  pure $ case rawProvenance of
-    firstCommit' : rawDate : authorEmail : authorName : _ ->
+  case rawProvenance of
+    hash : rawDate : authorEmail : authorName : _ ->
       let date = read (unpack rawDate)
-       in Just
-            Provenance
-              { firstCommit = firstCommit',
+       in pure
+            Commit
+              { hash = hash,
                 date = date,
-                authorEmail = authorEmail,
-                authorName = authorName
+                author = Author authorName authorEmail
               }
-    _ ->
-      Nothing
+    _ -> throwIO E.NoCommits
diff --git a/app/Issue/Tag.hs b/app/Issue/Tag.hs
index 42a371d..2947ec9 100644
--- a/app/Issue/Tag.hs
+++ b/app/Issue/Tag.hs
@@ -13,7 +13,7 @@ import Data.Text (Text, pack)
 import Data.Text qualified as T
 import Data.Time.Clock (UTCTime (utctDay))
 import GHC.Generics (Generic)
-import Issue.Provenance (Provenance (..))
+import Issue.Provenance (Provenance (..), Commit(..))
 
 data Tag = Tag Text (Maybe Text) deriving (Show, Generic, Binary, Eq)
 
@@ -46,7 +46,7 @@ internalTags title provenance' =
       maybe
         []
         ( \provenance ->
-            [ Tag "createdAt" $ Just $ pack $ show $ utctDay provenance.date
+            [ Tag "createdAt" $ Just $ pack $ show $ utctDay provenance.first.date
             ]
         )
         provenance'
diff --git a/app/Main.hs b/app/Main.hs
index 3bb60e2..28a32bb 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -447,6 +447,7 @@ module Main where
 
 import Control.Applicative ((<|>))
 import Data.Function ((&))
+import Issue.Provenance qualified as I
 import Data.List (find, isPrefixOf)
 import Data.Maybe (catMaybes)
 import Data.Text qualified as T
@@ -610,13 +611,13 @@ main = do
                     keyword "in"
                       <+> value (T.pack issue.file <> ":" <> T.pack (show issue.start.row))
                   commit = fromProvenanceDef (keyword "via" <+> value (T.pack "HEAD")) $
-                    \I.Provenance {firstCommit} -> keyword "via" <+> value (T.take 7 firstCommit)
+                    \I.Provenance {first} -> keyword "via" <+> value (T.take 7 first.hash)
                   author = fromProvenance $
-                    \I.Provenance {authorName, authorEmail} ->
-                      ( keyword "by" <+> value (authorName <> " <" <> authorEmail <> ">")
+                    \I.Provenance {first} ->
+                      ( keyword "by" <+> value (first.author.name <> " <" <> first.author.email <> ">")
                       )
                   date' = fromProvenance $
-                    \I.Provenance {date} -> keyword "on" <+> value (show (utctDay date))
+                    \I.Provenance {first} -> keyword "on" <+> value (show (utctDay first.date))
 
                   fromProvenanceDef def = flip (maybe def) issue.provenance
                   fromProvenance = flip fmap issue.provenance
@@ -671,13 +672,13 @@ main = do
                            "HEAD"
                          Just provenance ->
                            "\nvia "
-                             ++ T.unpack provenance.firstCommit
+                             ++ T.unpack provenance.first.hash
                              ++ "\nby "
-                             ++ T.unpack provenance.authorName
+                             ++ T.unpack provenance.first.author.name
                              ++ " <"
-                             ++ T.unpack provenance.authorEmail
+                             ++ T.unpack provenance.first.author.email
                              ++ ">\nat "
-                             ++ show provenance.date
+                             ++ show provenance.first.date
                      )
                   ++ "\n\n"
           sh_