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:
parent
650a631ef8
commit
b88f89c1ef
19 changed files with 137 additions and 108 deletions
|
@ -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)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue