diff --git a/Annex.hs b/Annex.hs index 7c2bd42bfb..ed9433fea0 100644 --- a/Annex.hs +++ b/Annex.hs @@ -74,7 +74,6 @@ import qualified Database.Keys.Handle as Keys import Utility.InodeCache import Utility.Url import Utility.ResourcePool -import Utility.Path.AbsRel import "mtl" Control.Monad.Reader import Control.Concurrent diff --git a/Annex/GitOverlay.hs b/Annex/GitOverlay.hs index 91bca22d8c..2e441a28b2 100644 --- a/Annex/GitOverlay.hs +++ b/Annex/GitOverlay.hs @@ -90,8 +90,8 @@ withWorkTreeRelated :: FilePath -> Annex a -> Annex a withWorkTreeRelated d a = withAltRepo modrepo unmodrepo (const a) where modrepo g = liftIO $ do - g' <- addGitEnv g "GIT_COMMON_DIR" - =<< absPath (fromRawFilePath (localGitDir g)) + g' <- addGitEnv g "GIT_COMMON_DIR" . fromRawFilePath + =<< absPath (localGitDir g) g'' <- addGitEnv g' "GIT_DIR" d return (g'' { gitEnvOverridesGitDir = True }, ()) unmodrepo g g' = g' diff --git a/Annex/Journal.hs b/Annex/Journal.hs index 34b21d1129..9ce80d8c44 100644 --- a/Annex/Journal.hs +++ b/Annex/Journal.hs @@ -50,11 +50,11 @@ setJournalFile :: Journalable content => JournalLocked -> RawFilePath -> content setJournalFile _jl file content = withOtherTmp $ \tmp -> do createAnnexDirectory =<< fromRepo gitAnnexJournalDir -- journal file is written atomically - jfile <- fromRawFilePath <$> fromRepo (journalFile file) - let tmpfile = tmp takeFileName jfile + jfile <- fromRepo (journalFile file) + let tmpfile = fromRawFilePath (tmp P. P.takeFileName jfile) liftIO $ do withFile tmpfile WriteMode $ \h -> writeJournalHandle h content - moveFile tmpfile jfile + moveFile tmpfile (fromRawFilePath jfile) {- Gets any journalled content for a file in the branch. -} getJournalFile :: JournalLocked -> RawFilePath -> Annex (Maybe L.ByteString) @@ -82,19 +82,19 @@ getJournalledFilesStale :: Annex [FilePath] getJournalledFilesStale = do g <- gitRepo fs <- liftIO $ catchDefaultIO [] $ - getDirectoryContents $ gitAnnexJournalDir g + getDirectoryContents $ fromRawFilePath $ gitAnnexJournalDir g return $ filter (`notElem` [".", ".."]) $ map (fromRawFilePath . fileJournal . toRawFilePath) fs withJournalHandle :: (DirectoryHandle -> IO a) -> Annex a withJournalHandle a = do - d <- fromRepo gitAnnexJournalDir + d <- fromRawFilePath <$> fromRepo gitAnnexJournalDir bracketIO (openDirectory d) closeDirectory (liftIO . a) {- Checks if there are changes in the journal. -} journalDirty :: Annex Bool journalDirty = do - d <- fromRepo gitAnnexJournalDir + d <- fromRawFilePath <$> fromRepo gitAnnexJournalDir liftIO $ (not <$> isDirectoryEmpty d) `catchIO` (const $ doesDirectoryExist d) diff --git a/Annex/Locations.hs b/Annex/Locations.hs index 7ccf619c97..3fc39937b9 100644 --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -108,7 +108,6 @@ import qualified Git.Types as Git import Git.FilePath import Annex.DirHashes import Annex.Fixup -import Utility.Path.AbsRel import qualified Utility.RawFilePath as R {- Conventions: @@ -240,18 +239,18 @@ gitAnnexContentLock key r config = do {- File that maps from a key to the file(s) in the git repository. - Used in direct mode. -} -gitAnnexMapping :: Key -> Git.Repo -> GitConfig -> IO FilePath +gitAnnexMapping :: Key -> Git.Repo -> GitConfig -> IO RawFilePath gitAnnexMapping key r config = do loc <- gitAnnexLocation key r config - return $ fromRawFilePath loc ++ ".map" + return $ loc <> ".map" {- File that caches information about a key's content, used to determine - if a file has changed. - Used in direct mode. -} -gitAnnexInodeCache :: Key -> Git.Repo -> GitConfig -> IO FilePath +gitAnnexInodeCache :: Key -> Git.Repo -> GitConfig -> IO RawFilePath gitAnnexInodeCache key r config = do loc <- gitAnnexLocation key r config - return $ fromRawFilePath loc ++ ".cache" + return $ loc <> ".cache" gitAnnexInodeSentinal :: Git.Repo -> RawFilePath gitAnnexInodeSentinal r = gitAnnexDir r P. "sentinal" @@ -273,22 +272,23 @@ gitAnnexTmpObjectDir :: Git.Repo -> FilePath gitAnnexTmpObjectDir = fromRawFilePath . gitAnnexTmpObjectDir' gitAnnexTmpObjectDir' :: Git.Repo -> RawFilePath -gitAnnexTmpObjectDir' r = P.addTrailingPathSeparator $ gitAnnexDir r P. "tmp" +gitAnnexTmpObjectDir' r = P.addTrailingPathSeparator $ + gitAnnexDir r P. "tmp" {- .git/annex/othertmp/ is used for other temp files -} -gitAnnexTmpOtherDir :: Git.Repo -> FilePath -gitAnnexTmpOtherDir r = fromRawFilePath $ - P.addTrailingPathSeparator $ gitAnnexDir r P. "othertmp" +gitAnnexTmpOtherDir :: Git.Repo -> RawFilePath +gitAnnexTmpOtherDir r = P.addTrailingPathSeparator $ + gitAnnexDir r P. "othertmp" {- Lock file for gitAnnexTmpOtherDir. -} -gitAnnexTmpOtherLock :: Git.Repo -> FilePath -gitAnnexTmpOtherLock r = fromRawFilePath $ gitAnnexDir r P. "othertmp.lck" +gitAnnexTmpOtherLock :: Git.Repo -> RawFilePath +gitAnnexTmpOtherLock r = 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 = fromRawFilePath $ - P.addTrailingPathSeparator $ gitAnnexDir r P. "misctmp" +gitAnnexTmpOtherDirOld :: Git.Repo -> RawFilePath +gitAnnexTmpOtherDirOld r = P.addTrailingPathSeparator $ + gitAnnexDir r P. "misctmp" {- .git/annex/watchtmp/ is used by the watcher and assistant -} gitAnnexTmpWatcherDir :: Git.Repo -> FilePath @@ -323,9 +323,8 @@ gitAnnexBadLocation :: Key -> Git.Repo -> FilePath 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 = - fromRawFilePath (gitAnnexDir r) (prefix ++ "unused") +gitAnnexUnusedLog :: RawFilePath -> Git.Repo -> RawFilePath +gitAnnexUnusedLog prefix r = gitAnnexDir r P. (prefix <> "unused") {- .git/annex/keysdb/ contains a database of information about keys. -} gitAnnexKeysDb :: Git.Repo -> FilePath @@ -342,29 +341,28 @@ 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 = fromRawFilePath $ - gitAnnexDir r P. "fsck" P. fromUUID u +gitAnnexFsckDir :: UUID -> Git.Repo -> RawFilePath +gitAnnexFsckDir u r = gitAnnexDir r P. "fsck" P. fromUUID u {- used to store information about incremental fscks. -} -gitAnnexFsckState :: UUID -> Git.Repo -> FilePath -gitAnnexFsckState u r = gitAnnexFsckDir u r "state" +gitAnnexFsckState :: UUID -> Git.Repo -> RawFilePath +gitAnnexFsckState u r = gitAnnexFsckDir u r P. "state" {- Directory containing database used to record fsck info. -} -gitAnnexFsckDbDir :: UUID -> Git.Repo -> FilePath -gitAnnexFsckDbDir u r = gitAnnexFsckDir u r "fsckdb" +gitAnnexFsckDbDir :: UUID -> Git.Repo -> RawFilePath +gitAnnexFsckDbDir u r = gitAnnexFsckDir u r P. "fsckdb" {- Directory containing old database used to record fsck info. -} -gitAnnexFsckDbDirOld :: UUID -> Git.Repo -> FilePath -gitAnnexFsckDbDirOld u r = gitAnnexFsckDir u r "db" +gitAnnexFsckDbDirOld :: UUID -> Git.Repo -> RawFilePath +gitAnnexFsckDbDirOld u r = gitAnnexFsckDir u r P. "db" {- Lock file for the fsck database. -} -gitAnnexFsckDbLock :: UUID -> Git.Repo -> FilePath -gitAnnexFsckDbLock u r = gitAnnexFsckDir u r "fsck.lck" +gitAnnexFsckDbLock :: UUID -> Git.Repo -> RawFilePath +gitAnnexFsckDbLock u r = gitAnnexFsckDir u r P. "fsck.lck" {- .git/annex/fsckresults/uuid is used to store results of git fscks -} -gitAnnexFsckResultsLog :: UUID -> Git.Repo -> FilePath -gitAnnexFsckResultsLog u r = fromRawFilePath $ +gitAnnexFsckResultsLog :: UUID -> Git.Repo -> RawFilePath +gitAnnexFsckResultsLog u r = gitAnnexDir r P. "fsckresults" P. fromUUID u {- .git/annex/smudge.log is used to log smudges worktree files that need to @@ -372,8 +370,8 @@ gitAnnexFsckResultsLog u r = fromRawFilePath $ gitAnnexSmudgeLog :: Git.Repo -> FilePath gitAnnexSmudgeLog r = fromRawFilePath $ gitAnnexDir r P. "smudge.log" -gitAnnexSmudgeLock :: Git.Repo -> FilePath -gitAnnexSmudgeLock r = fromRawFilePath $ gitAnnexDir r P. "smudge.lck" +gitAnnexSmudgeLock :: Git.Repo -> RawFilePath +gitAnnexSmudgeLock r = gitAnnexDir r P. "smudge.lck" {- .git/annex/move.log is used to log moves that are in progress, - to better support resuming an interrupted move. -} @@ -451,27 +449,28 @@ gitAnnexMergeDir r = fromRawFilePath $ {- .git/annex/transfer/ is used to record keys currently - being transferred, and other transfer bookkeeping info. -} -gitAnnexTransferDir :: Git.Repo -> FilePath -gitAnnexTransferDir r = fromRawFilePath $ +gitAnnexTransferDir :: Git.Repo -> RawFilePath +gitAnnexTransferDir r = 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 = fromRawFilePath $ +gitAnnexJournalDir :: Git.Repo -> RawFilePath +gitAnnexJournalDir r = 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 = fromRawFilePath $ gitAnnexDir r P. "journal.lck" +gitAnnexJournalLock :: Git.Repo -> RawFilePath +gitAnnexJournalLock r = 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 = fromRawFilePath $ gitAnnexDir r P. "gitqueue.lck" +gitAnnexGitQueueLock :: Git.Repo -> RawFilePath +gitAnnexGitQueueLock r = gitAnnexDir r P. "gitqueue.lck" {- Lock file for direct mode merge. -} gitAnnexMergeLock :: Git.Repo -> FilePath @@ -493,8 +492,8 @@ gitAnnexViewIndex :: Git.Repo -> FilePath gitAnnexViewIndex r = fromRawFilePath $ gitAnnexDir r P. "viewindex" {- File containing a log of recently accessed views. -} -gitAnnexViewLog :: Git.Repo -> FilePath -gitAnnexViewLog r = fromRawFilePath $ gitAnnexDir r P. "viewlog" +gitAnnexViewLog :: Git.Repo -> RawFilePath +gitAnnexViewLog r = gitAnnexDir r P. "viewlog" {- List of refs that have already been merged into the git-annex branch. -} gitAnnexMergedRefs :: Git.Repo -> FilePath @@ -539,9 +538,8 @@ gitAnnexTmpCfgFile :: Git.Repo -> FilePath gitAnnexTmpCfgFile r = fromRawFilePath $ gitAnnexDir r P. "config.tmp" {- .git/annex/ssh/ is used for ssh connection caching -} -gitAnnexSshDir :: Git.Repo -> FilePath -gitAnnexSshDir r = fromRawFilePath $ - P.addTrailingPathSeparator $ gitAnnexDir r P. "ssh" +gitAnnexSshDir :: Git.Repo -> RawFilePath +gitAnnexSshDir r = P.addTrailingPathSeparator $ gitAnnexDir r P. "ssh" {- .git/annex/remotes/ is used for remote-specific state. -} gitAnnexRemotesDir :: Git.Repo -> RawFilePath diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs index ddbbedf96a..ffe5287c90 100644 --- a/Annex/ReplaceFile.hs +++ b/Annex/ReplaceFile.hs @@ -19,6 +19,7 @@ import Annex.Tmp import Annex.Perms import Git import Utility.Tmp.Dir +import Utility.Directory.Create #ifndef mingw32_HOST_OS import Utility.Path.Max #endif @@ -30,7 +31,7 @@ replaceGitAnnexDirFile = replaceFile createAnnexDirectory {- replaceFile on a file located inside the .git directory. -} replaceGitDirFile :: FilePath -> (FilePath -> Annex a) -> Annex a replaceGitDirFile = replaceFile $ \dir -> do - top <- fromRawFilePath <$> fromRepo localGitDir + top <- fromRepo localGitDir liftIO $ createDirectoryUnder top dir {- replaceFile on a worktree file. -} @@ -52,29 +53,30 @@ replaceWorkTreeFile = replaceFile createWorkTreeDirectory - The createdirectory action is only run when moving the file into place - fails, and can create any parent directory structure needed. -} -replaceFile :: (FilePath -> Annex ()) -> FilePath -> (FilePath -> Annex a) -> Annex a +replaceFile :: (RawFilePath -> Annex ()) -> FilePath -> (FilePath -> Annex a) -> Annex a replaceFile createdirectory file action = withOtherTmp $ \othertmpdir -> do + let othertmpdir' = fromRawFilePath othertmpdir #ifndef mingw32_HOST_OS -- Use part of the filename as the template for the temp -- directory. This does not need to be unique, but it -- makes it more clear what this temp directory is for. - filemax <- liftIO $ fileNameLengthLimit othertmpdir + filemax <- liftIO $ fileNameLengthLimit othertmpdir' let basetmp = take (filemax `div` 2) (takeFileName file) #else -- Windows has limits on the whole path length, so keep -- it short. let basetmp = "t" #endif - withTmpDirIn othertmpdir basetmp $ \tmpdir -> do + withTmpDirIn othertmpdir' basetmp $ \tmpdir -> do let tmpfile = tmpdir basetmp r <- action tmpfile replaceFileFrom tmpfile file createdirectory return r -replaceFileFrom :: FilePath -> FilePath -> (FilePath -> Annex ()) -> Annex () +replaceFileFrom :: FilePath -> FilePath -> (RawFilePath -> Annex ()) -> Annex () replaceFileFrom src dest createdirectory = go `catchIO` fallback where go = liftIO $ moveFile src dest fallback _ = do - createdirectory (parentDir dest) + createdirectory (parentDir (toRawFilePath dest)) go diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index 6a6c33629d..08d26dfadc 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -38,6 +38,7 @@ import Annex.Concurrent.Utility import Types.Concurrency import Git.Env import Git.Ssh +import qualified Utility.RawFilePath as R import Annex.Perms #ifndef mingw32_HOST_OS import Annex.LockPool @@ -45,6 +46,7 @@ import Annex.LockPool import Control.Concurrent.STM import qualified Data.ByteString as S +import qualified System.FilePath.ByteString as P {- Some ssh commands are fed stdin on a pipe and so should be allowed to - consume it. But ssh commands that are not piped stdin should generally @@ -102,9 +104,11 @@ sshCachingInfo :: (SshHost, Maybe Integer) -> Annex (Maybe FilePath, [CommandPar sshCachingInfo (host, port) = go =<< sshCacheDir' where go (Right dir) = - liftIO (bestSocketPath $ dir hostport2socket host port) >>= return . \case + liftIO (bestSocketPath $ dir P. hostport2socket host port) >>= return . \case Nothing -> (Nothing, []) - Just socketfile -> (Just socketfile, sshConnectionCachingParams socketfile) + Just socketfile -> + let socketfile' = fromRawFilePath socketfile + in (Just socketfile', sshConnectionCachingParams socketfile') -- No connection caching with concurrency is not a good -- combination, so warn the user. go (Left whynocaching) = do @@ -130,20 +134,20 @@ sshCachingInfo (host, port) = go =<< sshCacheDir' - file. - - If no path can be constructed that is a valid socket, returns Nothing. -} -bestSocketPath :: FilePath -> IO (Maybe FilePath) +bestSocketPath :: RawFilePath -> IO (Maybe RawFilePath) bestSocketPath abssocketfile = do relsocketfile <- liftIO $ relPathCwdToFile abssocketfile - let socketfile = if length abssocketfile <= length relsocketfile + let socketfile = if S.length abssocketfile <= S.length relsocketfile then abssocketfile else relsocketfile - return $ if valid_unix_socket_path (socketfile ++ sshgarbage) + return $ if valid_unix_socket_path socketfile sshgarbagelen then Just socketfile else Nothing where -- ssh appends a 16 char extension to the socket when setting it -- up, which needs to be taken into account when checking -- that a valid socket was constructed. - sshgarbage = replicate (1+16) 'X' + sshgarbagelen = 1+16 sshConnectionCachingParams :: FilePath -> [CommandParam] sshConnectionCachingParams socketfile = @@ -160,10 +164,10 @@ sshSocketDirEnv = "GIT_ANNEX_SSH_SOCKET_DIR" - - The directory will be created if it does not exist. -} -sshCacheDir :: Annex (Maybe FilePath) +sshCacheDir :: Annex (Maybe RawFilePath) sshCacheDir = eitherToMaybe <$> sshCacheDir' -sshCacheDir' :: Annex (Either String FilePath) +sshCacheDir' :: Annex (Either String RawFilePath) sshCacheDir' = ifM (fromMaybe BuildInfo.sshconnectioncaching . annexSshCaching <$> Annex.getGitConfig) ( ifM crippledFileSystem @@ -186,7 +190,7 @@ sshCacheDir' = usetmpdir tmpdir = do let socktmp = tmpdir "ssh" createDirectoryIfMissing True socktmp - return socktmp + return (toRawFilePath socktmp) crippledfswarning = unwords [ "This repository is on a crippled filesystem, so unix named" @@ -285,9 +289,9 @@ enumSocketFiles :: Annex [FilePath] enumSocketFiles = liftIO . go =<< sshCacheDir where go Nothing = return [] - go (Just dir) = filterM (doesFileExist . socket2lock) + go (Just dir) = filterM (R.doesPathExist . socket2lock) =<< filter (not . isLock) - <$> catchDefaultIO [] (dirContents dir) + <$> catchDefaultIO [] (dirContents (fromRawFilePath dir)) {- Stop any unused ssh connection caching processes. -} sshCleanup :: Annex () @@ -339,19 +343,19 @@ forceStopSsh socketfile = withNullHandle $ \nullh -> do - of the path to a socket file. At the same time, it needs to be unique - for each host. -} -hostport2socket :: SshHost -> Maybe Integer -> FilePath +hostport2socket :: SshHost -> Maybe Integer -> RawFilePath hostport2socket host Nothing = hostport2socket' $ fromSshHost host hostport2socket host (Just port) = hostport2socket' $ fromSshHost host ++ "!" ++ show port -hostport2socket' :: String -> FilePath +hostport2socket' :: String -> RawFilePath hostport2socket' s - | length s > lengthofmd5s = show $ md5 $ encodeBL s - | otherwise = s + | length s > lengthofmd5s = toRawFilePath $ show $ md5 $ encodeBL s + | otherwise = toRawFilePath s where lengthofmd5s = 32 -socket2lock :: FilePath -> FilePath -socket2lock socket = socket ++ lockExt +socket2lock :: FilePath -> RawFilePath +socket2lock socket = toRawFilePath (socket ++ lockExt) isLock :: FilePath -> Bool isLock f = lockExt `isSuffixOf` f @@ -369,8 +373,8 @@ sizeof_sockaddr_un_sun_path = 100 {- Note that this looks at the true length of the path in bytes, as it will - appear on disk. -} -valid_unix_socket_path :: FilePath -> Bool -valid_unix_socket_path f = S.length (encodeBS f) < sizeof_sockaddr_un_sun_path +valid_unix_socket_path :: RawFilePath -> Int -> Bool +valid_unix_socket_path f n = S.length f + n < sizeof_sockaddr_un_sun_path {- Parses the SSH port, and returns the other OpenSSH options. If - several ports are found, the last one takes precedence. -} diff --git a/Annex/Tmp.hs b/Annex/Tmp.hs index cb68e73598..f7d1720467 100644 --- a/Annex/Tmp.hs +++ b/Annex/Tmp.hs @@ -21,7 +21,7 @@ import Data.Time.Clock.POSIX -- directory that is passed to it. However, once the action is done, -- any files left in that directory may be cleaned up by another process at -- any time. -withOtherTmp :: (FilePath -> Annex a) -> Annex a +withOtherTmp :: (RawFilePath -> Annex a) -> Annex a withOtherTmp a = do Annex.addCleanup OtherTmpCleanup cleanupOtherTmp tmpdir <- fromRepo gitAnnexTmpOtherDir @@ -38,14 +38,14 @@ withOtherTmp a = do -- Unlike withOtherTmp, this does not rely on locking working. -- Its main use is in situations where the state of lockfile is not -- determined yet, eg during initialization. -withEventuallyCleanedOtherTmp :: (FilePath -> Annex a) -> Annex a +withEventuallyCleanedOtherTmp :: (RawFilePath -> Annex a) -> Annex a withEventuallyCleanedOtherTmp = bracket setup cleanup where setup = do tmpdir <- fromRepo gitAnnexTmpOtherDirOld void $ createAnnexDirectory tmpdir return tmpdir - cleanup = liftIO . void . tryIO . removeDirectory + cleanup = liftIO . void . tryIO . removeDirectory . fromRawFilePath -- | Cleans up any tmp files that were left by a previous -- git-annex process that got interrupted or failed to clean up after @@ -56,9 +56,9 @@ cleanupOtherTmp :: Annex () cleanupOtherTmp = do tmplck <- fromRepo gitAnnexTmpOtherLock void $ tryIO $ tryExclusiveLock (const tmplck) $ do - tmpdir <- fromRepo gitAnnexTmpOtherDir + tmpdir <- fromRawFilePath <$> fromRepo gitAnnexTmpOtherDir void $ liftIO $ tryIO $ removeDirectoryRecursive tmpdir - oldtmp <- fromRepo gitAnnexTmpOtherDirOld + oldtmp <- fromRawFilePath <$> fromRepo gitAnnexTmpOtherDirOld liftIO $ mapM_ cleanold =<< dirContentsRecursive oldtmp liftIO $ void $ tryIO $ removeDirectory oldtmp -- when empty where diff --git a/Assistant/Install/Menu.hs b/Assistant/Install/Menu.hs index 2faa4a655e..f2a532efe1 100644 --- a/Assistant/Install/Menu.hs +++ b/Assistant/Install/Menu.hs @@ -10,9 +10,13 @@ module Assistant.Install.Menu where -import Common - import Utility.FreeDesktop +import Utility.FileSystemEncoding +import Utility.Path + +import System.IO +import Utility.SystemDirectory +import System.FilePath installMenu :: FilePath -> FilePath -> FilePath -> FilePath -> IO () #ifdef darwin_HOST_OS diff --git a/Common.hs b/Common.hs index 877e69a483..e741c81517 100644 --- a/Common.hs +++ b/Common.hs @@ -23,6 +23,7 @@ import Utility.DebugLocks as X import Utility.SafeCommand as X import Utility.Process as X import Utility.Path as X +import Utility.Path.AbsRel as X import Utility.Directory as X import Utility.Monad as X import Utility.Data as X diff --git a/Config/Files.hs b/Config/Files.hs index 2537622f69..c53ca646a4 100644 --- a/Config/Files.hs +++ b/Config/Files.hs @@ -9,8 +9,10 @@ module Config.Files where -import Common import Utility.FreeDesktop +import Utility.Exception + +import System.FilePath {- ~/.config/git-annex/file -} userConfigFile :: FilePath -> IO FilePath diff --git a/Config/Files/AutoStart.hs b/Config/Files/AutoStart.hs index 5d9eaaf78d..5c89bd2066 100644 --- a/Config/Files/AutoStart.hs +++ b/Config/Files/AutoStart.hs @@ -12,7 +12,6 @@ module Config.Files.AutoStart where import Common import Config.Files import Utility.Tmp -import Utility.Path.AbsRel {- Returns anything listed in the autostart file (which may not exist). -} readAutoStartFile :: IO [FilePath] diff --git a/Database/Fsck.hs b/Database/Fsck.hs index caa34452df..fb1a2791a8 100644 --- a/Database/Fsck.hs +++ b/Database/Fsck.hs @@ -62,13 +62,13 @@ newPass u = isJust <$> tryExclusiveLock (gitAnnexFsckDbLock u) go go = do removedb =<< fromRepo (gitAnnexFsckDbDir u) removedb =<< fromRepo (gitAnnexFsckDbDirOld u) - removedb = liftIO . void . tryIO . removeDirectoryRecursive + removedb = liftIO . void . tryIO . removeDirectoryRecursive . fromRawFilePath {- Opens the database, creating it if it doesn't exist yet. -} openDb :: UUID -> Annex FsckHandle openDb u = do dbdir <- fromRepo (gitAnnexFsckDbDir u) - let db = dbdir "db" + let db = fromRawFilePath dbdir "db" unlessM (liftIO $ doesFileExist db) $ do initDb db $ void $ runMigrationSilent migrateFsck diff --git a/Git.hs b/Git.hs index b875441bbf..32cf82e7f2 100644 --- a/Git.hs +++ b/Git.hs @@ -47,7 +47,6 @@ import qualified System.FilePath.ByteString as P import Common import Git.Types -import Utility.Path.AbsRel #ifndef mingw32_HOST_OS import Utility.FileMode #endif diff --git a/Git/CheckAttr.hs b/Git/CheckAttr.hs index ae50acee64..fd7b502120 100644 --- a/Git/CheckAttr.hs +++ b/Git/CheckAttr.hs @@ -10,7 +10,6 @@ module Git.CheckAttr where import Common import Git import Git.Command -import Utility.Path.AbsRel import qualified Utility.CoProcess as CoProcess import qualified Utility.RawFilePath as R diff --git a/Git/Config.hs b/Git/Config.hs index 2425d6f58f..df16196ec0 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -23,7 +23,6 @@ import qualified Git.Command import qualified Git.Construct import Utility.UserInfo import Utility.ThreadScheduler -import Utility.Path.AbsRel {- Returns a single git config setting, or a fallback value if not set. -} get :: ConfigKey -> ConfigValue -> Repo -> ConfigValue diff --git a/Git/Construct.hs b/Git/Construct.hs index 9cc7f748f7..e2a36f5035 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -38,7 +38,6 @@ import Git.Remote import Git.FilePath import qualified Git.Url as Url import Utility.UserInfo -import Utility.Path.AbsRel import qualified Data.ByteString as B import qualified System.FilePath.ByteString as P diff --git a/Git/CurrentRepo.hs b/Git/CurrentRepo.hs index 1909d334c4..25bdc5c635 100644 --- a/Git/CurrentRepo.hs +++ b/Git/CurrentRepo.hs @@ -15,7 +15,6 @@ import Git.Construct import qualified Git.Config import Utility.Env import Utility.Env.Set -import Utility.Path.AbsRel import qualified Utility.RawFilePath as R import qualified Data.ByteString as B diff --git a/Git/FilePath.hs b/Git/FilePath.hs index 54ea95bc3a..feed8f6736 100644 --- a/Git/FilePath.hs +++ b/Git/FilePath.hs @@ -30,7 +30,6 @@ module Git.FilePath ( import Common import Git -import Utility.Path.AbsRel import qualified System.FilePath.ByteString as P import qualified System.FilePath.Posix.ByteString diff --git a/Git/HashObject.hs b/Git/HashObject.hs index 05b9092e63..98bd4407b6 100644 --- a/Git/HashObject.hs +++ b/Git/HashObject.hs @@ -16,7 +16,6 @@ import Git.Command import Git.Types import qualified Utility.CoProcess as CoProcess import Utility.Tmp -import Utility.Path.AbsRel import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 diff --git a/Git/Index.hs b/Git/Index.hs index ed71878b66..c946015cfe 100644 --- a/Git/Index.hs +++ b/Git/Index.hs @@ -11,7 +11,6 @@ import Common import Git import Utility.Env import Utility.Env.Set -import Utility.Path.AbsRel indexEnv :: String indexEnv = "GIT_INDEX_FILE" diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index 3ba4ae9967..297c068284 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -37,7 +37,6 @@ import Git.Sha import Utility.InodeCache import Utility.TimeStamp import Utility.Attoparsec -import Utility.Path.AbsRel import qualified Utility.RawFilePath as R import System.Posix.Types diff --git a/Git/Version.hs b/Git/Version.hs index 5ecaca0c1c..9119f5dac8 100644 --- a/Git/Version.hs +++ b/Git/Version.hs @@ -14,7 +14,7 @@ module Git.Version ( GitVersion, ) where -import Common +import Utility.Process import Utility.DottedVersion type GitVersion = DottedVersion diff --git a/Logs/File.hs b/Logs/File.hs index 37c16c033d..e0c34b4c9e 100644 --- a/Logs/File.hs +++ b/Logs/File.hs @@ -29,8 +29,8 @@ import qualified Data.ByteString.Lazy.Char8 as L8 -- | Writes content to a file, replacing the file atomically, and -- making the new file have whatever permissions the git repository is -- configured to use. Creates the parent directory when necessary. -writeLogFile :: FilePath -> String -> Annex () -writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog f c +writeLogFile :: RawFilePath -> String -> Annex () +writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog (fromRawFilePath f) c where writelog f' c' = do liftIO $ writeFile f' c' @@ -38,10 +38,10 @@ writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog f c -- | Runs the action with a handle connected to a temp file. -- The temp file replaces the log file once the action succeeds. -withLogHandle :: FilePath -> (Handle -> Annex a) -> Annex a +withLogHandle :: RawFilePath -> (Handle -> Annex a) -> Annex a withLogHandle f a = do createAnnexDirectory (parentDir f) - replaceGitAnnexDirFile f $ \tmp -> + replaceGitAnnexDirFile (fromRawFilePath f) $ \tmp -> bracket (setup tmp) cleanup a where setup tmp = do @@ -51,10 +51,12 @@ withLogHandle f a = do -- | Appends a line to a log file, first locking it to prevent -- concurrent writers. -appendLogFile :: FilePath -> (Git.Repo -> FilePath) -> L.ByteString -> Annex () -appendLogFile f lck c = createDirWhenNeeded f $ withExclusiveLock lck $ do - liftIO $ withFile f AppendMode $ \h -> L8.hPutStrLn h c - setAnnexFilePerm f +appendLogFile :: FilePath -> (Git.Repo -> RawFilePath) -> L.ByteString -> Annex () +appendLogFile f lck c = + createDirWhenNeeded (toRawFilePath f) $ + withExclusiveLock lck $ do + liftIO $ withFile f AppendMode $ \h -> L8.hPutStrLn h c + setAnnexFilePerm f -- | Modifies a log file. -- @@ -64,13 +66,13 @@ appendLogFile f lck c = createDirWhenNeeded f $ withExclusiveLock lck $ do -- -- The file is locked to prevent concurrent writers, and it is written -- atomically. -modifyLogFile :: FilePath -> (Git.Repo -> FilePath) -> ([L.ByteString] -> [L.ByteString]) -> Annex () +modifyLogFile :: FilePath -> (Git.Repo -> RawFilePath) -> ([L.ByteString] -> [L.ByteString]) -> Annex () modifyLogFile f lck modf = withExclusiveLock lck $ do ls <- liftIO $ fromMaybe [] <$> tryWhenExists (L8.lines <$> L.readFile f) let ls' = modf ls when (ls' /= ls) $ - createDirWhenNeeded f $ + createDirWhenNeeded (toRawFilePath f) $ viaTmp writelog f (L8.unlines ls') where writelog f' b = do @@ -83,7 +85,7 @@ modifyLogFile f lck modf = withExclusiveLock lck $ do -- action is concurrently modifying the file. It does not lock the file, -- for speed, but instead relies on the fact that a log file usually -- ends in a newline. -checkLogFile :: FilePath -> (Git.Repo -> FilePath) -> (L.ByteString -> Bool) -> Annex Bool +checkLogFile :: FilePath -> (Git.Repo -> RawFilePath) -> (L.ByteString -> Bool) -> Annex Bool checkLogFile f lck matchf = withExclusiveLock lck $ bracket setup cleanup go where setup = liftIO $ tryWhenExists $ openFile f ReadMode @@ -117,7 +119,7 @@ fullLines = go [] -- -- Locking is used to prevent writes to to the log file while this -- is running. -streamLogFile :: FilePath -> (Git.Repo -> FilePath) -> (String -> Annex ()) -> Annex () +streamLogFile :: FilePath -> (Git.Repo -> RawFilePath) -> (String -> Annex ()) -> Annex () streamLogFile f lck a = withExclusiveLock lck $ bracketOnError setup cleanup go where setup = liftIO $ tryWhenExists $ openFile f ReadMode @@ -130,7 +132,7 @@ streamLogFile f lck a = withExclusiveLock lck $ bracketOnError setup cleanup go liftIO $ writeFile f "" setAnnexFilePerm f -createDirWhenNeeded :: FilePath -> Annex () -> Annex () +createDirWhenNeeded :: RawFilePath -> Annex () -> Annex () createDirWhenNeeded f a = a `catchNonAsync` \_e -> do -- Most of the time, the directory will exist, so this is only -- done if writing the file fails. diff --git a/Logs/FsckResults.hs b/Logs/FsckResults.hs index ee861704c2..e33caa9545 100644 --- a/Logs/FsckResults.hs +++ b/Logs/FsckResults.hs @@ -15,6 +15,7 @@ import Annex.Common import Git.Fsck import Git.Types import Logs.File +import qualified Utility.RawFilePath as R import qualified Data.Set as S @@ -24,7 +25,8 @@ writeFsckResults u fsckresults = do case fsckresults of FsckFailed -> store S.empty False logfile FsckFoundMissing s t - | S.null s -> liftIO $ removeWhenExistsWith removeLink logfile + | S.null s -> liftIO $ + removeWhenExistsWith R.removeLink logfile | otherwise -> store s t logfile where store s t logfile = writeLogFile logfile $ serialize s t @@ -38,7 +40,7 @@ readFsckResults :: UUID -> Annex FsckResults readFsckResults u = do logfile <- fromRepo $ gitAnnexFsckResultsLog u liftIO $ catchDefaultIO (FsckFoundMissing S.empty False) $ - deserialize . lines <$> readFile logfile + deserialize . lines <$> readFile (fromRawFilePath logfile) where deserialize ("truncated":ls) = deserialize' ls True deserialize ls = deserialize' ls False @@ -47,6 +49,6 @@ readFsckResults u = do in if S.null s then FsckFailed else FsckFoundMissing s t clearFsckResults :: UUID -> Annex () -clearFsckResults = liftIO . removeWhenExistsWith removeLink +clearFsckResults = liftIO . removeWhenExistsWith R.removeLink <=< fromRepo . gitAnnexFsckResultsLog diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 1b30e9548a..2722702d2f 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -5,6 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Logs.Transfer where @@ -19,6 +20,7 @@ import Utility.PID import Annex.LockPool import Utility.TimeStamp import Logs.File +import qualified Utility.RawFilePath as R #ifndef mingw32_HOST_OS import Annex.Perms #endif @@ -26,6 +28,8 @@ import Annex.Perms import Data.Time.Clock import Data.Time.Clock.POSIX import Control.Concurrent +import qualified Data.ByteString.Char8 as B8 +import qualified System.FilePath.ByteString as P describeTransfer :: Transfer -> TransferInfo -> String describeTransfer t info = unwords @@ -56,12 +60,12 @@ percentComplete t info = - which should be run after locking the transfer lock file, but - before using the callback, and a MVar that can be used to read - the number of bytesComplete. -} -mkProgressUpdater :: Transfer -> TransferInfo -> Annex (MeterUpdate, FilePath, Annex (), MVar Integer) +mkProgressUpdater :: Transfer -> TransferInfo -> Annex (MeterUpdate, RawFilePath, Annex (), MVar Integer) mkProgressUpdater t info = do tfile <- fromRepo $ transferFile t let createtfile = void $ tryNonAsync $ writeTransferInfoFile info tfile mvar <- liftIO $ newMVar 0 - return (liftIO . updater tfile mvar, tfile, createtfile, mvar) + return (liftIO . updater (fromRawFilePath tfile) mvar, tfile, createtfile, mvar) where updater tfile mvar b = modifyMVar_ mvar $ \oldbytes -> do let newbytes = fromBytesProcessed b @@ -103,13 +107,13 @@ checkTransfer t = debugLocks $ do tfile <- fromRepo $ transferFile t let lck = transferLockFile tfile let cleanstale = do - void $ tryIO $ removeFile tfile - void $ tryIO $ removeFile lck + void $ tryIO $ R.removeLink tfile + void $ tryIO $ R.removeLink lck #ifndef mingw32_HOST_OS v <- getLockStatus lck case v of StatusLockedBy pid -> liftIO $ catchDefaultIO Nothing $ - readTransferInfoFile (Just pid) tfile + readTransferInfoFile (Just pid) (fromRawFilePath tfile) _ -> do -- Take a non-blocking lock while deleting -- the stale lock file. Ignore failure @@ -145,7 +149,7 @@ getTransfers' dirs wanted = do infos <- mapM checkTransfer transfers return $ mapMaybe running $ zip transfers infos where - findfiles = liftIO . mapM dirContentsRecursive + findfiles = liftIO . mapM (dirContentsRecursive . fromRawFilePath) =<< mapM (fromRepo . transferDir) dirs running (t, Just i) = Just (t, i) running (_, Nothing) = Nothing @@ -172,7 +176,7 @@ getFailedTransfers u = catMaybes <$> (liftIO . getpairs =<< concat <$> findfiles return $ case (mt, mi) of (Just t, Just i) -> Just (t, i) _ -> Nothing - findfiles = liftIO . mapM dirContentsRecursive + findfiles = liftIO . mapM (dirContentsRecursive . fromRawFilePath) =<< mapM (fromRepo . failedTransferDir u) [Download, Upload] clearFailedTransfers :: UUID -> Annex [(Transfer, TransferInfo)] @@ -184,7 +188,7 @@ clearFailedTransfers u = do removeFailedTransfer :: Transfer -> Annex () removeFailedTransfer t = do f <- fromRepo $ failedTransferFile t - liftIO $ void $ tryIO $ removeFile f + liftIO $ void $ tryIO $ R.removeLink f recordFailedTransfer :: Transfer -> TransferInfo -> Annex () recordFailedTransfer t info = do @@ -192,20 +196,23 @@ recordFailedTransfer t info = do writeTransferInfoFile info failedtfile {- The transfer information file to use for a given Transfer. -} -transferFile :: Transfer -> Git.Repo -> FilePath -transferFile (Transfer direction u kd) r = transferDir direction r - filter (/= '/') (fromUUID u) - fromRawFilePath (keyFile (mkKey (const kd))) +transferFile :: Transfer -> Git.Repo -> RawFilePath +transferFile (Transfer direction u kd) r = + transferDir direction r + P. B8.filter (/= '/') (fromUUID u) + P. 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 - fromRawFilePath (keyFile (mkKey (const kd))) +failedTransferFile :: Transfer -> Git.Repo -> RawFilePath +failedTransferFile (Transfer direction u kd) r = + failedTransferDir u direction r + P. keyFile (mkKey (const kd)) {- The transfer lock file corresponding to a given transfer info file. -} -transferLockFile :: FilePath -> FilePath -transferLockFile infofile = let (d,f) = splitFileName infofile in - combine d ("lck." ++ f) +transferLockFile :: RawFilePath -> RawFilePath +transferLockFile infofile = + let (d, f) = P.splitFileName infofile + in P.combine d ("lck." <> f) {- Parses a transfer information filename to a Transfer. -} parseTransferFile :: FilePath -> Maybe Transfer @@ -220,7 +227,7 @@ parseTransferFile file where bits = splitDirectories file -writeTransferInfoFile :: TransferInfo -> FilePath -> Annex () +writeTransferInfoFile :: TransferInfo -> RawFilePath -> Annex () writeTransferInfoFile info tfile = writeLogFile tfile $ writeTransferInfo info -- The file keeps whatever permissions it has, so should be used only @@ -286,16 +293,16 @@ readTransferInfo mpid s = TransferInfo else pure Nothing -- not failure {- The directory holding transfer information files for a given Direction. -} -transferDir :: Direction -> Git.Repo -> FilePath -transferDir direction r = gitAnnexTransferDir r formatDirection direction +transferDir :: Direction -> Git.Repo -> RawFilePath +transferDir direction r = gitAnnexTransferDir r P. formatDirection direction {- The directory holding failed transfer information files for a given - Direction and UUID -} -failedTransferDir :: UUID -> Direction -> Git.Repo -> FilePath +failedTransferDir :: UUID -> Direction -> Git.Repo -> RawFilePath failedTransferDir u direction r = gitAnnexTransferDir r - "failed" - formatDirection direction - filter (/= '/') (fromUUID u) + P. "failed" + P. formatDirection direction + P. B8.filter (/= '/') (fromUUID u) prop_read_write_transferinfo :: TransferInfo -> Bool prop_read_write_transferinfo info diff --git a/Logs/Unused.hs b/Logs/Unused.hs index c56f93ba24..0fdec4c0d4 100644 --- a/Logs/Unused.hs +++ b/Logs/Unused.hs @@ -15,6 +15,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Logs.Unused ( UnusedMap, updateUnusedLog, @@ -55,13 +57,13 @@ preserveTimestamps oldl newl = M.intersection (M.unionWith oldts oldl newl) newl where oldts _old@(_, ts) _new@(int, _) = (int, ts) -updateUnusedLog :: FilePath -> UnusedMap -> Annex () +updateUnusedLog :: RawFilePath -> UnusedMap -> Annex () updateUnusedLog prefix m = do oldl <- readUnusedLog prefix newl <- preserveTimestamps oldl . flip map2log m <$> liftIO getPOSIXTime writeUnusedLog prefix newl -writeUnusedLog :: FilePath -> UnusedLog -> Annex () +writeUnusedLog :: RawFilePath -> UnusedLog -> Annex () writeUnusedLog prefix l = do logfile <- fromRepo $ gitAnnexUnusedLog prefix writeLogFile logfile $ unlines $ map format $ M.toList l @@ -69,9 +71,9 @@ writeUnusedLog prefix l = do format (k, (i, Just t)) = show i ++ " " ++ serializeKey k ++ " " ++ show t format (k, (i, Nothing)) = show i ++ " " ++ serializeKey k -readUnusedLog :: FilePath -> Annex UnusedLog +readUnusedLog :: RawFilePath -> Annex UnusedLog readUnusedLog prefix = do - f <- fromRepo $ gitAnnexUnusedLog prefix + f <- fromRawFilePath <$> fromRepo (gitAnnexUnusedLog prefix) ifM (liftIO $ doesFileExist f) ( M.fromList . mapMaybe parse . lines <$> liftIO (readFileStrict f) @@ -87,13 +89,13 @@ readUnusedLog prefix = do skey = reverse rskey ts = reverse rts -readUnusedMap :: FilePath -> Annex UnusedMap +readUnusedMap :: RawFilePath -> Annex UnusedMap readUnusedMap = log2map <$$> readUnusedLog -dateUnusedLog :: FilePath -> Annex (Maybe UTCTime) +dateUnusedLog :: RawFilePath -> Annex (Maybe UTCTime) dateUnusedLog prefix = do f <- fromRepo $ gitAnnexUnusedLog prefix - liftIO $ catchMaybeIO $ getModificationTime f + liftIO $ catchMaybeIO $ getModificationTime $ fromRawFilePath f {- Set of unused keys. This is cached for speed. -} unusedKeys :: Annex (S.Set Key) diff --git a/Logs/View.hs b/Logs/View.hs index ea28f29b55..f76a9b9ec2 100644 --- a/Logs/View.hs +++ b/Logs/View.hs @@ -50,7 +50,7 @@ removeView v = writeViews =<< filter (/= v) <$> recentViews recentViews :: Annex [View] recentViews = do - f <- fromRepo gitAnnexViewLog + f <- fromRawFilePath <$> fromRepo gitAnnexViewLog liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFile f) {- Gets the currently checked out view, if there is one. -} diff --git a/Types/Transfer.hs b/Types/Transfer.hs index fed03cb0a3..8f13af702e 100644 --- a/Types/Transfer.hs +++ b/Types/Transfer.hs @@ -5,6 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} module Types.Transfer where @@ -17,6 +18,7 @@ import Utility.QuickCheck import Utility.Url import Utility.FileSystemEncoding +import qualified Data.ByteString as B import Data.Time.Clock.POSIX import Control.Concurrent import Control.Applicative @@ -56,7 +58,7 @@ stubTransferInfo = TransferInfo Nothing Nothing Nothing Nothing Nothing (Associa data Direction = Upload | Download deriving (Eq, Ord, Show, Read) -formatDirection :: Direction -> String +formatDirection :: Direction -> B.ByteString formatDirection Upload = "upload" formatDirection Download = "download" diff --git a/Upgrade/V5/Direct.hs b/Upgrade/V5/Direct.hs index 6fcc98be7a..d10d1182e7 100644 --- a/Upgrade/V5/Direct.hs +++ b/Upgrade/V5/Direct.hs @@ -28,6 +28,7 @@ import Config import Annex.Perms import Utility.InodeCache import Annex.InodeSentinal +import qualified Utility.RawFilePath as R setIndirect :: Annex () setIndirect = do @@ -86,7 +87,7 @@ associatedFiles key = do - the top of the repo. -} associatedFilesRelative :: Key -> Annex [FilePath] associatedFilesRelative key = do - mapping <- calcRepo $ gitAnnexMapping key + mapping <- fromRawFilePath <$> calcRepo (gitAnnexMapping key) liftIO $ catchDefaultIO [] $ withFile mapping ReadMode $ \h -> -- Read strictly to ensure the file is closed promptly lines <$> hGetContentsStrict h @@ -96,7 +97,7 @@ removeAssociatedFiles :: Key -> Annex () removeAssociatedFiles key = do mapping <- calcRepo $ gitAnnexMapping key modifyContent mapping $ - liftIO $ removeWhenExistsWith removeLink mapping + liftIO $ removeWhenExistsWith R.removeLink mapping {- Checks if a file in the tree, associated with a key, has not been modified. - @@ -116,13 +117,14 @@ goodContent key file = recordedInodeCache :: Key -> Annex [InodeCache] recordedInodeCache key = withInodeCacheFile key $ \f -> liftIO $ catchDefaultIO [] $ - mapMaybe readInodeCache . lines <$> readFileStrict f + mapMaybe readInodeCache . lines + <$> readFileStrict (fromRawFilePath f) {- Removes an inode cache. -} removeInodeCache :: Key -> Annex () removeInodeCache key = withInodeCacheFile key $ \f -> modifyContent f $ - liftIO $ removeWhenExistsWith removeLink f + liftIO $ removeWhenExistsWith R.removeLink f -withInodeCacheFile :: Key -> (FilePath -> Annex a) -> Annex a +withInodeCacheFile :: Key -> (RawFilePath -> Annex a) -> Annex a withInodeCacheFile key a = a =<< calcRepo (gitAnnexInodeCache key) diff --git a/Utility/DottedVersion.hs b/Utility/DottedVersion.hs index dff37176ba..84b8463dbe 100644 --- a/Utility/DottedVersion.hs +++ b/Utility/DottedVersion.hs @@ -13,7 +13,7 @@ module Utility.DottedVersion ( normalize, ) where -import Common +import Utility.Split data DottedVersion = DottedVersion String Integer deriving (Eq) diff --git a/Utility/RawFilePath.hs b/Utility/RawFilePath.hs index b5b2ec20ef..f5fff2a40e 100644 --- a/Utility/RawFilePath.hs +++ b/Utility/RawFilePath.hs @@ -32,7 +32,7 @@ import Utility.FileSystemEncoding (RawFilePath) import System.Posix.Files.ByteString import qualified System.Posix.Directory.ByteString as D --- | Checks if a file or directoy exists. Note that a dangling symlink +-- | Checks if a file or directory exists. Note that a dangling symlink -- will be false. doesPathExist :: RawFilePath -> IO Bool doesPathExist = fileExist