git-remote-annex: incremental pushing

Untested

Sponsored-by: Joshua Antonishen on Patreon

Git/Bundle.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Git.Bundle where
 
 import Common
@@ -24,15 +26,43 @@ listHeads bundle repo = map gen . S8.lines <$>
 unbundle :: FilePath -> Repo -> IO ()
 unbundle bundle = runQuiet [Param "bundle", Param "unbundle", File bundle]
 
-create :: FilePath -> [Ref] -> Repo -> IO ()
-create bundle refs repo = pipeWrite
+-- 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 writerefs
+	] repo writer
   where
-	writerefs h = do
-		mapM_ (S8.hPutStrLn h . fromRef') refs
+	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