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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
{- git bundles
-
- Copyright 2024 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Git.Bundle where
import Common
import Git
import Git.Command
import qualified Git.Version
import Data.Char (ord)
import qualified Data.ByteString.Char8 as S8
-- Older versions of git had a git bundle command that sometimes omitted
-- refs, and that did not properly support --stdin.
versionSupported :: IO Bool
versionSupported = not <$> Git.Version.older "2.31"
listHeads :: FilePath -> Repo -> IO [(Sha, Ref)]
listHeads bundle repo = map gen . S8.lines <$>
pipeReadStrict [Param "bundle", Param "list-heads", File bundle] repo
where
gen l = let (s, r) = separate' (== fromIntegral (ord ' ')) l
in (Ref s, Ref r)
unbundle :: FilePath -> Repo -> IO ()
unbundle bundle = runQuiet [Param "bundle", Param "unbundle", File bundle]
-- Specifies what to include in the bundle.
data BundleSpec = BundleSpec
{ preRequisiteRef :: Maybe Ref
-- ^ Do not include this Ref, or any objects reachable from it
-- in the bundle. This should be an ancestor of the includeRef.
, includeRef :: Ref
-- ^ Include this Ref and objects reachable from it in the bundle,
-- unless filtered out by the preRequisiteRef of this BundleSpec
-- or any other one that is included in the bundle.
}
deriving (Show)
-- Include the ref and all objects reachable from it in the bundle.
-- (Unless another BundleSpec is included that has a preRequisiteRef
-- that filters out the ref or other objects.)
fullBundleSpec :: Ref -> BundleSpec
fullBundleSpec r = BundleSpec
{ preRequisiteRef = Nothing
, includeRef = r
}
create :: FilePath -> [BundleSpec] -> Repo -> IO ()
create bundle revs repo = pipeWrite
[ Param "bundle"
, Param "create"
, Param "--quiet"
, File bundle
, Param "--stdin"
] repo writer
where
writer h = do
forM_ revs $ \bs ->
case preRequisiteRef bs of
Nothing -> S8.hPutStrLn h $
fromRef' (includeRef bs)
Just pr -> S8.hPutStrLn h $
fromRef' pr
<> ".." <>
fromRef' (includeRef bs)
hClose h
|
