chore: drop `Git.withWorkingTree`

1 files changed, 91 insertions, 16 deletions

diff --git a/app/Git.hs b/app/Git.hs
index 0b8a561..a3c82fa 100644
--- a/app/Git.hs
+++ b/app/Git.hs
@@ -1,36 +1,111 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module Git
   ( module Git.CommitHash,
-    withWorkingTree,
     getCommitHashes,
     getRootDir,
+    getChangedFilesOf,
+    Commit (..),
+    Author (..),
+    getCommitOf,
+    readTextFileOf,
   )
 where
 
-import Control.Exception (finally, throw)
-import Data.ByteString.Lazy.Char8 qualified as LB8
+import Control.Exception (throw, throwIO)
+import Data.Binary (Binary, Put, get, put)
+import Data.ByteString.Lazy qualified as LB
+import Data.Fixed (Pico)
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as N
 import Data.Maybe (fromMaybe)
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as T
+import Data.Text.Lazy qualified as LT
+import Data.Text.Lazy.Encoding qualified as LT
+import Data.Text.Lazy.IO qualified as LT
+import Data.Time.Calendar (Day (..), toModifiedJulianDay)
+import Data.Time.Clock (DiffTime, UTCTime (..), getCurrentTime, picosecondsToDiffTime)
 import Exception qualified as E
+import GHC.Generics (Generic)
 import Git.CommitHash
-import Process (proc, sh, sh_)
-import System.Directory (createDirectoryIfMissing)
-import System.FilePath (dropTrailingPathSeparator, takeDirectory)
-
--- | Runs an IO-action within a working tree.
-withWorkingTree :: FilePath -> T.Text -> IO a -> IO a
-withWorkingTree path hash action = do
-  createDirectoryIfMissing True (takeDirectory (dropTrailingPathSeparator path))
-  sh_ $ proc "git worktree add --quiet --detach % %" path hash
-  action `finally` do
-    sh_ $ proc "git worktree remove --force %" path
+import Process (proc, sh)
+import Prelude hiding (lines)
 
 getCommitHashes :: IO (NonEmpty T.Text)
-getCommitHashes = fromMaybe (throw E.NoCommits) . N.nonEmpty . reverse . T.lines . T.decodeUtf8 . LB8.toStrict <$> sh "git log --format=%H"
+getCommitHashes = fromMaybe (throw E.NoCommits) . N.nonEmpty . reverse . T.lines . T.decodeUtf8 . LB.toStrict <$> sh "git log --format=%H"
 
 getRootDir :: IO FilePath
-getRootDir = T.unpack . stripTrailingNL . T.decodeUtf8 . LB8.toStrict <$> sh (proc "git rev-parse --show-toplevel")
+getRootDir = T.unpack . stripTrailingNL . T.decodeUtf8 . LB.toStrict <$> sh (proc "git rev-parse --show-toplevel")
   where
     stripTrailingNL s = fromMaybe s $ T.stripSuffix "\n" s
+
+getChangedFilesOf :: CommitHash -> IO [FilePath]
+getChangedFilesOf WorkingTree = do
+  map T.unpack . T.lines . T.decodeUtf8 . LB.toStrict
+    <$> sh "git ls-files --modified"
+getChangedFilesOf (Commit hash) = do
+  map T.unpack . T.lines . T.decodeUtf8 . LB.toStrict
+    <$> sh (proc "git show -p --name-only --format= %" hash)
+
+data Commit = Commit'
+  { commitHash :: CommitHash,
+    date :: UTCTime,
+    author :: Author
+  }
+  deriving (Show, Generic, Binary, Eq)
+
+data Author = Author
+  { name :: T.Text,
+    email :: T.Text
+  }
+  deriving (Show, Generic, Binary, Eq)
+
+-- 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
+
+getCommitOf :: CommitHash -> IO Commit
+getCommitOf commitHash@WorkingTree = do
+  date <- getCurrentTime
+  authorName <- T.decodeUtf8 . LB.toStrict <$> sh "git config user.name"
+  authorEmail <- T.decodeUtf8 . LB.toStrict <$> sh "git config user.email"
+  pure
+    Commit'
+      { author = Author authorName authorEmail,
+        ..
+      }
+getCommitOf commitHash@(Commit hash) = do
+  ( T.splitOn "\NUL" . head . T.lines . T.decodeUtf8 . LB.toStrict
+      <$> sh
+        ( proc
+            "git show --quiet --format=%%ai%%x00%%ae%%x00%%an %"
+            hash
+        )
+    )
+    >>= \case
+      rawDate : authorEmail : authorName : _ ->
+        let date = read (T.unpack rawDate)
+         in pure
+              Commit'
+                { author = Author authorName authorEmail,
+                  ..
+                }
+      _ -> throwIO E.NoCommits
+
+readTextFileOf :: CommitHash -> FilePath -> IO LT.Text
+readTextFileOf WorkingTree filePath = LT.readFile filePath
+readTextFileOf (Commit hash) filePath =
+  LT.decodeUtf8 <$> sh (proc "git show %:%" hash filePath)