get the most commonly used commands building again

A quick benchmark of whereis shows not much speed improvement, maybe a
few percent. Profiling it found a hotspot, adds to todo.
This commit is contained in:
Joey Hess 2019-12-04 13:15:34 -04:00
parent 650a631ef8
commit b88f89c1ef
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
19 changed files with 137 additions and 108 deletions

View file

@ -6,6 +6,7 @@
-}
{-# LANGUAGE TupleSections, BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Command.Export where
@ -70,7 +71,7 @@ optParser _ = ExportOptions
-- To handle renames which swap files, the exported file is first renamed
-- to a stable temporary name based on the key.
exportTempName :: ExportKey -> ExportLocation
exportTempName ek = mkExportLocation $
exportTempName ek = mkExportLocation $ toRawFilePath $
".git-annex-tmp-content-" ++ serializeKey (asKey (ek))
seek :: ExportOptions -> CommandSeek
@ -258,9 +259,9 @@ startExport r db cvar allfilledvar ti = do
performExport r db ek af (Git.LsTree.sha ti) loc allfilledvar
)
where
loc = mkExportLocation f
loc = mkExportLocation (toRawFilePath f)
f = getTopFilePath (Git.LsTree.file ti)
af = AssociatedFile (Just f)
af = AssociatedFile (Just (toRawFilePath f))
notrecordedpresent ek = (||)
<$> liftIO (notElem loc <$> getExportedLocation db (asKey ek))
-- If content was removed from the remote, the export db
@ -316,14 +317,14 @@ startUnexport r db f shas = do
else starting ("unexport " ++ name r) (ActionItemOther (Just f')) $
performUnexport r db eks loc
where
loc = mkExportLocation f'
loc = mkExportLocation (toRawFilePath f')
f' = getTopFilePath f
startUnexport' :: Remote -> ExportHandle -> TopFilePath -> ExportKey -> CommandStart
startUnexport' r db f ek = starting ("unexport " ++ name r) (ActionItemOther (Just f')) $
performUnexport r db [ek] loc
where
loc = mkExportLocation f'
loc = mkExportLocation (toRawFilePath f')
f' = getTopFilePath f
-- Unlike a usual drop from a repository, this does not check that
@ -363,19 +364,19 @@ startRecoverIncomplete r db sha oldf
| otherwise = do
ek <- exportKey sha
let loc = exportTempName ek
starting ("unexport " ++ name r) (ActionItemOther (Just (fromExportLocation loc))) $ do
starting ("unexport " ++ name r) (ActionItemOther (Just (fromRawFilePath (fromExportLocation loc)))) $ do
liftIO $ removeExportedLocation db (asKey ek) oldloc
performUnexport r db [ek] loc
where
oldloc = mkExportLocation oldf'
oldloc = mkExportLocation (toRawFilePath oldf')
oldf' = getTopFilePath oldf
startMoveToTempName :: Remote -> ExportHandle -> TopFilePath -> ExportKey -> CommandStart
startMoveToTempName r db f ek = starting ("rename " ++ name r)
(ActionItemOther $ Just $ f' ++ " -> " ++ fromExportLocation tmploc)
(ActionItemOther $ Just $ f' ++ " -> " ++ fromRawFilePath (fromExportLocation tmploc))
(performRename r db ek loc tmploc)
where
loc = mkExportLocation f'
loc = mkExportLocation (toRawFilePath f')
f' = getTopFilePath f
tmploc = exportTempName ek
@ -383,10 +384,10 @@ startMoveFromTempName :: Remote -> ExportHandle -> ExportKey -> TopFilePath -> C
startMoveFromTempName r db ek f = do
let tmploc = exportTempName ek
stopUnless (liftIO $ elem tmploc <$> getExportedLocation db (asKey ek)) $
starting ("rename " ++ name r) (ActionItemOther (Just (fromExportLocation tmploc ++ " -> " ++ f'))) $
starting ("rename " ++ name r) (ActionItemOther (Just (fromRawFilePath (fromExportLocation tmploc) ++ " -> " ++ f'))) $
performRename r db ek tmploc loc
where
loc = mkExportLocation f'
loc = mkExportLocation (toRawFilePath f')
f' = getTopFilePath f
performRename :: Remote -> ExportHandle -> ExportKey -> ExportLocation -> ExportLocation -> CommandPerform
@ -468,7 +469,7 @@ filterPreferredContent r tree = logExportExcluded (uuid r) $ \logwriter -> do
-- Match filename relative to the
-- top of the tree.
let af = AssociatedFile $ Just $
getTopFilePath topf
toRawFilePath $ getTopFilePath topf
let mi = MatchingKey k af
ifM (checkMatcher' matcher mi mempty)
( return (Just ti)