more RawFilePath
authorJoey Hess <joeyh@joeyh.name>
Wed, 18 Dec 2019 20:45:03 +0000 (16:45 -0400)
committerJoey Hess <joeyh@joeyh.name>
Wed, 18 Dec 2019 21:10:28 +0000 (17:10 -0400)
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.

26 files changed:
Annex/Content.hs
Annex/Content/LowLevel.hs
Annex/Link.hs
Annex/Locations.hs
Annex/Perms.hs
Annex/VariantFile.hs
Assistant/Repair.hs
Command/AddUnused.hs
Command/Fsck.hs
Command/Info.hs
Command/Map.hs
Command/Uninit.hs
Database/Keys.hs
Logs.hs
Logs/Transfer.hs
Remote/BitTorrent.hs
Remote/Directory.hs
Remote/Directory/LegacyChunked.hs
Remote/GCrypt.hs
Remote/Helper/Chunked/Legacy.hs
Remote/Rsync.hs
Remote/Rsync/RsyncUrl.hs
Remote/WebDAV/DavLocation.hs
Upgrade/V0.hs
Upgrade/V1.hs
doc/todo/optimise_by_converting_Ref_to_ByteString.mdwn [new file with mode: 0644]

index 74dd17886ef2662df0270f295a3ef1f4890c7524..7c57cf5040358a5d9719a4e24f185e495a279d8f 100644 (file)
@@ -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
index 546e647def18f3a78cf4d87bb54ef6fab5d6b376..39e187de76061467f328da5585b3d63e76958eec 100644 (file)
@@ -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 " ++ 
index ede132a5b94124dddffbf813827902565e6571e9..faed59f1921fe5f840f8efda2ce4fd4155560a53 100644 (file)
@@ -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.
index 36858a72bbe6a06800d4167a1bd3e3930e52b47a..bb8138f3faabda9b290f45c2dbef586fcffa56e0 100644 (file)
@@ -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.
index d2b270dd40c18906f8eec69f5853a6492ce6a232..a24e0362f00bac9e73eebad618d6dfcb38f20cc3 100644 (file)
@@ -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)
index 65f989ebaed32cc90b34c8daae7fecae12b01c54..781732368da0530f2fd4a034677beb2abd5be182 100644 (file)
@@ -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
index f8e7bedcecf7551d79fcb39bcd78c396fca0a0fe..a96921796cbee693cb615c9b651b50fa8f41db13 100644 (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
index 025b25e4d008d548f0de3b1d4bc1dcd2e8b2cbc9..b14e85bde56e936a3cf47038b15de901829b7815 100644 (file)
@@ -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
index 3010a6ce3764269a81ca72a1c090d54bb0a2a5f5..65c0112ea76fb32bd59cd4e25d026a279cc20936 100644 (file)
@@ -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
index 94292077f813516c41a3229f8a74212774403486..3448ee6ef29318dc9578365ee21f11ed56ca2266 100644 (file)
@@ -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 ++ ")"
index de2a0c6dd66c50e6db8bdade1fbb867265cd9e4a..c35ad6870dab1fe5d7cedf6d90b5a5d7ed67ddcd 100644 (file)
@@ -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 $
index 29278a6c4ebcbcbbe06869c8a5f7b89650d168ca..ff9c4d3880748c74ef7d5a1cc22da074489bb20d 100644 (file)
@@ -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
index 48d51caf4e150e9105ed3576f5a75382517af679..afbe7191d5168215dd1c91df3d02e5ee5dab2000 100644 (file)
@@ -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.
diff --git a/Logs.hs b/Logs.hs
index 18a045b452f30df2eab268580992eb75c2489bb5..5faec561efb6d13512ecb8e81cc64f2026c0c517 100644 (file)
--- a/Logs.hs
+++ b/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)
index 2dabe5cf34c3f7c7e91d32fd49b3619615ebe429..ab9a8ca61bb30f745e08d957813f7b416ae6e35b 100644 (file)
@@ -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
index 09fa5ed744911e1832eb4f9f4e3678f0a7428126..0bbf4b24a7343ad0433a65997bac20ed6be7e8a1 100644 (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
index 933ccd23ce93e3ee7c4d93a634ad879a2ee85316..3aa618515524a3f00f3490fb8de00d74f07c5a67 100644 (file)
@@ -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
index fb3626f489aa60e8efca30ee74906e3706d67a7e..d9d5a860ce993f86d234104f314548178cddeaa7 100644 (file)
@@ -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 $
index c3a3f313481644c10a47ed230fbe8e7474a1a4fd..9fa59169781f806120c461e90010619d415682f9 100644 (file)
@@ -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
index c804b23754beaad7aa8865eeab7f600662624e31..e7a7c5fc67183013139740a0e93a531a6305663f 100644 (file)
@@ -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
index f171b69e609b429bd57da0b32a5b700d7b406f1a..1847514002437fcf086bf9a571986b1ea9629818 100644 (file)
@@ -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,
index 2b0dbc1966fe97e0d7b6faf97735ed94b26d627a..dc810dea4d720e426e2a743209f604eb9fcc06d8 100644 (file)
@@ -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
index 3893533a2208ead99159f07a63af9eb91c4981e9..bd188a6de4e884fed883ae0a84ac74d46c006cb4 100644 (file)
@@ -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
index 00dce6d125e4ee5090739aff09b730a24e2cb6cf..2b5b2d4eba50bb54a019a92d06d0f3fc7086f3c6 100644 (file)
@@ -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
 
index e31104466429ba4f367c98378d6f4b848523fb4b..88a3494484da9a58a4761eba8d7406ce9c7d1631 100644 (file)
@@ -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"
diff --git a/doc/todo/optimise_by_converting_Ref_to_ByteString.mdwn b/doc/todo/optimise_by_converting_Ref_to_ByteString.mdwn
new file mode 100644 (file)
index 0000000..11328a9
--- /dev/null
@@ -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.