refactor `Issue.Provenance` from `Issue`

1 files changed, 3 insertions, 52 deletions

diff --git a/app/Issue.hs b/app/Issue.hs
index f7895af..75e700d 100644
--- a/app/Issue.hs
+++ b/app/Issue.hs
@@ -1,22 +1,14 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 module Issue (Issue (..), Provenance (..), fromMatch, id) where
 
-import Data.Binary (Binary, Put, get, put)
-import Data.ByteString.Lazy (toStrict)
-import Data.Fixed (Pico)
-import Data.Function ((&))
+import Data.Binary (Binary)
 import Data.List (find, foldl')
 import Data.Text (Text)
 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 GHC.Generics (Generic)
+import Issue.Provenance (Provenance (..), provenanceFromHEAD)
 import Issue.Tag (Tag (..))
 import Issue.Tag qualified as I
 import Issue.Text qualified as I
-import Process (sh)
-import System.Process.Typed (setWorkingDir)
 import TreeGrepper.Match (Match (..))
 import TreeGrepper.Match qualified as G
 import TreeGrepper.Result (Result (..))
@@ -35,30 +27,6 @@ data Issue = Issue
   }
   deriving (Show, Binary, Generic)
 
-data Provenance = Provenance
-  { firstCommit :: Text,
-    date :: UTCTime,
-    authorEmail :: Text,
-    authorName :: Text
-  }
-  deriving (Show, Generic, Binary)
-
--- XXX These are taken from `Data.Binary.Orphans` [1]. I cannot get importing
--- the instance from the package to work.. so we use `-fno-warn-orphans` here.
---
--- [1] https://hackage.haskell.org/package/binary-orphans-0.1.5.1/docs/src/Data-Binary-Orphans.html#line-132
-instance Binary UTCTime where
-  get = UTCTime <$> get <*> get
-  put (UTCTime d dt) = put d >> put dt
-
-instance Binary Day where
-  get = fmap ModifiedJulianDay get
-  put = put . toModifiedJulianDay
-
-instance Binary DiffTime where
-  get = fmap picosecondsToDiffTime get
-  put = (put :: Pico -> Put) . realToFrac
-
 id :: Issue -> Maybe String
 id issue =
   (\(Tag _ v) -> T.unpack v)
@@ -68,24 +36,7 @@ id issue =
 
 fromMatch :: FilePath -> G.Result -> G.Match -> IO (Maybe Issue)
 fromMatch cwd result match = do
-  rawProvenance <-
-    fmap (T.splitOn "\NUL" . head . T.lines . decodeUtf8 . toStrict) $
-      sh $
-        "git show --quiet --format='%H%x00%ai%x00%ae%x00%an'"
-          & setWorkingDir cwd
-  let provenance =
-        case rawProvenance of
-          firstCommit' : rawDate : authorEmail : authorName : _ ->
-            let date = read (T.unpack rawDate)
-             in Just
-                  Provenance
-                    { firstCommit = firstCommit',
-                      date = date,
-                      authorEmail = authorEmail,
-                      authorName = authorName
-                    }
-          _ ->
-            Nothing
+  provenance <- provenanceFromHEAD cwd
 
   pure
     ( if any (\marker -> T.isPrefixOf marker title') issueMarkers