diff --git a/Annex/Locations.hs b/Annex/Locations.hs index ce05056b3f..647e5ef50c 100644 --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -795,6 +795,3 @@ keyPath key hasher = hasher key f f keyPaths :: Key -> NE.NonEmpty OsPath keyPaths key = NE.map (\h -> keyPath key (h def)) dirHashes -uuidPath :: UUID -> OsPath -uuidPath u = toOsPath (fromUUID u :: SB.ShortByteString) - diff --git a/Annex/LockFile.hs b/Annex/LockFile.hs index 9e8d1b8105..079f6a57f3 100644 --- a/Annex/LockFile.hs +++ b/Annex/LockFile.hs @@ -26,11 +26,10 @@ import Annex.Perms import Annex.LockPool import qualified Data.Map as M -import qualified System.FilePath.ByteString as P {- Create a specified lock file, and takes a shared lock, which is retained - in the cache. -} -lockFileCached :: RawFilePath -> Annex () +lockFileCached :: OsPath -> Annex () lockFileCached file = go =<< fromLockCache file where go (Just _) = noop -- already locked @@ -43,7 +42,7 @@ lockFileCached file = go =<< fromLockCache file #endif changeLockCache $ M.insert file lockhandle -unlockFile :: RawFilePath -> Annex () +unlockFile :: OsPath -> Annex () unlockFile file = maybe noop go =<< fromLockCache file where go lockhandle = do @@ -53,7 +52,7 @@ unlockFile file = maybe noop go =<< fromLockCache file getLockCache :: Annex LockCache getLockCache = getState lockcache -fromLockCache :: RawFilePath -> Annex (Maybe LockHandle) +fromLockCache :: OsPath -> Annex (Maybe LockHandle) fromLockCache file = M.lookup file <$> getLockCache changeLockCache :: (LockCache -> LockCache) -> Annex () @@ -63,9 +62,9 @@ changeLockCache a = do {- Runs an action with a shared lock held. If an exclusive lock is held, - blocks until it becomes free. -} -withSharedLock :: RawFilePath -> Annex a -> Annex a +withSharedLock :: OsPath -> Annex a -> Annex a withSharedLock lockfile a = debugLocks $ do - createAnnexDirectory $ P.takeDirectory lockfile + createAnnexDirectory $ takeDirectory lockfile mode <- annexFileMode bracket (lock mode lockfile) (liftIO . dropLock) (const a) where @@ -77,16 +76,16 @@ withSharedLock lockfile a = debugLocks $ do {- Runs an action with an exclusive lock held. If the lock is already - held, blocks until it becomes free. -} -withExclusiveLock :: RawFilePath -> Annex a -> Annex a +withExclusiveLock :: OsPath -> Annex a -> Annex a withExclusiveLock lockfile a = bracket (takeExclusiveLock lockfile) (liftIO . dropLock) (const a) {- Takes an exclusive lock, blocking until it's free. -} -takeExclusiveLock :: RawFilePath -> Annex LockHandle +takeExclusiveLock :: OsPath -> Annex LockHandle takeExclusiveLock lockfile = debugLocks $ do - createAnnexDirectory $ P.takeDirectory lockfile + createAnnexDirectory $ takeDirectory lockfile mode <- annexFileMode lock mode lockfile where @@ -98,9 +97,9 @@ takeExclusiveLock lockfile = debugLocks $ do {- Tries to take an exclusive lock and run an action. If the lock is - already held, returns Nothing. -} -tryExclusiveLock :: RawFilePath -> Annex a -> Annex (Maybe a) +tryExclusiveLock :: OsPath -> Annex a -> Annex (Maybe a) tryExclusiveLock lockfile a = debugLocks $ do - createAnnexDirectory $ P.takeDirectory lockfile + createAnnexDirectory $ takeDirectory lockfile mode <- annexFileMode bracket (lock mode lockfile) (liftIO . unlock) go where @@ -118,7 +117,7 @@ tryExclusiveLock lockfile a = debugLocks $ do - Does not create the lock directory or lock file if it does not exist, - taking an exclusive lock will create them. -} -trySharedLock :: RawFilePath -> Annex (Maybe LockHandle) +trySharedLock :: OsPath -> Annex (Maybe LockHandle) trySharedLock lockfile = debugLocks $ #ifndef mingw32_HOST_OS tryLockShared Nothing lockfile diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs index 5cb46b17dd..4262131219 100644 --- a/Annex/ReplaceFile.hs +++ b/Annex/ReplaceFile.hs @@ -24,17 +24,17 @@ import Utility.Directory.Create import qualified System.FilePath.ByteString as P {- replaceFile on a file located inside the gitAnnexDir. -} -replaceGitAnnexDirFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a +replaceGitAnnexDirFile :: OsPath -> (OsPath -> Annex a) -> Annex a replaceGitAnnexDirFile = replaceFile createAnnexDirectory {- replaceFile on a file located inside the .git directory. -} -replaceGitDirFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a +replaceGitDirFile :: OsPath -> (OsPath -> Annex a) -> Annex a replaceGitDirFile = replaceFile $ \dir -> do top <- fromRepo localGitDir liftIO $ createDirectoryUnder [top] dir {- replaceFile on a worktree file. -} -replaceWorkTreeFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a +replaceWorkTreeFile :: OsPath -> (OsPath -> Annex a) -> Annex a replaceWorkTreeFile = replaceFile createWorkTreeDirectory {- Replaces a possibly already existing file with a new version, @@ -52,20 +52,20 @@ 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 :: (RawFilePath -> Annex ()) -> RawFilePath -> (RawFilePath -> Annex a) -> Annex a +replaceFile :: (OsPath -> Annex ()) -> OsPath -> (OsPath -> Annex a) -> Annex a replaceFile createdirectory file action = replaceFile' createdirectory file (const True) action -replaceFile' :: (RawFilePath -> Annex ()) -> RawFilePath -> (a -> Bool) -> (RawFilePath -> Annex a) -> Annex a +replaceFile' :: (OsPath -> Annex ()) -> OsPath -> (a -> Bool) -> (OsPath -> Annex a) -> Annex a replaceFile' createdirectory file checkres action = withOtherTmp $ \othertmpdir -> do - let basetmp = relatedTemplate' (P.takeFileName file) - withTmpDirIn (fromRawFilePath othertmpdir) (toOsPath basetmp) $ \tmpdir -> do - let tmpfile = toRawFilePath tmpdir P. basetmp + let basetmp = relatedTemplate (fromOsPath (takeFileName file)) + withTmpDirIn othertmpdir basetmp $ \tmpdir -> do + let tmpfile = tmpdir basetmp r <- action tmpfile when (checkres r) $ replaceFileFrom tmpfile file createdirectory return r -replaceFileFrom :: RawFilePath -> RawFilePath -> (RawFilePath -> Annex ()) -> Annex () +replaceFileFrom :: OsPath -> OsPath -> (OsPath -> Annex ()) -> Annex () replaceFileFrom src dest createdirectory = go `catchIO` fallback where go = liftIO $ moveFile src dest diff --git a/Annex/Tmp.hs b/Annex/Tmp.hs index 6f9f28b8b6..6a1fd99f7e 100644 --- a/Annex/Tmp.hs +++ b/Annex/Tmp.hs @@ -23,7 +23,7 @@ import System.PosixCompat.Files (modificationTime) -- 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 :: (RawFilePath -> Annex a) -> Annex a +withOtherTmp :: (OsPath -> Annex a) -> Annex a withOtherTmp a = do Annex.addCleanupAction OtherTmpCleanup cleanupOtherTmp tmpdir <- fromRepo gitAnnexTmpOtherDir @@ -40,14 +40,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 :: (RawFilePath -> Annex a) -> Annex a +withEventuallyCleanedOtherTmp :: (OsPath -> Annex a) -> Annex a withEventuallyCleanedOtherTmp = bracket setup cleanup where setup = do tmpdir <- fromRepo gitAnnexTmpOtherDirOld void $ createAnnexDirectory tmpdir return tmpdir - cleanup = liftIO . void . tryIO . removeDirectory . fromRawFilePath + cleanup = liftIO . void . tryIO . removeDirectory -- | Cleans up any tmp files that were left by a previous -- git-annex process that got interrupted or failed to clean up after @@ -58,14 +58,13 @@ cleanupOtherTmp :: Annex () cleanupOtherTmp = do tmplck <- fromRepo gitAnnexTmpOtherLock void $ tryIO $ tryExclusiveLock tmplck $ do - tmpdir <- fromRawFilePath <$> fromRepo gitAnnexTmpOtherDir + tmpdir <- fromRepo gitAnnexTmpOtherDir void $ liftIO $ tryIO $ removeDirectoryRecursive tmpdir oldtmp <- fromRepo gitAnnexTmpOtherDirOld - liftIO $ mapM_ cleanold + liftIO $ mapM_ (cleanold . fromOsPath) =<< emptyWhenDoesNotExist (dirContentsRecursive oldtmp) -- remove when empty - liftIO $ void $ tryIO $ - removeDirectory (fromRawFilePath oldtmp) + liftIO $ void $ tryIO $ removeDirectory oldtmp where cleanold f = do now <- liftIO getPOSIXTime diff --git a/Database/ContentIdentifier.hs b/Database/ContentIdentifier.hs index 3a399f7765..2f112a209c 100644 --- a/Database/ContentIdentifier.hs +++ b/Database/ContentIdentifier.hs @@ -98,8 +98,8 @@ AnnexBranch openDb :: Annex ContentIdentifierHandle openDb = do dbdir <- calcRepo' gitAnnexContentIdentifierDbDir - let db = dbdir P. "db" - isnew <- liftIO $ not <$> R.doesPathExist db + let db = dbdir literalOsPath "db" + isnew <- liftIO $ not <$> doesDirectoryPathExist db if isnew then initDb db $ void $ runMigrationSilent migrateContentIdentifier diff --git a/Database/Fsck.hs b/Database/Fsck.hs index 2ff4eb6bb5..496903e0e4 100644 --- a/Database/Fsck.hs +++ b/Database/Fsck.hs @@ -33,12 +33,10 @@ import Annex.Locations import Utility.Exception import Annex.Common import Annex.LockFile -import qualified Utility.RawFilePath as R import Database.Persist.Sql hiding (Key) import Database.Persist.TH import Data.Time.Clock -import qualified System.FilePath.ByteString as P data FsckHandle = FsckHandle H.DbQueue UUID @@ -66,14 +64,14 @@ newPass u = do go = do removedb =<< calcRepo' (gitAnnexFsckDbDir u) removedb =<< calcRepo' (gitAnnexFsckDbDirOld u) - removedb = liftIO . void . tryIO . removeDirectoryRecursive . fromRawFilePath + removedb = liftIO . void . tryIO . removeDirectoryRecursive {- Opens the database, creating it if it doesn't exist yet. -} openDb :: UUID -> Annex FsckHandle openDb u = do dbdir <- calcRepo' (gitAnnexFsckDbDir u) - let db = dbdir P. "db" - unlessM (liftIO $ R.doesPathExist db) $ do + let db = dbdir literalOsPath "db" + unlessM (liftIO $ doesDirectoryExist db) $ do initDb db $ void $ runMigrationSilent migrateFsck lockFileCached =<< calcRepo' (gitAnnexFsckDbLock u) diff --git a/Database/RepoSize.hs b/Database/RepoSize.hs index 0118e88a7b..93c6b1d5ba 100644 --- a/Database/RepoSize.hs +++ b/Database/RepoSize.hs @@ -42,11 +42,9 @@ import Database.Utility import Database.Types import Annex.LockFile import Git.Types -import qualified Utility.RawFilePath as R import Database.Persist.Sql hiding (Key) import Database.Persist.TH -import qualified System.FilePath.ByteString as P import qualified Data.Map.Strict as M import qualified Data.Set as S import Control.Exception @@ -107,8 +105,8 @@ getRepoSizeHandle = Annex.getState Annex.reposizehandle >>= \case openDb :: Annex RepoSizeHandle openDb = lockDbWhile permerr $ do dbdir <- calcRepo' gitAnnexRepoSizeDbDir - let db = dbdir P. "db" - unlessM (liftIO $ R.doesPathExist db) $ do + let db = dbdir literalOsPath "db" + unlessM (liftIO $ doesDirectoryExist db) $ do initDb db $ void $ runMigrationSilent migrateRepoSizes h <- liftIO $ H.openDb db "repo_sizes" diff --git a/Git/Repair.hs b/Git/Repair.hs index 30fc3fb720..904cca52b7 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -95,7 +95,7 @@ explodePacks r = go =<< listPackFiles r f <- relPathDirToFile tmpdir objfile let dest = objectsDir r f createDirectoryIfMissing True (parentDir dest) - moveFile (fromOsPath objfile) (fromOsPath dest) + moveFile objfile dest forM_ packs $ \packfile -> do removeWhenExistsWith R.removeLink (fromOsPath packfile) removeWhenExistsWith R.removeLink (fromOsPath (packIdxFile packfile)) diff --git a/Logs/File.hs b/Logs/File.hs index 93aef17f97..ed95627883 100644 --- a/Logs/File.hs +++ b/Logs/File.hs @@ -34,16 +34,16 @@ 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 :: RawFilePath -> String -> Annex () -writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog (toOsPath f) c +writeLogFile :: OsPath -> String -> Annex () +writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog f c where writelog tmp c' = do - liftIO $ writeFile (fromRawFilePath (fromOsPath tmp)) c' - setAnnexFilePerm (fromOsPath tmp) + liftIO $ writeFile (fromOsPath tmp) c' + setAnnexFilePerm tmp -- | Runs the action with a handle connected to a temp file. -- The temp file replaces the log file once the action succeeds. -withLogHandle :: RawFilePath -> (Handle -> Annex a) -> Annex a +withLogHandle :: OsPath -> (Handle -> Annex a) -> Annex a withLogHandle f a = do createAnnexDirectory (parentDir f) replaceGitAnnexDirFile f $ \tmp -> @@ -51,16 +51,16 @@ withLogHandle f a = do where setup tmp = do setAnnexFilePerm tmp - liftIO $ F.openFile (toOsPath tmp) WriteMode + liftIO $ F.openFile tmp WriteMode cleanup h = liftIO $ hClose h -- | Appends a line to a log file, first locking it to prevent -- concurrent writers. -appendLogFile :: RawFilePath -> RawFilePath -> L.ByteString -> Annex () +appendLogFile :: OsPath -> OsPath -> L.ByteString -> Annex () appendLogFile f lck c = createDirWhenNeeded f $ withExclusiveLock lck $ do - liftIO $ F.withFile (toOsPath f) AppendMode $ + liftIO $ F.withFile f AppendMode $ \h -> L8.hPutStrLn h c setAnnexFilePerm f @@ -72,25 +72,24 @@ appendLogFile f lck c = -- -- The file is locked to prevent concurrent writers, and it is written -- atomically. -modifyLogFile :: RawFilePath -> RawFilePath -> ([L.ByteString] -> [L.ByteString]) -> Annex () +modifyLogFile :: OsPath -> OsPath -> ([L.ByteString] -> [L.ByteString]) -> Annex () modifyLogFile f lck modf = withExclusiveLock lck $ do ls <- liftIO $ fromMaybe [] - <$> tryWhenExists (fileLines <$> F.readFile f') + <$> tryWhenExists (fileLines <$> F.readFile f) let ls' = modf ls when (ls' /= ls) $ createDirWhenNeeded f $ - viaTmp writelog f' (L8.unlines ls') + viaTmp writelog f (L8.unlines ls') where - f' = toOsPath f writelog lf b = do liftIO $ F.writeFile lf b - setAnnexFilePerm (fromOsPath lf) + setAnnexFilePerm lf -- | Checks the content of a log file to see if any line matches. -checkLogFile :: RawFilePath -> RawFilePath -> (L.ByteString -> Bool) -> Annex Bool +checkLogFile :: OsPath -> OsPath -> (L.ByteString -> Bool) -> Annex Bool checkLogFile f lck matchf = withSharedLock lck $ bracket setup cleanup go where - setup = liftIO $ tryWhenExists $ F.openFile (toOsPath f) ReadMode + setup = liftIO $ tryWhenExists $ F.openFile f ReadMode cleanup Nothing = noop cleanup (Just h) = liftIO $ hClose h go Nothing = return False @@ -99,15 +98,15 @@ checkLogFile f lck matchf = withSharedLock lck $ bracket setup cleanup go return r -- | Folds a function over lines of a log file to calculate a value. -calcLogFile :: RawFilePath -> RawFilePath -> t -> (L.ByteString -> t -> t) -> Annex t +calcLogFile :: OsPath -> OsPath -> t -> (L.ByteString -> t -> t) -> Annex t calcLogFile f lck start update = withSharedLock lck $ calcLogFileUnsafe f start update -- | Unsafe version that does not do locking. -calcLogFileUnsafe :: RawFilePath -> t -> (L.ByteString -> t -> t) -> Annex t +calcLogFileUnsafe :: OsPath -> t -> (L.ByteString -> t -> t) -> Annex t calcLogFileUnsafe f start update = bracket setup cleanup go where - setup = liftIO $ tryWhenExists $ F.openFile (toOsPath f) ReadMode + setup = liftIO $ tryWhenExists $ F.openFile f ReadMode cleanup Nothing = noop cleanup (Just h) = liftIO $ hClose h go Nothing = return start @@ -129,19 +128,19 @@ calcLogFileUnsafe f start update = bracket setup cleanup go -- -- Locking is used to prevent writes to to the log file while this -- is running. -streamLogFile :: RawFilePath -> RawFilePath -> Annex () -> (String -> Annex ()) -> Annex () +streamLogFile :: OsPath -> OsPath -> Annex () -> (String -> Annex ()) -> Annex () streamLogFile f lck finalizer processor = withExclusiveLock lck $ do streamLogFileUnsafe f finalizer processor - liftIO $ F.writeFile' (toOsPath f) mempty + liftIO $ F.writeFile' f mempty setAnnexFilePerm f -- Unsafe version that does not do locking, and does not empty the file -- at the end. -streamLogFileUnsafe :: RawFilePath -> Annex () -> (String -> Annex ()) -> Annex () +streamLogFileUnsafe :: OsPath -> Annex () -> (String -> Annex ()) -> Annex () streamLogFileUnsafe f finalizer processor = bracketOnError setup cleanup go where - setup = liftIO $ tryWhenExists $ F.openFile (toOsPath f) ReadMode + setup = liftIO $ tryWhenExists $ F.openFile f ReadMode cleanup Nothing = noop cleanup (Just h) = liftIO $ hClose h go Nothing = finalizer @@ -150,7 +149,7 @@ streamLogFileUnsafe f finalizer processor = bracketOnError setup cleanup go liftIO $ hClose h finalizer -createDirWhenNeeded :: RawFilePath -> Annex () -> Annex () +createDirWhenNeeded :: OsPath -> 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/Unused.hs b/Logs/Unused.hs index fa2b2ce3cc..4b3ad4f0f6 100644 --- a/Logs/Unused.hs +++ b/Logs/Unused.hs @@ -58,13 +58,13 @@ preserveTimestamps oldl newl = M.intersection (M.unionWith oldts oldl newl) newl where oldts _old@(_, ts) _new@(int, _) = (int, ts) -updateUnusedLog :: RawFilePath -> UnusedMap -> Annex () +updateUnusedLog :: OsPath -> UnusedMap -> Annex () updateUnusedLog prefix m = do oldl <- readUnusedLog prefix newl <- preserveTimestamps oldl . flip map2log m <$> liftIO getPOSIXTime writeUnusedLog prefix newl -writeUnusedLog :: RawFilePath -> UnusedLog -> Annex () +writeUnusedLog :: OsPath -> UnusedLog -> Annex () writeUnusedLog prefix l = do logfile <- fromRepo $ gitAnnexUnusedLog prefix writeLogFile logfile $ unlines $ map format $ M.toList l @@ -72,12 +72,12 @@ writeUnusedLog prefix l = do format (k, (i, Just t)) = show i ++ " " ++ serializeKey k ++ " " ++ show t format (k, (i, Nothing)) = show i ++ " " ++ serializeKey k -readUnusedLog :: RawFilePath -> Annex UnusedLog +readUnusedLog :: OsPath -> Annex UnusedLog readUnusedLog prefix = do f <- fromRepo (gitAnnexUnusedLog prefix) - ifM (liftIO $ doesFileExist (fromRawFilePath f)) + ifM (liftIO $ doesFileExist f) ( M.fromList . mapMaybe (parse . decodeBS) . fileLines' - <$> liftIO (F.readFile' (toOsPath f)) + <$> liftIO (F.readFile' f) , return M.empty ) where @@ -90,13 +90,13 @@ readUnusedLog prefix = do skey = reverse rskey ts = reverse rts -readUnusedMap :: RawFilePath -> Annex UnusedMap +readUnusedMap :: OsPath -> Annex UnusedMap readUnusedMap = log2map <$$> readUnusedLog -dateUnusedLog :: RawFilePath -> Annex (Maybe UTCTime) +dateUnusedLog :: OsPath -> Annex (Maybe UTCTime) dateUnusedLog prefix = do f <- fromRepo $ gitAnnexUnusedLog prefix - liftIO $ catchMaybeIO $ getModificationTime $ fromRawFilePath f + liftIO $ catchMaybeIO $ getModificationTime f {- Set of unused keys. This is cached for speed. -} unusedKeys :: Annex (S.Set Key) @@ -104,7 +104,7 @@ unusedKeys = maybe (setUnusedKeys =<< unusedKeys') return =<< Annex.getState Annex.unusedkeys unusedKeys' :: Annex [Key] -unusedKeys' = M.keys <$> readUnusedLog "" +unusedKeys' = M.keys <$> readUnusedLog (literalOsPath "") setUnusedKeys :: [Key] -> Annex (S.Set Key) setUnusedKeys ks = do diff --git a/Logs/Upgrade.hs b/Logs/Upgrade.hs index bc63e0021f..f40d93004d 100644 --- a/Logs/Upgrade.hs +++ b/Logs/Upgrade.hs @@ -33,9 +33,9 @@ writeUpgradeLog v t = do readUpgradeLog :: Annex [(RepoVersion, POSIXTime)] readUpgradeLog = do logfile <- fromRepo gitAnnexUpgradeLog - ifM (liftIO $ doesFileExist (fromRawFilePath logfile)) + ifM (liftIO $ doesFileExist logfile) ( mapMaybe (parse . decodeBS) . fileLines' - <$> liftIO (F.readFile' (toOsPath logfile)) + <$> liftIO (F.readFile' logfile) , return [] ) where diff --git a/Logs/View.hs b/Logs/View.hs index afb036c202..14ee8dcd37 100644 --- a/Logs/View.hs +++ b/Logs/View.hs @@ -54,7 +54,7 @@ removeView v = writeViews =<< filter (/= v) <$> recentViews recentViews :: Annex [View] recentViews = do - f <- fromRawFilePath <$> fromRepo gitAnnexViewLog + f <- fromOsPath <$> fromRepo gitAnnexViewLog liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFile f) {- Gets the currently checked out view, if there is one. diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs index d1f5182e38..a005813d2c 100644 --- a/Remote/Helper/Hooks.hs +++ b/Remote/Helper/Hooks.hs @@ -11,7 +11,6 @@ module Remote.Helper.Hooks (addHooks) where import qualified Data.Map as M -import qualified System.FilePath.ByteString as P import Annex.Common import Types.Remote @@ -51,13 +50,13 @@ addHooks' r starthook stophook = r' runHooks :: Remote -> Maybe String -> Maybe String -> Annex a -> Annex a runHooks r starthook stophook a = do dir <- fromRepo gitAnnexRemotesDir - let lck = dir P. remoteid <> ".lck" + let lck = dir remoteid <> literalOsPath ".lck" whenM (notElem lck . M.keys <$> getLockCache) $ do createAnnexDirectory dir firstrun lck a where - remoteid = fromUUID (uuid r) + remoteid = uuidPath (uuid r) run Nothing = noop run (Just command) = void $ liftIO $ boolSystem "sh" [Param "-c", Param command] diff --git a/Types/LockCache.hs b/Types/LockCache.hs index 5b921be17d..c1b7ad77b8 100644 --- a/Types/LockCache.hs +++ b/Types/LockCache.hs @@ -13,6 +13,6 @@ module Types.LockCache ( import Utility.LockPool (LockHandle) import qualified Data.Map as M -import System.FilePath.ByteString (RawFilePath) +import Utility.OsPath -type LockCache = M.Map RawFilePath LockHandle +type LockCache = M.Map OsPath LockHandle diff --git a/Types/UUID.hs b/Types/UUID.hs index 71ef2b28cd..d4e38edecd 100644 --- a/Types/UUID.hs +++ b/Types/UUID.hs @@ -24,6 +24,7 @@ import Git.Types (ConfigValue(..)) import Utility.FileSystemEncoding import Utility.QuickCheck import Utility.Aeson +import Utility.OsPath import qualified Utility.SimpleProtocol as Proto -- A UUID is either an arbitrary opaque string, or UUID info may be missing. @@ -101,6 +102,9 @@ buildUUID NoUUID = mempty isUUID :: String -> Bool isUUID = isJust . U.fromString +uuidPath :: UUID -> OsPath +uuidPath u = toOsPath (fromUUID u :: SB.ShortByteString) + -- A description of a UUID. newtype UUIDDesc = UUIDDesc B.ByteString deriving (Eq, Sem.Semigroup, Monoid, IsString) diff --git a/Utility/MoveFile.hs b/Utility/MoveFile.hs index ccd37ff109..7bc0297532 100644 --- a/Utility/MoveFile.hs +++ b/Utility/MoveFile.hs @@ -27,21 +27,20 @@ import Utility.SystemDirectory import Utility.Tmp import Utility.Exception import Utility.Monad -import Utility.FileSystemEncoding import Utility.OsPath import qualified Utility.RawFilePath as R import Author {- Moves one filename to another. - First tries a rename, but falls back to moving across devices if needed. -} -moveFile :: RawFilePath -> RawFilePath -> IO () -moveFile src dest = tryIO (R.rename src dest) >>= onrename +moveFile :: OsPath -> OsPath -> IO () +moveFile src dest = tryIO (renamePath src dest) >>= onrename where onrename (Right _) = noop onrename (Left e) | isPermissionError e = rethrow | isDoesNotExistError e = rethrow - | otherwise = viaTmp mv (toOsPath dest) () + | otherwise = viaTmp mv dest () where rethrow = throwM e @@ -57,8 +56,8 @@ moveFile src dest = tryIO (R.rename src dest) >>= onrename whenM (isdir dest) rethrow ok <- copyright =<< boolSystem "mv" [ Param "-f" - , Param (fromRawFilePath src) - , Param (fromRawFilePath (fromOsPath tmp)) + , Param (fromOsPath src) + , Param (fromOsPath tmp) ] let e' = e #else @@ -74,7 +73,7 @@ moveFile src dest = tryIO (R.rename src dest) >>= onrename #ifndef mingw32_HOST_OS isdir f = do - r <- tryIO $ R.getSymbolicLinkStatus f + r <- tryIO $ R.getSymbolicLinkStatus (fromOsPath f) case r of (Left _) -> return False (Right s) -> return $ isDirectory s diff --git a/Utility/RawFilePath.hs b/Utility/RawFilePath.hs index b39423df5b..f07a39f6c4 100644 --- a/Utility/RawFilePath.hs +++ b/Utility/RawFilePath.hs @@ -104,7 +104,7 @@ setFileMode p m = do P.setFileMode p' m {- Using renamePath rather than the rename provided in unix-compat - - because of this bug https://github.com/jacobstanley/unix-compat/issues/56-} + - because of this bug https://github.com/jacobstanley/unix-compat/issues/56 -} rename :: RawFilePath -> RawFilePath -> IO () rename a b = D.renamePath (fromRawFilePath a) (fromRawFilePath b)