packages feed

git-annex 7.20191024 → 7.20191106

raw patch · 11 files changed

+207/−39 lines, 11 files

Files

Annex/Init.hs view
@@ -109,7 +109,7 @@ 		setVersion (fromMaybe defaultVersion mversion) 	configureSmudgeFilter 	showSideAction "scanning for unlocked files"-	scanUnlockedFiles True+	scanUnlockedFiles 	unlessM isBareRepo $ do 		hookWrite postCheckoutHook 		hookWrite postMergeHook
Annex/WorkTree.hs view
@@ -70,11 +70,12 @@  - when initializing/upgrading a v6+ mode repository.  -  - Also, the content for the unlocked file may already be present as- - an annex object. If so, make the unlocked file use that content- - when replacefiles is True.+ - an annex object. If so, populate the pointer file with it.+ - But if worktree file does not have a pointer file's content, it is left+ - as-is.  -}-scanUnlockedFiles :: Bool -> Annex ()-scanUnlockedFiles replacefiles = whenM (inRepo Git.Ref.headExists) $ do+scanUnlockedFiles :: Annex ()+scanUnlockedFiles = whenM (inRepo Git.Ref.headExists) $ do 	Database.Keys.runWriter $ 		liftIO . Database.Keys.SQL.dropAllAssociatedFiles 	(l, cleanup) <- inRepo $ Git.LsTree.lsTree Git.LsTree.LsTreeRecursive Git.Ref.headRef@@ -92,15 +93,18 @@ 		let tf = Git.LsTree.file i 		Database.Keys.runWriter $ 			liftIO . Database.Keys.SQL.addAssociatedFileFast (toIKey k) tf-		whenM (pure replacefiles <&&> inAnnex k) $ do+		whenM (inAnnex k) $ do 			f <- fromRepo $ fromTopFilePath tf-			destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus f-			ic <- replaceFile f $ \tmp ->-				linkFromAnnex k tmp destmode >>= \case-					LinkAnnexOk -> -						withTSDelta (liftIO . genInodeCache tmp)-					LinkAnnexNoop -> return Nothing-					LinkAnnexFailed -> liftIO $ do-						writePointerFile tmp k destmode-						return Nothing-			maybe noop (restagePointerFile (Restage True) f) ic+			liftIO (isPointerFile f) >>= \case+				Just k' | k' == k -> do+					destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus f+					ic <- replaceFile f $ \tmp ->+						linkFromAnnex k tmp destmode >>= \case+							LinkAnnexOk -> +								withTSDelta (liftIO . genInodeCache tmp)+							LinkAnnexNoop -> return Nothing+							LinkAnnexFailed -> liftIO $ do+								writePointerFile tmp k destmode+								return Nothing+					maybe noop (restagePointerFile (Restage True) f) ic+				_ -> noop
CHANGELOG view
@@ -1,3 +1,11 @@+git-annex (7.20191106) upstream; urgency=medium++  * init: Fix bug that lost modifications to unlocked files when init is+    re-ran in an already initialized repo.+  * benchmark: Add --databases to benchmark sqlite databases.++ -- Joey Hess <id@joeyh.name>  Wed, 06 Nov 2019 12:14:50 -0400+ git-annex (7.20191024) upstream; urgency=medium    * Changed git add/git commit -a default behavior back to what it was
Command/Benchmark.hs view
@@ -11,10 +11,11 @@  import Command import Types.Benchmark- #ifdef WITH_BENCHMARK+import Database.Benchmark+ import Criterion.Main-import Criterion.Main.Options (parseWith, Mode)+import Criterion.Main.Options (parseWith) #endif  cmd :: BenchmarkGenerator -> Command@@ -23,20 +24,26 @@ 	paramNothing 	(seek generator <$$> optParser) -#ifndef WITH_BENCHMARK-type Mode = ()-#endif--data BenchmarkOptions = BenchmarkOptions CmdParams Mode+data BenchmarkOptions +	= BenchmarkOptions CmdParams CriterionMode+	| BenchmarkDatabases CriterionMode  optParser :: CmdParamsDesc -> Parser BenchmarkOptions-optParser desc = BenchmarkOptions-	<$> cmdParams desc+optParser desc = benchmarkoptions <|> benchmarkdatabases+  where+	benchmarkoptions = BenchmarkOptions+		<$> cmdParams desc+		<*> criterionopts+	benchmarkdatabases = BenchmarkDatabases+		<$> criterionopts+		<* flag' () +			( long "databases"+			<> help "benchmark sqlite databases"+			) #ifdef WITH_BENCHMARK-	-- parse criterion's options-	<*> parseWith defaultConfig+	criterionopts = parseWith defaultConfig #else-	<*> pure ()+	criterionopts = pure () #endif  seek :: BenchmarkGenerator -> BenchmarkOptions -> CommandSeek@@ -44,6 +51,7 @@ seek generator (BenchmarkOptions ps mode) = do 	runner <- generator ps 	liftIO $ runMode mode [ bench (unwords ps) $ nfIO runner ]+seek _ (BenchmarkDatabases mode) = benchmarkDbs mode #else seek _ _ = giveup "git-annex is not built with benchmarking support" #endif
+ Database/Benchmark.hs view
@@ -0,0 +1,120 @@+{- git-annex database benchmarks+ -+ - Copyright 2016-2019 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++module Database.Benchmark (benchmarkDbs) where++import Annex.Common+import Types.Benchmark+#ifdef WITH_BENCHMARK+import qualified Database.Keys.SQL as SQL+import qualified Database.Queue as H+import Database.Init+import Database.Types+import Utility.Tmp.Dir+import Git.FilePath+import Types.Key++import Criterion.Main+import Control.Monad.IO.Class (liftIO)+import qualified Data.ByteString.Char8 as B8+import System.Random+#endif++benchmarkDbs :: CriterionMode -> Annex ()+#ifdef WITH_BENCHMARK+benchmarkDbs mode = withTmpDirIn "." "benchmark" $ \tmpdir -> do+	-- benchmark different sizes of databases+	dbs <- mapM (benchDb tmpdir)+		[ 1000+		, 10000+		-- , 100000+		]+	liftIO $ runMode mode+		[ bgroup "keys database" $ flip concatMap dbs $ \db ->+			[ getAssociatedFilesHitBench db+			, getAssociatedFilesMissBench db+			, getAssociatedKeyHitBench db+			, getAssociatedKeyMissBench db+			, addAssociatedFileOldBench db+			, addAssociatedFileNewBench db+			]+		]+#else+benchmarkDbs _ = error "not built with criterion, cannot benchmark"+#endif++#ifdef WITH_BENCHMARK++getAssociatedFilesHitBench :: BenchDb -> Benchmark+getAssociatedFilesHitBench (BenchDb h num) = bench ("getAssociatedFiles from " ++ show num ++ " (hit)") $ nfIO $ do+	n <- getStdRandom (randomR (1,num))+	SQL.getAssociatedFiles (toIKey (keyN n)) (SQL.ReadHandle h)++getAssociatedFilesMissBench :: BenchDb -> Benchmark+getAssociatedFilesMissBench (BenchDb h num) = bench ("getAssociatedFiles from " ++ show num ++ " (miss)") $ nfIO $+	SQL.getAssociatedFiles (toIKey keyMiss) (SQL.ReadHandle h)++getAssociatedKeyHitBench :: BenchDb -> Benchmark+getAssociatedKeyHitBench (BenchDb h num) = bench ("getAssociatedKey from " ++ show num ++ " (hit)") $ nfIO $ do+	n <- getStdRandom (randomR (1,num))+	-- fromIKey because this ends up being used to get a Key+	map fromIKey <$> SQL.getAssociatedKey (fileN n) (SQL.ReadHandle h)++getAssociatedKeyMissBench :: BenchDb -> Benchmark+getAssociatedKeyMissBench (BenchDb h num) = bench ("getAssociatedKey from " ++ show num ++ " (miss)") $ nfIO $+	-- fromIKey because this ends up being used to get a Key+	map fromIKey <$> SQL.getAssociatedKey fileMiss (SQL.ReadHandle h)++addAssociatedFileOldBench :: BenchDb -> Benchmark+addAssociatedFileOldBench (BenchDb h num) = bench ("addAssociatedFile to " ++ show num ++ " (old)") $ nfIO $ do+	n <- getStdRandom (randomR (1,num))+	SQL.addAssociatedFile (toIKey (keyN n)) (fileN n) (SQL.WriteHandle h)+	H.flushDbQueue h++addAssociatedFileNewBench :: BenchDb -> Benchmark+addAssociatedFileNewBench (BenchDb h num) = bench ("addAssociatedFile to " ++ show num ++ " (new)") $ nfIO $ do+	n <- getStdRandom (randomR (1,num))+	SQL.addAssociatedFile (toIKey (keyN n)) (fileN (n+1)) (SQL.WriteHandle h)+	H.flushDbQueue h++populateAssociatedFiles :: H.DbQueue -> Int -> IO ()+populateAssociatedFiles h num = do+	forM_ [1..num] $ \n ->+		SQL.addAssociatedFile (toIKey (keyN n)) (fileN n) (SQL.WriteHandle h)+	H.flushDbQueue h++keyN :: Int -> Key+keyN n = stubKey+	{ keyName = B8.pack $ "key" ++ show n+	, keyVariety = OtherKey "BENCH"+	}++fileN :: Int -> TopFilePath+fileN n = asTopFilePath ("file" ++ show n)++keyMiss :: Key+keyMiss = keyN 0 -- 0 is never stored++fileMiss :: TopFilePath+fileMiss = fileN 0 -- 0 is never stored++data BenchDb = BenchDb H.DbQueue Int++benchDb :: FilePath -> Int -> Annex BenchDb+benchDb tmpdir num = do+	liftIO $ putStrLn $ "setting up database with " ++ show num+	initDb db SQL.createTables+	h <- liftIO $ H.openDbQueue H.MultiWriter db SQL.containedTable+	liftIO $ populateAssociatedFiles h num+	return (BenchDb h num)+  where+	db = tmpdir </> show num </> "db"++#endif /* WITH_BENCHMARK */
Database/Types.hs view
@@ -17,6 +17,7 @@ import Data.Char import qualified Data.ByteString as S import qualified Data.Text as T+import Control.DeepSeq  import Utility.PartialPrelude import Key@@ -40,6 +41,9 @@ -- A Key index. More efficient than SKey, but its Read instance does not -- work when it's used in any kind of complex data structure. newtype IKey = IKey String++instance NFData IKey where+	rnf (IKey s) = rnf s  instance Read IKey where 	readsPrec _ s = [(IKey s, "")]
Git/FilePath.hs view
@@ -11,6 +11,7 @@  -}  {-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}  module Git.FilePath ( 	TopFilePath,@@ -30,10 +31,14 @@ import Git  import qualified System.FilePath.Posix+import GHC.Generics+import Control.DeepSeq  {- A FilePath, relative to the top of the git repository. -} newtype TopFilePath = TopFilePath { getTopFilePath :: FilePath }-	deriving (Show, Eq, Ord)+	deriving (Show, Eq, Ord, Generic)++instance NFData TopFilePath  {- A file in a branch or other treeish. -} data BranchFilePath = BranchFilePath Ref TopFilePath
Types/Benchmark.hs view
@@ -5,11 +5,22 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE CPP #-}+ module Types.Benchmark where  import Annex import Types.Command+#ifdef WITH_BENCHMARK+import Criterion.Main.Options (Mode)+#endif  type BenchmarkGenerator = [String] -> Annex (IO ())  type MkBenchmarkGenerator = [Command] -> BenchmarkGenerator++#ifdef WITH_BENCHMARK+type CriterionMode = Mode+#else+type CriterionMode = ()+#endif
Types/Key.hs view
@@ -5,7 +5,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}  module Types.Key where @@ -13,6 +13,8 @@ import qualified Data.ByteString.Char8 as S8 import System.Posix.Types import Data.Monoid+import GHC.Generics+import Control.DeepSeq import Prelude  {- A Key has a unique name, which is derived from a particular backend,@@ -24,8 +26,10 @@ 	, keyMtime :: Maybe EpochTime 	, keyChunkSize :: Maybe Integer 	, keyChunkNum :: Maybe Integer-	} deriving (Eq, Ord, Read, Show)+	} deriving (Eq, Ord, Read, Show, Generic) +instance NFData Key+ {- A filename may be associated with a Key. -} newtype AssociatedFile = AssociatedFile (Maybe FilePath) 	deriving (Show, Eq, Ord)@@ -46,15 +50,21 @@  	-- Some repositories may contain keys of other varieties, 	-- which can still be processed to some extent. 	| OtherKey S.ByteString-	deriving (Eq, Ord, Read, Show)+	deriving (Eq, Ord, Read, Show, Generic) +instance NFData KeyVariety+ {- Some varieties of keys may contain an extension at the end of the  - keyName -} newtype HasExt = HasExt Bool-	deriving (Eq, Ord, Read, Show)+	deriving (Eq, Ord, Read, Show, Generic) +instance NFData HasExt+ newtype HashSize = HashSize Int-	deriving (Eq, Ord, Read, Show)+	deriving (Eq, Ord, Read, Show, Generic)++instance NFData HashSize  hasExt :: KeyVariety -> Bool hasExt (SHA2Key _ (HasExt b)) = b
Upgrade/V5.hs view
@@ -42,13 +42,10 @@ 		( do 			checkGitVersionForDirectUpgrade 			convertDirect-			-- Worktree files are already populated, so don't-			-- have this try to populate them again.-			scanUnlockedFiles False 		, do 			checkGitVersionForIndirectUpgrade-			scanUnlockedFiles True 		)+	scanUnlockedFiles 	configureSmudgeFilter 	-- Inode sentinal file was only used in direct mode and when 	-- locking down files as they were added. In v6, it's used more
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 7.20191024+Version: 7.20191106 Cabal-Version: >= 1.8 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -813,6 +813,7 @@     Config.Smudge     Creds     Crypto+    Database.Benchmark     Database.ContentIdentifier     Database.Export     Database.Fsck