diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index 5540844a70..b9ae3af8a8 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -15,7 +15,6 @@ import Data.Default import Data.ByteString.Builder import qualified Data.ByteString as S import qualified Data.ByteString.Short as S (toShort, fromShort) -import qualified System.FilePath.ByteString as P import System.PosixCompat.Files (isRegularFile) import Text.Read @@ -82,20 +81,19 @@ moveContent = do forM_ files move where move f = do - let f' = toRawFilePath f - let k = fileKey1 (fromRawFilePath (P.takeFileName f')) - let d = parentDir f' + let k = fileKey1 (fromOsPath $ takeFileName f) + let d = parentDir f liftIO $ allowWrite d - liftIO $ allowWrite f' - _ <- moveAnnex k (AssociatedFile Nothing) f' - liftIO $ removeDirectory (fromRawFilePath d) + liftIO $ allowWrite f + _ <- moveAnnex k (AssociatedFile Nothing) f + liftIO $ removeDirectory d updateSymlinks :: Annex () updateSymlinks = do showAction "updating symlinks" top <- fromRepo Git.repoPath (files, cleanup) <- inRepo $ LsFiles.inRepo [] [top] - forM_ files (fixlink . fromRawFilePath) + forM_ files fixlink void $ liftIO cleanup where fixlink f = do @@ -103,11 +101,10 @@ updateSymlinks = do case r of Nothing -> noop Just (k, _) -> do - link <- fromRawFilePath - <$> calcRepo (gitAnnexLink (toRawFilePath f) k) + link <- calcRepo (gitAnnexLink f k) liftIO $ removeFile f - liftIO $ R.createSymbolicLink (toRawFilePath link) (toRawFilePath f) - Annex.Queue.addCommand [] "add" [Param "--"] [f] + liftIO $ R.createSymbolicLink (fromOsPath link) (fromOsPath f) + Annex.Queue.addCommand [] "add" [Param "--"] [(fromOsPath f)] moveLocationLogs :: Annex () moveLocationLogs = do @@ -118,15 +115,15 @@ moveLocationLogs = do oldlocationlogs = do dir <- fromRepo Upgrade.V2.gitStateDir ifM (liftIO $ doesDirectoryExist dir) - ( mapMaybe oldlog2key + ( mapMaybe (oldlog2key . fromOsPath) <$> liftIO (getDirectoryContents dir) , return [] ) move (l, k) = do dest <- fromRepo (logFile2 k) dir <- fromRepo Upgrade.V2.gitStateDir - let f = dir l - createWorkTreeDirectory (parentDir (toRawFilePath dest)) + let f = dir toOsPath l + createWorkTreeDirectory (parentDir dest) -- could just git mv, but this way deals with -- log files that are not checked into git, -- as well as merging with already upgraded @@ -134,9 +131,9 @@ moveLocationLogs = do old <- liftIO $ readLog1 f new <- liftIO $ readLog1 dest liftIO $ writeLog1 dest (old++new) - Annex.Queue.addCommand [] "add" [Param "--"] [dest] - Annex.Queue.addCommand [] "add" [Param "--"] [f] - Annex.Queue.addCommand [] "rm" [Param "--quiet", Param "-f", Param "--"] [f] + Annex.Queue.addCommand [] "add" [Param "--"] [fromOsPath dest] + Annex.Queue.addCommand [] "add" [Param "--"] [fromOsPath f] + Annex.Queue.addCommand [] "rm" [Param "--quiet", Param "-f", Param "--"] [fromOsPath f] oldlog2key :: FilePath -> Maybe (FilePath, Key) oldlog2key l @@ -197,70 +194,64 @@ fileKey1 :: FilePath -> Key fileKey1 file = readKey1 $ replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file -writeLog1 :: FilePath -> [LogLine] -> IO () -writeLog1 file ls = viaTmp F.writeFile - (toOsPath (toRawFilePath file)) - (toLazyByteString $ buildLog ls) +writeLog1 :: OsPath -> [LogLine] -> IO () +writeLog1 file ls = viaTmp F.writeFile file (toLazyByteString $ buildLog ls) -readLog1 :: FilePath -> IO [LogLine] -readLog1 file = catchDefaultIO [] $ - parseLog <$> F.readFile (toOsPath (toRawFilePath file)) +readLog1 :: OsPath -> IO [LogLine] +readLog1 file = catchDefaultIO [] $ parseLog <$> F.readFile file -lookupKey1 :: FilePath -> Annex (Maybe (Key, Backend)) +lookupKey1 :: OsPath -> Annex (Maybe (Key, Backend)) lookupKey1 file = do tl <- liftIO $ tryIO getsymlink case tl of Left _ -> return Nothing Right l -> makekey l where - getsymlink = takeFileName . fromRawFilePath - <$> R.readSymbolicLink (toRawFilePath file) + getsymlink :: IO OsPath + getsymlink = takeFileName . toOsPath + <$> R.readSymbolicLink (fromOsPath file) makekey l = maybeLookupBackendVariety (fromKey keyVariety k) >>= \case Nothing -> do unless (null kname || null bname || - not (isLinkToAnnex (toRawFilePath l))) $ + not (isLinkToAnnex (fromOsPath l))) $ warning (UnquotedString skip) return Nothing Just backend -> return $ Just (k, backend) where - k = fileKey1 l + k = fileKey1 (fromOsPath l) bname = decodeBS (formatKeyVariety (fromKey keyVariety k)) kname = decodeBS (S.fromShort (fromKey keyName k)) - skip = "skipping " ++ file ++ + skip = "skipping " ++ fromOsPath file ++ " (unknown backend " ++ bname ++ ")" -getKeyFilesPresent1 :: Annex [FilePath] -getKeyFilesPresent1 = getKeyFilesPresent1' . fromRawFilePath - =<< fromRepo gitAnnexObjectDir -getKeyFilesPresent1' :: FilePath -> Annex [FilePath] +getKeyFilesPresent1 :: Annex [OsPath] +getKeyFilesPresent1 = getKeyFilesPresent1' =<< fromRepo gitAnnexObjectDir +getKeyFilesPresent1' :: OsPath -> Annex [OsPath] getKeyFilesPresent1' dir = ifM (liftIO $ doesDirectoryExist dir) ( do dirs <- liftIO $ getDirectoryContents dir - let files = map (\d -> dir ++ "/" ++ d ++ "/" ++ takeFileName d) dirs + let files = map (\d -> dir <> literalOsPath "/" <> d <> literalOsPath "/" <> takeFileName d) dirs liftIO $ filterM present files , return [] ) where + present :: OsPath -> IO Bool present f = do - result <- tryIO $ R.getFileStatus (toRawFilePath f) + result <- tryIO $ R.getFileStatus (fromOsPath f) case result of Right s -> return $ isRegularFile s Left _ -> return False -logFile1 :: Git.Repo -> Key -> String -logFile1 repo key = Upgrade.V2.gitStateDir repo ++ keyFile1 key ++ ".log" - -logFile2 :: Key -> Git.Repo -> String +logFile2 :: Key -> Git.Repo -> OsPath logFile2 = logFile' (hashDirLower def) -logFile' :: (Key -> RawFilePath) -> Key -> Git.Repo -> String +logFile' :: (Key -> OsPath) -> Key -> Git.Repo -> OsPath logFile' hasher key repo = - gitStateDir repo ++ fromRawFilePath (hasher key) ++ fromRawFilePath (keyFile key) ++ ".log" + gitStateDir repo <> hasher key <> keyFile key <> literalOsPath ".log" -stateDir :: FilePath -stateDir = addTrailingPathSeparator ".git-annex" +stateDir :: OsPath +stateDir = addTrailingPathSeparator (literalOsPath ".git-annex") -gitStateDir :: Git.Repo -> FilePath -gitStateDir repo = addTrailingPathSeparator $ - fromRawFilePath (Git.repoPath repo) stateDir +gitStateDir :: Git.Repo -> OsPath +gitStateDir repo = addTrailingPathSeparator $ Git.repoPath repo stateDir diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs index 7690921232..bd01cb5ab0 100644 --- a/Upgrade/V2.hs +++ b/Upgrade/V2.hs @@ -21,11 +21,12 @@ import Utility.Tmp import Logs import Messages.Progress import qualified Utility.FileIO as F +import qualified Utility.OsString as OS -olddir :: Git.Repo -> FilePath +olddir :: Git.Repo -> OsPath olddir g - | Git.repoIsLocalBare g = "" - | otherwise = ".git-annex" + | Git.repoIsLocalBare g = literalOsPath "" + | otherwise = literalOsPath ".git-annex" {- .git-annex/ moved to a git-annex branch. - @@ -54,14 +55,14 @@ upgrade = do e <- liftIO $ doesDirectoryExist old when e $ do config <- Annex.getGitConfig - mapM_ (\(k, f) -> inject f $ fromRawFilePath $ locationLogFile config k) =<< locationLogs + mapM_ (\(k, f) -> inject f $ locationLogFile config k) =<< locationLogs mapM_ (\f -> inject f f) =<< logFiles old saveState False showProgressDots when e $ do - inRepo $ Git.Command.run [Param "rm", Param "-r", Param "-f", Param "-q", File old] + inRepo $ Git.Command.run [Param "rm", Param "-r", Param "-f", Param "-q", File (fromOsPath old)] unless bare $ inRepo gitAttributesUnWrite showProgressDots @@ -69,29 +70,29 @@ upgrade = do return UpgradeSuccess -locationLogs :: Annex [(Key, FilePath)] +locationLogs :: Annex [(Key, OsPath)] locationLogs = do config <- Annex.getGitConfig dir <- fromRepo gitStateDir liftIO $ do - levela <- dirContents (toRawFilePath dir) + levela <- dirContents dir levelb <- mapM tryDirContents levela files <- mapM tryDirContents (concat levelb) return $ mapMaybe (islogfile config) (concat files) where tryDirContents d = catchDefaultIO [] $ dirContents d - islogfile config f = maybe Nothing (\k -> Just (k, fromRawFilePath f)) $ + islogfile config f = maybe Nothing (\k -> Just (k, f)) $ locationLogFileKey config f -inject :: FilePath -> FilePath -> Annex () +inject :: OsPath -> OsPath -> Annex () inject source dest = do old <- fromRepo olddir - new <- liftIO (readFile $ old source) - Annex.Branch.change (Annex.Branch.RegardingUUID []) (toRawFilePath dest) $ \prev -> + new <- liftIO (readFile $ fromOsPath $ old source) + Annex.Branch.change (Annex.Branch.RegardingUUID []) dest $ \prev -> encodeBL $ unlines $ nub $ lines (decodeBL prev) ++ lines new -logFiles :: FilePath -> Annex [FilePath] -logFiles dir = return . filter (".log" `isSuffixOf`) +logFiles :: OsPath -> Annex [OsPath] +logFiles dir = return . filter (literalOsPath ".log" `OS.isSuffixOf`) <=< liftIO $ getDirectoryContents dir push :: Annex () @@ -130,25 +131,22 @@ push = do {- Old .gitattributes contents, not needed anymore. -} attrLines :: [String] attrLines = - [ stateDir "*.log merge=union" - , stateDir "*/*/*.log merge=union" + [ fromOsPath $ stateDir literalOsPath "*.log merge=union" + , fromOsPath $ stateDir literalOsPath "*/*/*.log merge=union" ] gitAttributesUnWrite :: Git.Repo -> IO () gitAttributesUnWrite repo = do let attributes = Git.attributes repo - let attributes' = fromRawFilePath attributes - whenM (doesFileExist attributes') $ do + whenM (doesFileExist attributes) $ do c <- map decodeBS . fileLines' - <$> F.readFile' (toOsPath attributes) - liftIO $ viaTmp (writeFile . fromRawFilePath . fromOsPath) - (toOsPath attributes) + <$> F.readFile' attributes + liftIO $ viaTmp (writeFile . fromOsPath) attributes (unlines $ filter (`notElem` attrLines) c) - Git.Command.run [Param "add", File attributes'] repo + Git.Command.run [Param "add", File (fromOsPath attributes)] repo -stateDir :: FilePath -stateDir = addTrailingPathSeparator ".git-annex" +stateDir :: OsPath +stateDir = addTrailingPathSeparator (literalOsPath ".git-annex") -gitStateDir :: Git.Repo -> FilePath -gitStateDir repo = addTrailingPathSeparator $ - fromRawFilePath (Git.repoPath repo) stateDir +gitStateDir :: Git.Repo -> OsPath +gitStateDir repo = addTrailingPathSeparator $ Git.repoPath repo stateDir diff --git a/Upgrade/V5.hs b/Upgrade/V5.hs index 708c838977..ee90ba7cd8 100644 --- a/Upgrade/V5.hs +++ b/Upgrade/V5.hs @@ -33,7 +33,6 @@ import Git.Ref import Utility.InodeCache import Utility.DottedVersion import Annex.AdjustedBranch -import qualified Utility.RawFilePath as R import qualified Utility.FileIO as F upgrade :: Bool -> Annex UpgradeResult @@ -130,7 +129,7 @@ upgradeDirectWorkTree = do stagePointerFile f Nothing =<< hashPointerFile k ifM (isJust <$> getAnnexLinkTarget f) ( writepointer f k - , fromdirect (fromRawFilePath f) k + , fromdirect f k ) Database.Keys.addAssociatedFile k =<< inRepo (toTopFilePath f) @@ -138,14 +137,13 @@ upgradeDirectWorkTree = do fromdirect f k = ifM (Direct.goodContent k f) ( do - let f' = toRawFilePath f -- If linkToAnnex fails for some reason, the work tree -- file still has the content; the annex object file -- is just not populated with it. Since the work tree -- file is recorded as an associated file, things will -- still work that way, it's just not ideal. - ic <- withTSDelta (liftIO . genInodeCache f') - void $ Content.linkToAnnex k f' ic + ic <- withTSDelta (liftIO . genInodeCache f) + void $ Content.linkToAnnex k f ic , unlessM (Content.inAnnex k) $ do -- Worktree file was deleted or modified; -- if there are no other copies of the content @@ -157,8 +155,8 @@ upgradeDirectWorkTree = do ) writepointer f k = liftIO $ do - removeWhenExistsWith R.removeLink f - F.writeFile' (toOsPath f) (formatPointer k) + removeWhenExistsWith removeFile f + F.writeFile' f (formatPointer k) {- Remove all direct mode bookkeeping files. -} removeDirectCruft :: Annex () diff --git a/Upgrade/V9.hs b/Upgrade/V9.hs index 700f1f6387..32af018f36 100644 --- a/Upgrade/V9.hs +++ b/Upgrade/V9.hs @@ -55,7 +55,7 @@ upgrade automatic - run for an entire year and so predate the v9 upgrade. -} assistantrunning = do pidfile <- fromRepo gitAnnexPidFile - isJust <$> liftIO (checkDaemon (fromRawFilePath pidfile)) + isJust <$> liftIO (checkDaemon (fromOsPath pidfile)) unsafeupgrade = [ "Not upgrading from v9 to v10, because there may be git-annex"