more RawFilePath
Remove dup definitions and just use the RawFilePath one. </> etc are enough faster that it's probably faster than building a String directly, although I have not benchmarked.
This commit is contained in:
Joey Hess
parent
9e9def2dc0
commit
686791c4ed
26 changed files with 140 additions and 120 deletions
|
|
@ -91,6 +91,8 @@ import Annex.Concurrent
|
|||
import Types.WorkerPool
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
import qualified System.FilePath.ByteString as P
|
||||
|
||||
{- Checks if a given key's content is currently present. -}
|
||||
inAnnex :: Key -> Annex Bool
|
||||
inAnnex key = inAnnexCheck key $ liftIO . R.doesPathExist
|
||||
|
|
@ -742,7 +744,7 @@ listKeys keyloc = do
|
|||
if depth < 2
|
||||
then do
|
||||
contents' <- filterM (present s) contents
|
||||
let keys = mapMaybe (fileKey . takeFileName) contents'
|
||||
let keys = mapMaybe (fileKey . P.takeFileName . toRawFilePath) contents'
|
||||
continue keys []
|
||||
else do
|
||||
let deeper = walk s (depth - 1)
|
||||
|
|
@ -816,7 +818,7 @@ dirKeys dirspec = do
|
|||
contents <- liftIO $ getDirectoryContents dir
|
||||
files <- liftIO $ filterM doesFileExist $
|
||||
map (dir </>) contents
|
||||
return $ mapMaybe (fileKey . takeFileName) files
|
||||
return $ mapMaybe (fileKey . P.takeFileName . toRawFilePath) files
|
||||
, return []
|
||||
)
|
||||
|
||||
|
|
@ -835,7 +837,8 @@ staleKeysPrune dirspec nottransferred = do
|
|||
|
||||
dir <- fromRepo dirspec
|
||||
forM_ dups $ \k ->
|
||||
pruneTmpWorkDirBefore (dir </> keyFile k) (liftIO . removeFile)
|
||||
pruneTmpWorkDirBefore (dir </> fromRawFilePath (keyFile k))
|
||||
(liftIO . removeFile)
|
||||
|
||||
if nottransferred
|
||||
then do
|
||||
|
|
|
|||
|
|
@ -128,7 +128,7 @@ checkDiskSpace' need destdir key alreadythere samefilesystem = ifM (Annex.getSta
|
|||
_ -> return True
|
||||
)
|
||||
where
|
||||
dir = maybe (fromRepo gitAnnexDir) return destdir
|
||||
dir = maybe (fromRawFilePath <$> fromRepo gitAnnexDir) return destdir
|
||||
|
||||
needMoreDiskSpace :: Integer -> String
|
||||
needMoreDiskSpace n = "not enough free space, need " ++
|
||||
|
|
|
|||
|
|
@ -253,7 +253,7 @@ parseLinkTargetOrPointerLazy b =
|
|||
{- Parses a symlink target to a Key. -}
|
||||
parseLinkTarget :: S.ByteString -> Maybe Key
|
||||
parseLinkTarget l
|
||||
| isLinkToAnnex l = fileKey' $ snd $ S8.breakEnd pathsep l
|
||||
| isLinkToAnnex l = fileKey $ snd $ S8.breakEnd pathsep l
|
||||
| otherwise = Nothing
|
||||
where
|
||||
pathsep '/' = True
|
||||
|
|
@ -263,9 +263,9 @@ parseLinkTarget l
|
|||
pathsep _ = False
|
||||
|
||||
formatPointer :: Key -> S.ByteString
|
||||
formatPointer k = prefix <> keyFile' k <> nl
|
||||
formatPointer k = prefix <> keyFile k <> nl
|
||||
where
|
||||
prefix = toInternalGitPath $ toRawFilePath (pathSeparator:objectDir)
|
||||
prefix = toInternalGitPath $ P.pathSeparator `S.cons` objectDir'
|
||||
nl = S8.singleton '\n'
|
||||
|
||||
{- Maximum size of a file that could be a pointer to a key.
|
||||
|
|
|
|||
|
|
@ -9,9 +9,7 @@
|
|||
|
||||
module Annex.Locations (
|
||||
keyFile,
|
||||
keyFile',
|
||||
fileKey,
|
||||
fileKey',
|
||||
keyPaths,
|
||||
keyPath,
|
||||
annexDir,
|
||||
|
|
@ -124,19 +122,16 @@ import qualified Utility.RawFilePath as R
|
|||
|
||||
{- The directory git annex uses for local state, relative to the .git
|
||||
- directory -}
|
||||
annexDir :: FilePath
|
||||
annexDir = addTrailingPathSeparator "annex"
|
||||
|
||||
annexDir' :: RawFilePath
|
||||
annexDir' = P.addTrailingPathSeparator "annex"
|
||||
annexDir :: RawFilePath
|
||||
annexDir = P.addTrailingPathSeparator "annex"
|
||||
|
||||
{- The directory git annex uses for locally available object content,
|
||||
- relative to the .git directory -}
|
||||
objectDir :: FilePath
|
||||
objectDir = addTrailingPathSeparator $ annexDir </> "objects"
|
||||
objectDir = fromRawFilePath objectDir'
|
||||
|
||||
objectDir' :: RawFilePath
|
||||
objectDir' = P.addTrailingPathSeparator $ annexDir' P.</> "objects"
|
||||
objectDir' = P.addTrailingPathSeparator $ annexDir P.</> "objects"
|
||||
|
||||
{- Annexed file's possible locations relative to the .git directory.
|
||||
- There are two different possibilities, using different hashes.
|
||||
|
|
@ -260,46 +255,51 @@ gitAnnexInodeCache key r config = do
|
|||
return $ fromRawFilePath loc ++ ".cache"
|
||||
|
||||
gitAnnexInodeSentinal :: Git.Repo -> RawFilePath
|
||||
gitAnnexInodeSentinal r = gitAnnexDir' r P.</> "sentinal"
|
||||
gitAnnexInodeSentinal r = gitAnnexDir r P.</> "sentinal"
|
||||
|
||||
gitAnnexInodeSentinalCache :: Git.Repo -> RawFilePath
|
||||
gitAnnexInodeSentinalCache r = gitAnnexInodeSentinal r <> ".cache"
|
||||
|
||||
{- The annex directory of a repository. -}
|
||||
gitAnnexDir :: Git.Repo -> FilePath
|
||||
gitAnnexDir r = addTrailingPathSeparator $ fromRawFilePath (Git.localGitDir r) </> annexDir
|
||||
|
||||
gitAnnexDir' :: Git.Repo -> RawFilePath
|
||||
gitAnnexDir' r = P.addTrailingPathSeparator $ Git.localGitDir r P.</> annexDir'
|
||||
gitAnnexDir :: Git.Repo -> RawFilePath
|
||||
gitAnnexDir r = P.addTrailingPathSeparator $ Git.localGitDir r P.</> annexDir
|
||||
|
||||
{- The part of the annex directory where file contents are stored. -}
|
||||
gitAnnexObjectDir :: Git.Repo -> FilePath
|
||||
gitAnnexObjectDir r = addTrailingPathSeparator $ fromRawFilePath (Git.localGitDir r) </> objectDir
|
||||
gitAnnexObjectDir r = fromRawFilePath $
|
||||
P.addTrailingPathSeparator $ Git.localGitDir r P.</> objectDir'
|
||||
|
||||
{- .git/annex/tmp/ is used for temp files for key's contents -}
|
||||
gitAnnexTmpObjectDir :: Git.Repo -> FilePath
|
||||
gitAnnexTmpObjectDir r = addTrailingPathSeparator $ gitAnnexDir r </> "tmp"
|
||||
gitAnnexTmpObjectDir = fromRawFilePath . gitAnnexTmpObjectDir'
|
||||
|
||||
gitAnnexTmpObjectDir' :: Git.Repo -> RawFilePath
|
||||
gitAnnexTmpObjectDir' r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "tmp"
|
||||
|
||||
{- .git/annex/othertmp/ is used for other temp files -}
|
||||
gitAnnexTmpOtherDir :: Git.Repo -> FilePath
|
||||
gitAnnexTmpOtherDir r = addTrailingPathSeparator $ gitAnnexDir r </> "othertmp"
|
||||
gitAnnexTmpOtherDir r = fromRawFilePath $
|
||||
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "othertmp"
|
||||
|
||||
{- Lock file for gitAnnexTmpOtherDir. -}
|
||||
gitAnnexTmpOtherLock :: Git.Repo -> FilePath
|
||||
gitAnnexTmpOtherLock r = gitAnnexDir r </> "othertmp.lck"
|
||||
gitAnnexTmpOtherLock r = fromRawFilePath $ gitAnnexDir r P.</> "othertmp.lck"
|
||||
|
||||
{- .git/annex/misctmp/ was used by old versions of git-annex and is still
|
||||
- used during initialization -}
|
||||
gitAnnexTmpOtherDirOld :: Git.Repo -> FilePath
|
||||
gitAnnexTmpOtherDirOld r = addTrailingPathSeparator $ gitAnnexDir r </> "misctmp"
|
||||
gitAnnexTmpOtherDirOld r = fromRawFilePath $
|
||||
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "misctmp"
|
||||
|
||||
{- .git/annex/watchtmp/ is used by the watcher and assistant -}
|
||||
gitAnnexTmpWatcherDir :: Git.Repo -> FilePath
|
||||
gitAnnexTmpWatcherDir r = addTrailingPathSeparator $ gitAnnexDir r </> "watchtmp"
|
||||
gitAnnexTmpWatcherDir r = fromRawFilePath $
|
||||
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "watchtmp"
|
||||
|
||||
{- The temp file to use for a given key's content. -}
|
||||
gitAnnexTmpObjectLocation :: Key -> Git.Repo -> FilePath
|
||||
gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r </> keyFile key
|
||||
gitAnnexTmpObjectLocation key r = fromRawFilePath $
|
||||
gitAnnexTmpObjectDir' r P.</> keyFile key
|
||||
|
||||
{- Given a temp file such as gitAnnexTmpObjectLocation, makes a name for a
|
||||
- subdirectory in the same location, that can be used as a work area
|
||||
|
|
@ -316,19 +316,21 @@ gitAnnexTmpWorkDir p =
|
|||
|
||||
{- .git/annex/bad/ is used for bad files found during fsck -}
|
||||
gitAnnexBadDir :: Git.Repo -> FilePath
|
||||
gitAnnexBadDir r = addTrailingPathSeparator $ gitAnnexDir r </> "bad"
|
||||
gitAnnexBadDir r = fromRawFilePath $
|
||||
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "bad"
|
||||
|
||||
{- The bad file to use for a given key. -}
|
||||
gitAnnexBadLocation :: Key -> Git.Repo -> FilePath
|
||||
gitAnnexBadLocation key r = gitAnnexBadDir r </> keyFile key
|
||||
gitAnnexBadLocation key r = gitAnnexBadDir r </> fromRawFilePath (keyFile key)
|
||||
|
||||
{- .git/annex/foounused is used to number possibly unused keys -}
|
||||
gitAnnexUnusedLog :: FilePath -> Git.Repo -> FilePath
|
||||
gitAnnexUnusedLog prefix r = gitAnnexDir r </> (prefix ++ "unused")
|
||||
gitAnnexUnusedLog prefix r =
|
||||
fromRawFilePath (gitAnnexDir r) </> (prefix ++ "unused")
|
||||
|
||||
{- .git/annex/keys/ contains a database of information about keys. -}
|
||||
gitAnnexKeysDb :: Git.Repo -> FilePath
|
||||
gitAnnexKeysDb r = gitAnnexDir r </> "keys"
|
||||
gitAnnexKeysDb r = fromRawFilePath $ gitAnnexDir r P.</> "keys"
|
||||
|
||||
{- Lock file for the keys database. -}
|
||||
gitAnnexKeysDbLock :: Git.Repo -> FilePath
|
||||
|
|
@ -342,7 +344,8 @@ gitAnnexKeysDbIndexCache r = gitAnnexKeysDb r ++ ".cache"
|
|||
{- .git/annex/fsck/uuid/ is used to store information about incremental
|
||||
- fscks. -}
|
||||
gitAnnexFsckDir :: UUID -> Git.Repo -> FilePath
|
||||
gitAnnexFsckDir u r = gitAnnexDir r </> "fsck" </> fromUUID u
|
||||
gitAnnexFsckDir u r = fromRawFilePath $
|
||||
gitAnnexDir r P.</> "fsck" P.</> fromUUID u
|
||||
|
||||
{- used to store information about incremental fscks. -}
|
||||
gitAnnexFsckState :: UUID -> Git.Repo -> FilePath
|
||||
|
|
@ -358,20 +361,21 @@ gitAnnexFsckDbLock u r = gitAnnexFsckDir u r </> "fsck.lck"
|
|||
|
||||
{- .git/annex/fsckresults/uuid is used to store results of git fscks -}
|
||||
gitAnnexFsckResultsLog :: UUID -> Git.Repo -> FilePath
|
||||
gitAnnexFsckResultsLog u r = gitAnnexDir r </> "fsckresults" </> fromUUID u
|
||||
gitAnnexFsckResultsLog u r = fromRawFilePath $
|
||||
gitAnnexDir r P.</> "fsckresults" P.</> fromUUID u
|
||||
|
||||
{- .git/annex/smudge.log is used to log smudges worktree files that need to
|
||||
- be updated. -}
|
||||
gitAnnexSmudgeLog :: Git.Repo -> FilePath
|
||||
gitAnnexSmudgeLog r = gitAnnexDir r </> "smudge.log"
|
||||
gitAnnexSmudgeLog r = fromRawFilePath $ gitAnnexDir r P.</> "smudge.log"
|
||||
|
||||
gitAnnexSmudgeLock :: Git.Repo -> FilePath
|
||||
gitAnnexSmudgeLock r = gitAnnexDir r </> "smudge.lck"
|
||||
gitAnnexSmudgeLock r = fromRawFilePath $ gitAnnexDir r P.</> "smudge.lck"
|
||||
|
||||
{- .git/annex/export/uuid/ is used to store information about
|
||||
- exports to special remotes. -}
|
||||
gitAnnexExportDir :: UUID -> Git.Repo -> FilePath
|
||||
gitAnnexExportDir u r = gitAnnexDir r </> "export" </> fromUUID u
|
||||
gitAnnexExportDir u r = fromRawFilePath (gitAnnexDir r) </> "export" </> fromUUID u
|
||||
|
||||
{- Directory containing database used to record export info. -}
|
||||
gitAnnexExportDbDir :: UUID -> Git.Repo -> FilePath
|
||||
|
|
@ -388,7 +392,8 @@ gitAnnexExportUpdateLock u r = gitAnnexExportDbDir u r ++ ".upl"
|
|||
{- Log file used to keep track of files that were in the tree exported to a
|
||||
- remote, but were excluded by its preferred content settings. -}
|
||||
gitAnnexExportExcludeLog :: UUID -> Git.Repo -> FilePath
|
||||
gitAnnexExportExcludeLog u r = gitAnnexDir r </> "export.ex" </> fromUUID u
|
||||
gitAnnexExportExcludeLog u r = fromRawFilePath $
|
||||
gitAnnexDir r P.</> "export.ex" P.</> fromUUID u
|
||||
|
||||
{- Directory containing database used to record remote content ids.
|
||||
-
|
||||
|
|
@ -396,7 +401,7 @@ gitAnnexExportExcludeLog u r = gitAnnexDir r </> "export.ex" </> fromUUID u
|
|||
- need to be rebuilt with a new name.)
|
||||
-}
|
||||
gitAnnexContentIdentifierDbDir :: Git.Repo -> FilePath
|
||||
gitAnnexContentIdentifierDbDir r = gitAnnexDir r </> "cids"
|
||||
gitAnnexContentIdentifierDbDir r = fromRawFilePath $ gitAnnexDir r P.</> "cids"
|
||||
|
||||
{- Lock file for writing to the content id database. -}
|
||||
gitAnnexContentIdentifierLock :: Git.Repo -> FilePath
|
||||
|
|
@ -405,128 +410,137 @@ gitAnnexContentIdentifierLock r = gitAnnexContentIdentifierDbDir r ++ ".lck"
|
|||
{- .git/annex/schedulestate is used to store information about when
|
||||
- scheduled jobs were last run. -}
|
||||
gitAnnexScheduleState :: Git.Repo -> FilePath
|
||||
gitAnnexScheduleState r = gitAnnexDir r </> "schedulestate"
|
||||
gitAnnexScheduleState r = fromRawFilePath $ gitAnnexDir r P.</> "schedulestate"
|
||||
|
||||
{- .git/annex/creds/ is used to store credentials to access some special
|
||||
- remotes. -}
|
||||
gitAnnexCredsDir :: Git.Repo -> FilePath
|
||||
gitAnnexCredsDir r = addTrailingPathSeparator $ gitAnnexDir r </> "creds"
|
||||
gitAnnexCredsDir r = fromRawFilePath $
|
||||
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "creds"
|
||||
|
||||
{- .git/annex/certificate.pem and .git/annex/key.pem are used by the webapp
|
||||
- when HTTPS is enabled -}
|
||||
gitAnnexWebCertificate :: Git.Repo -> FilePath
|
||||
gitAnnexWebCertificate r = gitAnnexDir r </> "certificate.pem"
|
||||
gitAnnexWebCertificate r = fromRawFilePath $ gitAnnexDir r P.</> "certificate.pem"
|
||||
gitAnnexWebPrivKey :: Git.Repo -> FilePath
|
||||
gitAnnexWebPrivKey r = gitAnnexDir r </> "privkey.pem"
|
||||
gitAnnexWebPrivKey r = fromRawFilePath $ gitAnnexDir r P.</> "privkey.pem"
|
||||
|
||||
{- .git/annex/feeds/ is used to record per-key (url) state by importfeeds -}
|
||||
gitAnnexFeedStateDir :: Git.Repo -> FilePath
|
||||
gitAnnexFeedStateDir r = addTrailingPathSeparator $ gitAnnexDir r </> "feedstate"
|
||||
gitAnnexFeedStateDir r = fromRawFilePath $
|
||||
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "feedstate"
|
||||
|
||||
gitAnnexFeedState :: Key -> Git.Repo -> FilePath
|
||||
gitAnnexFeedState k r = gitAnnexFeedStateDir r </> keyFile k
|
||||
gitAnnexFeedState k r = gitAnnexFeedStateDir r </> fromRawFilePath (keyFile k)
|
||||
|
||||
{- .git/annex/merge/ is used as a empty work tree for direct mode merges and
|
||||
- merges in adjusted branches. -}
|
||||
gitAnnexMergeDir :: Git.Repo -> FilePath
|
||||
gitAnnexMergeDir r = addTrailingPathSeparator $ gitAnnexDir r </> "merge"
|
||||
gitAnnexMergeDir r = fromRawFilePath $
|
||||
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "merge"
|
||||
|
||||
{- .git/annex/transfer/ is used to record keys currently
|
||||
- being transferred, and other transfer bookkeeping info. -}
|
||||
gitAnnexTransferDir :: Git.Repo -> FilePath
|
||||
gitAnnexTransferDir r = addTrailingPathSeparator $ gitAnnexDir r </> "transfer"
|
||||
gitAnnexTransferDir r = fromRawFilePath $
|
||||
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "transfer"
|
||||
|
||||
{- .git/annex/journal/ is used to journal changes made to the git-annex
|
||||
- branch -}
|
||||
gitAnnexJournalDir :: Git.Repo -> FilePath
|
||||
gitAnnexJournalDir r = addTrailingPathSeparator $ gitAnnexDir r </> "journal"
|
||||
gitAnnexJournalDir r = fromRawFilePath $
|
||||
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "journal"
|
||||
|
||||
gitAnnexJournalDir' :: Git.Repo -> RawFilePath
|
||||
gitAnnexJournalDir' r = P.addTrailingPathSeparator $ gitAnnexDir' r P.</> "journal"
|
||||
gitAnnexJournalDir' r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "journal"
|
||||
|
||||
{- Lock file for the journal. -}
|
||||
gitAnnexJournalLock :: Git.Repo -> FilePath
|
||||
gitAnnexJournalLock r = gitAnnexDir r </> "journal.lck"
|
||||
gitAnnexJournalLock r = fromRawFilePath $ gitAnnexDir r P.</> "journal.lck"
|
||||
|
||||
{- Lock file for flushing a git queue that writes to the git index or
|
||||
- other git state that should only have one writer at a time. -}
|
||||
gitAnnexGitQueueLock :: Git.Repo -> FilePath
|
||||
gitAnnexGitQueueLock r = gitAnnexDir r </> "gitqueue.lck"
|
||||
gitAnnexGitQueueLock r = fromRawFilePath $ gitAnnexDir r P.</> "gitqueue.lck"
|
||||
|
||||
{- Lock file for the pre-commit hook. -}
|
||||
gitAnnexPreCommitLock :: Git.Repo -> FilePath
|
||||
gitAnnexPreCommitLock r = gitAnnexDir r </> "precommit.lck"
|
||||
gitAnnexPreCommitLock r = fromRawFilePath $ gitAnnexDir r P.</> "precommit.lck"
|
||||
|
||||
{- Lock file for direct mode merge. -}
|
||||
gitAnnexMergeLock :: Git.Repo -> FilePath
|
||||
gitAnnexMergeLock r = gitAnnexDir r </> "merge.lck"
|
||||
gitAnnexMergeLock r = fromRawFilePath $ gitAnnexDir r P.</> "merge.lck"
|
||||
|
||||
{- .git/annex/index is used to stage changes to the git-annex branch -}
|
||||
gitAnnexIndex :: Git.Repo -> FilePath
|
||||
gitAnnexIndex r = gitAnnexDir r </> "index"
|
||||
gitAnnexIndex r = fromRawFilePath $ gitAnnexDir r P.</> "index"
|
||||
|
||||
{- Holds the ref of the git-annex branch that the index was last updated to.
|
||||
-
|
||||
- The .lck in the name is a historical accident; this is not used as a
|
||||
- lock. -}
|
||||
gitAnnexIndexStatus :: Git.Repo -> FilePath
|
||||
gitAnnexIndexStatus r = gitAnnexDir r </> "index.lck"
|
||||
gitAnnexIndexStatus r = fromRawFilePath $ gitAnnexDir r P.</> "index.lck"
|
||||
|
||||
{- The index file used to generate a filtered branch view._-}
|
||||
gitAnnexViewIndex :: Git.Repo -> FilePath
|
||||
gitAnnexViewIndex r = gitAnnexDir r </> "viewindex"
|
||||
gitAnnexViewIndex r = fromRawFilePath $ gitAnnexDir r P.</> "viewindex"
|
||||
|
||||
{- File containing a log of recently accessed views. -}
|
||||
gitAnnexViewLog :: Git.Repo -> FilePath
|
||||
gitAnnexViewLog r = gitAnnexDir r </> "viewlog"
|
||||
gitAnnexViewLog r = fromRawFilePath $ gitAnnexDir r P.</> "viewlog"
|
||||
|
||||
{- List of refs that have already been merged into the git-annex branch. -}
|
||||
gitAnnexMergedRefs :: Git.Repo -> FilePath
|
||||
gitAnnexMergedRefs r = gitAnnexDir r </> "mergedrefs"
|
||||
gitAnnexMergedRefs r = fromRawFilePath $ gitAnnexDir r P.</> "mergedrefs"
|
||||
|
||||
{- List of refs that should not be merged into the git-annex branch. -}
|
||||
gitAnnexIgnoredRefs :: Git.Repo -> FilePath
|
||||
gitAnnexIgnoredRefs r = gitAnnexDir r </> "ignoredrefs"
|
||||
gitAnnexIgnoredRefs r = fromRawFilePath $ gitAnnexDir r P.</> "ignoredrefs"
|
||||
|
||||
{- Pid file for daemon mode. -}
|
||||
gitAnnexPidFile :: Git.Repo -> FilePath
|
||||
gitAnnexPidFile r = gitAnnexDir r </> "daemon.pid"
|
||||
gitAnnexPidFile r = fromRawFilePath $ gitAnnexDir r P.</> "daemon.pid"
|
||||
|
||||
{- Pid lock file for pidlock mode -}
|
||||
gitAnnexPidLockFile :: Git.Repo -> FilePath
|
||||
gitAnnexPidLockFile r = gitAnnexDir r </> "pidlock"
|
||||
gitAnnexPidLockFile r = fromRawFilePath $ gitAnnexDir r P.</> "pidlock"
|
||||
|
||||
{- Status file for daemon mode. -}
|
||||
gitAnnexDaemonStatusFile :: Git.Repo -> FilePath
|
||||
gitAnnexDaemonStatusFile r = gitAnnexDir r </> "daemon.status"
|
||||
gitAnnexDaemonStatusFile r = fromRawFilePath $
|
||||
gitAnnexDir r P.</> "daemon.status"
|
||||
|
||||
{- Log file for daemon mode. -}
|
||||
gitAnnexLogFile :: Git.Repo -> FilePath
|
||||
gitAnnexLogFile r = gitAnnexDir r </> "daemon.log"
|
||||
gitAnnexLogFile r = fromRawFilePath $ gitAnnexDir r P.</> "daemon.log"
|
||||
|
||||
{- Log file for fuzz test. -}
|
||||
gitAnnexFuzzTestLogFile :: Git.Repo -> FilePath
|
||||
gitAnnexFuzzTestLogFile r = gitAnnexDir r </> "fuzztest.log"
|
||||
gitAnnexFuzzTestLogFile r = fromRawFilePath $
|
||||
gitAnnexDir r P.</> "fuzztest.log"
|
||||
|
||||
{- Html shim file used to launch the webapp. -}
|
||||
gitAnnexHtmlShim :: Git.Repo -> FilePath
|
||||
gitAnnexHtmlShim r = gitAnnexDir r </> "webapp.html"
|
||||
gitAnnexHtmlShim r = fromRawFilePath $ gitAnnexDir r P.</> "webapp.html"
|
||||
|
||||
{- File containing the url to the webapp. -}
|
||||
gitAnnexUrlFile :: Git.Repo -> FilePath
|
||||
gitAnnexUrlFile r = gitAnnexDir r </> "url"
|
||||
gitAnnexUrlFile r = fromRawFilePath $ gitAnnexDir r P.</> "url"
|
||||
|
||||
{- Temporary file used to edit configuriation from the git-annex branch. -}
|
||||
gitAnnexTmpCfgFile :: Git.Repo -> FilePath
|
||||
gitAnnexTmpCfgFile r = gitAnnexDir r </> "config.tmp"
|
||||
gitAnnexTmpCfgFile r = fromRawFilePath $ gitAnnexDir r P.</> "config.tmp"
|
||||
|
||||
{- .git/annex/ssh/ is used for ssh connection caching -}
|
||||
gitAnnexSshDir :: Git.Repo -> FilePath
|
||||
gitAnnexSshDir r = addTrailingPathSeparator $ gitAnnexDir r </> "ssh"
|
||||
gitAnnexSshDir r = fromRawFilePath $
|
||||
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "ssh"
|
||||
|
||||
{- .git/annex/remotes/ is used for remote-specific state. -}
|
||||
gitAnnexRemotesDir :: Git.Repo -> FilePath
|
||||
gitAnnexRemotesDir r = addTrailingPathSeparator $ gitAnnexDir r </> "remotes"
|
||||
gitAnnexRemotesDir r = fromRawFilePath $
|
||||
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "remotes"
|
||||
|
||||
{- This is the base directory name used by the assistant when making
|
||||
- repositories, by default. -}
|
||||
|
|
@ -583,11 +597,8 @@ reSanitizeKeyName = preSanitizeKeyName' True
|
|||
- Changing what this function escapes and how is not a good idea, as it
|
||||
- can cause existing objects to get lost.
|
||||
-}
|
||||
keyFile :: Key -> FilePath
|
||||
keyFile = fromRawFilePath . keyFile'
|
||||
|
||||
keyFile' :: Key -> RawFilePath
|
||||
keyFile' k =
|
||||
keyFile :: Key -> RawFilePath
|
||||
keyFile k =
|
||||
let b = serializeKey' k
|
||||
in if S8.any (`elem` ['&', '%', ':', '/']) b
|
||||
then S8.concatMap esc b
|
||||
|
|
@ -602,11 +613,8 @@ keyFile' k =
|
|||
|
||||
{- Reverses keyFile, converting a filename fragment (ie, the basename of
|
||||
- the symlink target) into a key. -}
|
||||
fileKey :: FilePath -> Maybe Key
|
||||
fileKey = fileKey' . toRawFilePath
|
||||
|
||||
fileKey' :: RawFilePath -> Maybe Key
|
||||
fileKey' = deserializeKey' . S8.intercalate "/" . map go . S8.split '%'
|
||||
fileKey :: RawFilePath -> Maybe Key
|
||||
fileKey = deserializeKey' . S8.intercalate "/" . map go . S8.split '%'
|
||||
where
|
||||
go = S8.concat . unescafterfirst . S8.split '&'
|
||||
unescafterfirst [] = []
|
||||
|
|
@ -628,7 +636,7 @@ fileKey' = deserializeKey' . S8.intercalate "/" . map go . S8.split '%'
|
|||
keyPath :: Key -> Hasher -> RawFilePath
|
||||
keyPath key hasher = hasher key P.</> f P.</> f
|
||||
where
|
||||
f = keyFile' key
|
||||
f = keyFile key
|
||||
|
||||
{- All possibile locations to store a key in a special remote
|
||||
- using different directory hashes.
|
||||
|
|
|
|||
|
|
@ -70,7 +70,7 @@ annexFileMode = withShared $ return . go
|
|||
createAnnexDirectory :: FilePath -> Annex ()
|
||||
createAnnexDirectory dir = walk dir [] =<< top
|
||||
where
|
||||
top = parentDir <$> fromRepo gitAnnexDir
|
||||
top = parentDir . fromRawFilePath <$> fromRepo gitAnnexDir
|
||||
walk d below stop
|
||||
| d `equalFilePath` stop = done
|
||||
| otherwise = ifM (liftIO $ doesDirectoryExist d)
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ mkVariant file variant = takeDirectory file
|
|||
-}
|
||||
variantFile :: FilePath -> Key -> FilePath
|
||||
variantFile file key
|
||||
| doubleconflict = mkVariant file (keyFile key)
|
||||
| doubleconflict = mkVariant file (fromRawFilePath (keyFile key))
|
||||
| otherwise = mkVariant file (shortHash $ serializeKey' key)
|
||||
where
|
||||
doubleconflict = variantMarker `isInfixOf` file
|
||||
|
|
|
|||
|
|
@ -130,7 +130,7 @@ repairStaleGitLocks r = do
|
|||
repairStaleLocks lockfiles
|
||||
return $ not $ null lockfiles
|
||||
where
|
||||
findgitfiles = dirContentsRecursiveSkipping (== dropTrailingPathSeparator annexDir) True . fromRawFilePath . Git.localGitDir
|
||||
findgitfiles = dirContentsRecursiveSkipping (== dropTrailingPathSeparator (fromRawFilePath annexDir)) True . fromRawFilePath . Git.localGitDir
|
||||
islock f
|
||||
| "gc.pid" `isInfixOf` f = False
|
||||
| ".lock" `isSuffixOf` f = True
|
||||
|
|
|
|||
|
|
@ -31,7 +31,7 @@ perform key = next $ do
|
|||
addLink file key Nothing
|
||||
return True
|
||||
where
|
||||
file = "unused." ++ keyFile key
|
||||
file = "unused." ++ fromRawFilePath (keyFile key)
|
||||
|
||||
{- The content is not in the annex, but in another directory, and
|
||||
- it seems better to error out, rather than moving bad/tmp content into
|
||||
|
|
|
|||
|
|
@ -164,7 +164,7 @@ performRemote key afile backend numcopies remote =
|
|||
pid <- liftIO getPID
|
||||
t <- fromRepo gitAnnexTmpObjectDir
|
||||
createAnnexDirectory t
|
||||
let tmp = t </> "fsck" ++ show pid ++ "." ++ keyFile key
|
||||
let tmp = t </> "fsck" ++ show pid ++ "." ++ fromRawFilePath (keyFile key)
|
||||
let cleanup = liftIO $ catchIO (removeFile tmp) (const noop)
|
||||
cleanup
|
||||
cleanup `after` a tmp
|
||||
|
|
@ -516,7 +516,7 @@ badContent key = do
|
|||
badContentRemote :: Remote -> FilePath -> Key -> Annex String
|
||||
badContentRemote remote localcopy key = do
|
||||
bad <- fromRepo gitAnnexBadDir
|
||||
let destbad = bad </> keyFile key
|
||||
let destbad = bad </> fromRawFilePath (keyFile key)
|
||||
movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad))
|
||||
( return False
|
||||
, do
|
||||
|
|
|
|||
|
|
@ -454,7 +454,7 @@ disk_size :: Stat
|
|||
disk_size = simpleStat "available local disk space" $
|
||||
calcfree
|
||||
<$> (lift $ annexDiskReserve <$> Annex.getGitConfig)
|
||||
<*> (lift $ inRepo $ getDiskFree . gitAnnexDir)
|
||||
<*> (lift $ inRepo $ getDiskFree . fromRawFilePath . gitAnnexDir)
|
||||
<*> mkSizer
|
||||
where
|
||||
calcfree reserve (Just have) sizer = unwords
|
||||
|
|
@ -674,7 +674,7 @@ staleSize label dirspec = go =<< lift (dirKeys dirspec)
|
|||
keysizes keys = do
|
||||
dir <- lift $ fromRepo dirspec
|
||||
liftIO $ forM keys $ \k -> catchDefaultIO 0 $
|
||||
getFileSize (dir </> keyFile k)
|
||||
getFileSize (dir </> fromRawFilePath (keyFile k))
|
||||
|
||||
aside :: String -> String
|
||||
aside s = " (" ++ s ++ ")"
|
||||
|
|
|
|||
|
|
@ -46,7 +46,9 @@ start = startingNoMessage (ActionItemOther Nothing) $ do
|
|||
umap <- uuidDescMap
|
||||
trustmap <- trustMapLoad
|
||||
|
||||
file <- (</>) <$> fromRepo gitAnnexDir <*> pure "map.dot"
|
||||
file <- (</>)
|
||||
<$> fromRepo (fromRawFilePath . gitAnnexDir)
|
||||
<*> pure "map.dot"
|
||||
|
||||
liftIO $ writeFile file (drawMap rs trustmap umap)
|
||||
next $
|
||||
|
|
|
|||
|
|
@ -58,7 +58,7 @@ startCheckIncomplete file _ = giveup $ unlines
|
|||
|
||||
finish :: Annex ()
|
||||
finish = do
|
||||
annexdir <- fromRepo gitAnnexDir
|
||||
annexdir <- fromRawFilePath <$> fromRepo gitAnnexDir
|
||||
annexobjectdir <- fromRepo gitAnnexObjectDir
|
||||
leftovers <- removeUnannexed =<< listKeys InAnnex
|
||||
prepareRemoveAnnexDir annexdir
|
||||
|
|
|
|||
|
|
@ -43,6 +43,9 @@ import Git.Command
|
|||
import Git.Types
|
||||
import Git.Index
|
||||
|
||||
import qualified Data.ByteString as S
|
||||
import qualified System.FilePath.ByteString as P
|
||||
|
||||
{- Runs an action that reads from the database.
|
||||
-
|
||||
- If the database doesn't already exist, it's not created; mempty is
|
||||
|
|
@ -263,7 +266,7 @@ reconcileStaged qh = do
|
|||
-- pointer file. And a pointer file that is replaced with
|
||||
-- a non-pointer file will match this.
|
||||
, Param $ "-G^" ++ fromRawFilePath (toInternalGitPath $
|
||||
toRawFilePath (pathSeparator:objectDir))
|
||||
P.pathSeparator `S.cons` objectDir')
|
||||
-- Don't include files that were deleted, because this only
|
||||
-- wants to update information for files that are present
|
||||
-- in the index.
|
||||
|
|
|
|||
18
Logs.hs
18
Logs.hs
|
|
@ -119,18 +119,18 @@ exportLog = "export.log"
|
|||
{- The pathname of the location log file for a given key. -}
|
||||
locationLogFile :: GitConfig -> Key -> RawFilePath
|
||||
locationLogFile config key =
|
||||
branchHashDir config key P.</> keyFile' key <> ".log"
|
||||
branchHashDir config key P.</> keyFile key <> ".log"
|
||||
|
||||
{- The filename of the url log for a given key. -}
|
||||
urlLogFile :: GitConfig -> Key -> RawFilePath
|
||||
urlLogFile config key =
|
||||
branchHashDir config key P.</> keyFile' key <> urlLogExt
|
||||
branchHashDir config key P.</> keyFile key <> urlLogExt
|
||||
|
||||
{- Old versions stored the urls elsewhere. -}
|
||||
oldurlLogs :: GitConfig -> Key -> [RawFilePath]
|
||||
oldurlLogs config key =
|
||||
[ "remote/web" P.</> hdir P.</> serializeKey' key <> ".log"
|
||||
, "remote/web" P.</> hdir P.</> keyFile' key <> ".log"
|
||||
, "remote/web" P.</> hdir P.</> keyFile key <> ".log"
|
||||
]
|
||||
where
|
||||
hdir = branchHashDir config key
|
||||
|
|
@ -145,7 +145,7 @@ isUrlLog file = urlLogExt `S.isSuffixOf` file
|
|||
{- The filename of the remote state log for a given key. -}
|
||||
remoteStateLogFile :: GitConfig -> Key -> RawFilePath
|
||||
remoteStateLogFile config key =
|
||||
(branchHashDir config key P.</> keyFile' key)
|
||||
(branchHashDir config key P.</> keyFile key)
|
||||
<> remoteStateLogExt
|
||||
|
||||
remoteStateLogExt :: S.ByteString
|
||||
|
|
@ -157,7 +157,7 @@ isRemoteStateLog path = remoteStateLogExt `S.isSuffixOf` path
|
|||
{- The filename of the chunk log for a given key. -}
|
||||
chunkLogFile :: GitConfig -> Key -> RawFilePath
|
||||
chunkLogFile config key =
|
||||
(branchHashDir config key P.</> keyFile' key)
|
||||
(branchHashDir config key P.</> keyFile key)
|
||||
<> chunkLogExt
|
||||
|
||||
chunkLogExt :: S.ByteString
|
||||
|
|
@ -169,7 +169,7 @@ isChunkLog path = chunkLogExt `S.isSuffixOf` path
|
|||
{- The filename of the metadata log for a given key. -}
|
||||
metaDataLogFile :: GitConfig -> Key -> RawFilePath
|
||||
metaDataLogFile config key =
|
||||
(branchHashDir config key P.</> keyFile' key)
|
||||
(branchHashDir config key P.</> keyFile key)
|
||||
<> metaDataLogExt
|
||||
|
||||
metaDataLogExt :: S.ByteString
|
||||
|
|
@ -181,7 +181,7 @@ isMetaDataLog path = metaDataLogExt `S.isSuffixOf` path
|
|||
{- The filename of the remote metadata log for a given key. -}
|
||||
remoteMetaDataLogFile :: GitConfig -> Key -> RawFilePath
|
||||
remoteMetaDataLogFile config key =
|
||||
(branchHashDir config key P.</> keyFile' key)
|
||||
(branchHashDir config key P.</> keyFile key)
|
||||
<> remoteMetaDataLogExt
|
||||
|
||||
remoteMetaDataLogExt :: S.ByteString
|
||||
|
|
@ -193,7 +193,7 @@ isRemoteMetaDataLog path = remoteMetaDataLogExt `S.isSuffixOf` path
|
|||
{- The filename of the remote content identifier log for a given key. -}
|
||||
remoteContentIdentifierLogFile :: GitConfig -> Key -> RawFilePath
|
||||
remoteContentIdentifierLogFile config key =
|
||||
(branchHashDir config key P.</> keyFile' key)
|
||||
(branchHashDir config key P.</> keyFile key)
|
||||
<> remoteContentIdentifierExt
|
||||
|
||||
remoteContentIdentifierExt :: S.ByteString
|
||||
|
|
@ -205,7 +205,7 @@ isRemoteContentIdentifierLog path = remoteContentIdentifierExt `S.isSuffixOf` pa
|
|||
{- From an extension and a log filename, get the key that it's a log for. -}
|
||||
extLogFileKey :: S.ByteString -> RawFilePath -> Maybe Key
|
||||
extLogFileKey expectedext path
|
||||
| encodeBS' ext == expectedext = fileKey base
|
||||
| encodeBS' ext == expectedext = fileKey (toRawFilePath base)
|
||||
| otherwise = Nothing
|
||||
where
|
||||
file = takeFileName (fromRawFilePath path)
|
||||
|
|
|
|||
|
|
@ -195,12 +195,12 @@ recordFailedTransfer t info = do
|
|||
transferFile :: Transfer -> Git.Repo -> FilePath
|
||||
transferFile (Transfer direction u kd) r = transferDir direction r
|
||||
</> filter (/= '/') (fromUUID u)
|
||||
</> keyFile (mkKey (const kd))
|
||||
</> fromRawFilePath (keyFile (mkKey (const kd)))
|
||||
|
||||
{- The transfer information file to use to record a failed Transfer -}
|
||||
failedTransferFile :: Transfer -> Git.Repo -> FilePath
|
||||
failedTransferFile (Transfer direction u kd) r = failedTransferDir u direction r
|
||||
</> keyFile (mkKey (const kd))
|
||||
</> fromRawFilePath (keyFile (mkKey (const kd)))
|
||||
|
||||
{- The transfer lock file corresponding to a given transfer info file. -}
|
||||
transferLockFile :: FilePath -> FilePath
|
||||
|
|
@ -215,7 +215,7 @@ parseTransferFile file
|
|||
[direction, u, key] -> Transfer
|
||||
<$> parseDirection direction
|
||||
<*> pure (toUUID u)
|
||||
<*> fmap (fromKey id) (fileKey key)
|
||||
<*> fmap (fromKey id) (fileKey (toRawFilePath key))
|
||||
_ -> Nothing
|
||||
where
|
||||
bits = splitDirectories file
|
||||
|
|
|
|||
|
|
@ -195,7 +195,7 @@ downloadTorrentFile u = do
|
|||
createAnnexDirectory (parentDir torrent)
|
||||
if isTorrentMagnetUrl u
|
||||
then withOtherTmp $ \othertmp -> do
|
||||
kf <- keyFile <$> torrentUrlKey u
|
||||
kf <- fromRawFilePath . keyFile <$> torrentUrlKey u
|
||||
let metadir = othertmp </> "torrentmeta" </> kf
|
||||
createAnnexDirectory metadir
|
||||
showOutput
|
||||
|
|
@ -239,7 +239,7 @@ downloadTorrentContent :: Key -> URLString -> FilePath -> Int -> MeterUpdate ->
|
|||
downloadTorrentContent k u dest filenum p = do
|
||||
torrent <- tmpTorrentFile u
|
||||
withOtherTmp $ \othertmp -> do
|
||||
kf <- keyFile <$> torrentUrlKey u
|
||||
kf <- fromRawFilePath . keyFile <$> torrentUrlKey u
|
||||
let downloaddir = othertmp </> "torrent" </> kf
|
||||
createAnnexDirectory downloaddir
|
||||
f <- wantedfile torrent
|
||||
|
|
|
|||
|
|
@ -140,7 +140,7 @@ getLocation d k = do
|
|||
{- Directory where the file(s) for a key are stored. -}
|
||||
storeDir :: FilePath -> Key -> FilePath
|
||||
storeDir d k = addTrailingPathSeparator $
|
||||
d </> fromRawFilePath (hashDirLower def k) </> keyFile k
|
||||
d </> fromRawFilePath (hashDirLower def k) </> fromRawFilePath (keyFile k)
|
||||
|
||||
{- Check if there is enough free disk space in the remote's directory to
|
||||
- store the key. Note that the unencrypted key size is checked. -}
|
||||
|
|
@ -164,12 +164,13 @@ store d chunkconfig k b p = liftIO $ do
|
|||
case chunkconfig of
|
||||
LegacyChunks chunksize -> Legacy.store chunksize finalizeStoreGeneric k b p tmpdir destdir
|
||||
_ -> do
|
||||
let tmpf = tmpdir </> keyFile k
|
||||
let tmpf = tmpdir </> kf
|
||||
meteredWriteFile p tmpf b
|
||||
finalizeStoreGeneric tmpdir destdir
|
||||
return True
|
||||
where
|
||||
tmpdir = addTrailingPathSeparator $ d </> "tmp" </> keyFile k
|
||||
tmpdir = addTrailingPathSeparator $ d </> "tmp" </> kf
|
||||
kf = fromRawFilePath (keyFile k)
|
||||
destdir = storeDir d k
|
||||
|
||||
{- Passed a temp directory that contains the files that should be placed
|
||||
|
|
|
|||
|
|
@ -91,7 +91,7 @@ store chunksize finalizer k b p = storeHelper finalizer k $ \dests ->
|
|||
retrieve :: (FilePath -> Key -> [FilePath]) -> FilePath -> Preparer Retriever
|
||||
retrieve locations d basek a = withOtherTmp $ \tmpdir -> do
|
||||
showLongNote "This remote uses the deprecated chunksize setting. So this will be quite slow."
|
||||
let tmp = tmpdir </> keyFile basek ++ ".directorylegacy.tmp"
|
||||
let tmp = tmpdir </> fromRawFilePath (keyFile basek) ++ ".directorylegacy.tmp"
|
||||
a $ Just $ byteRetriever $ \k sink -> do
|
||||
liftIO $ void $ withStoredFiles d locations k $ \fs -> do
|
||||
forM_ fs $
|
||||
|
|
|
|||
|
|
@ -351,9 +351,9 @@ store' :: Git.Repo -> Remote -> Remote.Rsync.RsyncOpts -> Storer
|
|||
store' repo r rsyncopts
|
||||
| not $ Git.repoIsUrl repo =
|
||||
byteStorer $ \k b p -> guardUsable repo (return False) $ liftIO $ do
|
||||
let tmpdir = Git.repoLocation repo </> "tmp" </> keyFile k
|
||||
let tmpdir = Git.repoLocation repo </> "tmp" </> fromRawFilePath (keyFile k)
|
||||
void $ tryIO $ createDirectoryIfMissing True tmpdir
|
||||
let tmpf = tmpdir </> keyFile k
|
||||
let tmpf = tmpdir </> fromRawFilePath (keyFile k)
|
||||
meteredWriteFile p tmpf b
|
||||
let destdir = parentDir $ gCryptLocation repo k
|
||||
Remote.Directory.finalizeStoreGeneric tmpdir destdir
|
||||
|
|
|
|||
|
|
@ -77,7 +77,7 @@ storeChunks key tmp dest storer recorder finalizer = either onerr return
|
|||
warningIO (show e)
|
||||
return False
|
||||
|
||||
basef = tmp ++ keyFile key
|
||||
basef = tmp ++ fromRawFilePath (keyFile key)
|
||||
tmpdests = map (basef ++ ) chunkStream
|
||||
|
||||
{- Given a list of destinations to use, chunks the data according to the
|
||||
|
|
|
|||
|
|
@ -226,7 +226,7 @@ remove o k = removeGeneric o includes
|
|||
[ parentDir dir
|
||||
, dir
|
||||
-- match content directory and anything in it
|
||||
, dir </> keyFile k </> "***"
|
||||
, dir </> fromRawFilePath (keyFile k) </> "***"
|
||||
]
|
||||
|
||||
{- An empty directory is rsynced to make it delete. Everything is excluded,
|
||||
|
|
|
|||
|
|
@ -44,7 +44,7 @@ rsyncUrls :: RsyncOpts -> Key -> [RsyncUrl]
|
|||
rsyncUrls o k = map use dirHashes
|
||||
where
|
||||
use h = rsyncUrl o </> fromRawFilePath (hash h) </> rsyncEscape o (f </> f)
|
||||
f = keyFile k
|
||||
f = fromRawFilePath (keyFile k)
|
||||
#ifndef mingw32_HOST_OS
|
||||
hash h = h def k
|
||||
#else
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ inLocation d = inDAVLocation (</> d')
|
|||
|
||||
{- The directory where files(s) for a key are stored. -}
|
||||
keyDir :: Key -> DavLocation
|
||||
keyDir k = addTrailingPathSeparator $ hashdir </> keyFile k
|
||||
keyDir k = addTrailingPathSeparator $ hashdir </> fromRawFilePath (keyFile k)
|
||||
where
|
||||
#ifndef mingw32_HOST_OS
|
||||
hashdir = fromRawFilePath $ hashDirLower def k
|
||||
|
|
@ -45,7 +45,7 @@ keyDir k = addTrailingPathSeparator $ hashdir </> keyFile k
|
|||
#endif
|
||||
|
||||
keyLocation :: Key -> DavLocation
|
||||
keyLocation k = keyDir k ++ keyFile k
|
||||
keyLocation k = keyDir k ++ fromRawFilePath (keyFile k)
|
||||
|
||||
{- Paths containing # or ? cannot be represented in an url, so fails on
|
||||
- those. -}
|
||||
|
|
@ -60,7 +60,7 @@ exportLocation l =
|
|||
|
||||
{- Where we store temporary data for a key as it's being uploaded. -}
|
||||
keyTmpLocation :: Key -> DavLocation
|
||||
keyTmpLocation = tmpLocation . keyFile
|
||||
keyTmpLocation = tmpLocation . fromRawFilePath . keyFile
|
||||
|
||||
tmpLocation :: FilePath -> DavLocation
|
||||
tmpLocation f = "git-annex-webdav-tmp-" ++ f
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ upgrade = do
|
|||
showAction "v0 to v1"
|
||||
|
||||
-- do the reorganisation of the key files
|
||||
olddir <- fromRepo gitAnnexDir
|
||||
olddir <- fromRawFilePath <$> fromRepo gitAnnexDir
|
||||
keys <- getKeysPresent0 olddir
|
||||
forM_ keys $ \k -> moveAnnex k $ olddir </> keyFile0 k
|
||||
|
||||
|
|
|
|||
|
|
@ -238,7 +238,7 @@ logFile2 = logFile' (hashDirLower def)
|
|||
|
||||
logFile' :: (Key -> RawFilePath) -> Key -> Git.Repo -> String
|
||||
logFile' hasher key repo =
|
||||
gitStateDir repo ++ fromRawFilePath (hasher key) ++ keyFile key ++ ".log"
|
||||
gitStateDir repo ++ fromRawFilePath (hasher key) ++ fromRawFilePath (keyFile key) ++ ".log"
|
||||
|
||||
stateDir :: FilePath
|
||||
stateDir = addTrailingPathSeparator ".git-annex"
|
||||
|
|
|
|||
3
doc/todo/optimise_by_converting_Ref_to_ByteString.mdwn
Normal file
3
doc/todo/optimise_by_converting_Ref_to_ByteString.mdwn
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
Profiling of `git annex find --not --in web` suggests that converting Ref
|
||||
to contain a ByteString, rather than a String, would eliminate a
|
||||
fromRawFilePath that uses about 1% of runtime.
|
||||
Loading…
Reference in a new issue