blob: 653ddbd59df371b365588c241e6e5a9a129a1d4f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
module Git
( withWorkingTree,
getCommitHashes,
getRootDir,
)
where
import Control.Exception (finally, throw)
import Data.ByteString.Lazy.Char8 qualified as LB8
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 Exception qualified as E
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
getCommitHashes :: IO (NonEmpty T.Text)
getCommitHashes = fromMaybe (throw E.NoCommits) . N.nonEmpty . reverse . T.lines . T.decodeUtf8 . LB8.toStrict <$> sh "git log --format=%H"
getRootDir :: IO FilePath
getRootDir = T.unpack . stripTrailingNL . T.decodeUtf8 . LB8.toStrict <$> sh (proc "git rev-parse --show-toplevel")
where
stripTrailingNL s = fromMaybe s $ T.stripSuffix "\n" s
|
