git-annex 7.20191024 → 7.20191106
raw patch · 11 files changed
+207/−39 lines, 11 files
Files
- Annex/Init.hs +1/−1
- Annex/WorkTree.hs +19/−15
- CHANGELOG +8/−0
- Command/Benchmark.hs +20/−12
- Database/Benchmark.hs +120/−0
- Database/Types.hs +4/−0
- Git/FilePath.hs +6/−1
- Types/Benchmark.hs +11/−0
- Types/Key.hs +15/−5
- Upgrade/V5.hs +1/−4
- git-annex.cabal +2/−1
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