diff --git a/Annex/Content.hs b/Annex/Content.hs index 15d58e2e26..638390b2bf 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -276,8 +276,7 @@ winLocker :: (LockFile -> IO (Maybe LockHandle)) -> ContentLocker winLocker takelock _ (Just lockfile) = let lck = do modifyContentDir lockfile $ - void $ liftIO $ tryIO $ - writeFile (fromOsPath lockfile) "" + void $ liftIO $ tryIO $ writeFileString lockfile "" liftIO $ takelock lockfile in (lck, Nothing) -- never reached; windows always uses a separate lock file @@ -991,7 +990,7 @@ withTmpWorkDir key action = do -- clean up gitAnnexTmpWorkDir for those it finds. obj <- prepTmp key unlessM (liftIO $ doesFileExist obj) $ do - liftIO $ writeFile (fromOsPath obj) "" + liftIO $ writeFileString obj "" setAnnexFilePerm obj let tmpdir = gitAnnexTmpWorkDir obj createAnnexDirectory tmpdir @@ -1083,7 +1082,7 @@ writeContentRetentionTimestamp key rt t = do readContentRetentionTimestamp rt >>= \case Just ts | ts >= t -> return () _ -> replaceFile (const noop) rt $ \tmp -> - liftIO $ writeFile (fromOsPath tmp) $ show t + liftIO $ writeFileString tmp $ show t where lock = takeExclusiveLock unlock = liftIO . dropLock diff --git a/Annex/Fixup.hs b/Annex/Fixup.hs index 1e245668f3..c6b1bf5042 100644 --- a/Annex/Fixup.hs +++ b/Annex/Fixup.hs @@ -1,6 +1,6 @@ {- git-annex repository fixups - - - Copyright 2013-2020 Joey Hess + - Copyright 2013-2025 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -9,29 +9,14 @@ module Annex.Fixup where +import Common import Git.Types import Git.Config import Types.GitConfig -import Utility.Path -import Utility.Path.AbsRel -import Utility.SafeCommand -import Utility.Directory -import Utility.Exception -import Utility.Monad -import Utility.SystemDirectory -import Utility.OsPath import qualified Utility.RawFilePath as R -import Utility.PartialPrelude import qualified Utility.OsString as OS -import System.IO -import Data.List -import Data.Maybe -import Control.Monad -import Control.Monad.IfElse import qualified Data.Map as M -import Control.Applicative -import Prelude fixupRepo :: Repo -> GitConfig -> IO Repo fixupRepo r c = do @@ -132,11 +117,11 @@ fixupUnusualRepos r@(Repo { location = Local { worktree = Just w, gitdir = d } } -- git-worktree sets up a "commondir" file that contains -- the path to the main git directory. -- Using --separate-git-dir does not. - commondirfile = fromOsPath (d literalOsPath "commondir") + commondirfile = d literalOsPath "commondir" readcommondirfile = catchDefaultIO Nothing $ fmap toOsPath . headMaybe . lines - <$> readFile commondirfile + <$> readFileString commondirfile setworktreepath r' = readcommondirfile >>= \case Just gd -> return $ r' diff --git a/Annex/Path.hs b/Annex/Path.hs index 802ab9c043..6db939e084 100644 --- a/Annex/Path.hs +++ b/Annex/Path.hs @@ -65,7 +65,7 @@ programPath = go =<< getEnv "GIT_ANNEX_DIR" readProgramFile :: IO (Maybe OsPath) readProgramFile = catchDefaultIO Nothing $ do programfile <- programFile - fmap toOsPath . headMaybe . lines <$> readFile (fromOsPath programfile) + fmap toOsPath . headMaybe . lines <$> readFileString programfile cannotFindProgram :: IO a cannotFindProgram = do diff --git a/Annex/Sim.hs b/Annex/Sim.hs index 823d991ad2..fa80b94e22 100644 --- a/Annex/Sim.hs +++ b/Annex/Sim.hs @@ -1356,16 +1356,15 @@ suspendSim st = do let st'' = st' { simRepoState = M.map freeze (simRepoState st') } - let statefile = fromOsPath $ - toOsPath (simRootDirectory st'') literalOsPath "state" - writeFile statefile (show st'') + let statefile = toOsPath (simRootDirectory st'') literalOsPath "state" + writeFileString statefile (show st'') where freeze :: SimRepoState SimRepo -> SimRepoState () freeze rst = rst { simRepo = Nothing } restoreSim :: OsPath -> IO (Either String (SimState SimRepo)) restoreSim rootdir = - tryIO (readFile statefile) >>= \case + tryIO (readFileString statefile) >>= \case Left err -> return (Left (show err)) Right c -> case readMaybe c :: Maybe (SimState ()) of Nothing -> return (Left "unable to parse sim state file") @@ -1379,7 +1378,7 @@ restoreSim rootdir = } return (Right st'') where - statefile = fromOsPath $ rootdir literalOsPath "state" + statefile = rootdir literalOsPath "state" thaw st (u, rst) = tryNonAsync (thaw' st u) >>= return . \case Left _ -> (u, rst { simRepo = Nothing }) Right r -> (u, rst { simRepo = Just r }) diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index a0e4ff9319..2a482dbc3c 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -484,4 +484,4 @@ sshAskPassEnv :: String sshAskPassEnv = "GIT_ANNEX_SSHASKPASS" runSshAskPass :: FilePath -> IO () -runSshAskPass passfile = putStrLn =<< readFile passfile +runSshAskPass passfile = putStrLn =<< readFileString (toOsPath passfile) diff --git a/Annex/YoutubeDl.hs b/Annex/YoutubeDl.hs index 5b3fbd7158..6c13295955 100644 --- a/Annex/YoutubeDl.hs +++ b/Annex/YoutubeDl.hs @@ -94,7 +94,7 @@ youtubeDl' url workdir p uo nofiles = Left $ youtubeDlCommand ++ " did not put any media in its work directory, perhaps it's been configured to store files somewhere else?" toomanyfiles fs = Left $ youtubeDlCommand ++ " downloaded multiple media files; git-annex is only able to deal with one per url: " ++ show fs downloadedfiles = liftIO $ - (nub . lines <$> readFile (fromOsPath filelistfile)) + (nub . lines <$> readFileString filelistfile) `catchIO` (pure . const []) workdirfiles = liftIO $ filter (/= filelistfile) <$> (filterM doesFileExist =<< dirContents workdir) diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index eeb40605ea..80f18b6996 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -132,7 +132,7 @@ writeDaemonStatusFile file status = ] readDaemonStatusFile :: FilePath -> IO DaemonStatus -readDaemonStatusFile file = parse <$> newDaemonStatus <*> readFile file +readDaemonStatusFile file = parse <$> newDaemonStatus <*> readFileString (toOsPath file) where parse status = foldr parseline status . lines parseline line status diff --git a/Assistant/Install.hs b/Assistant/Install.hs index 750b4a9adc..c5710ff213 100644 --- a/Assistant/Install.hs +++ b/Assistant/Install.hs @@ -57,7 +57,7 @@ ensureInstalled = ifM (isJust <$> getEnv "GIT_ANNEX_PACKAGE_INSTALL") let program = base literalOsPath "git-annex" programfile <- programFile createDirectoryIfMissing True (parentDir programfile) - writeFile (fromOsPath programfile) (fromOsPath program) + writeFileString programfile (fromOsPath program) #ifdef darwin_HOST_OS autostartfile <- userAutoStart osxAutoStartLabel @@ -70,7 +70,7 @@ ensureInstalled = ifM (isJust <$> getEnv "GIT_ANNEX_PACKAGE_INSTALL") let bootfile = toOsPath home literalOsPath ".termux" literalOsPath "boot" literalOsPath "git-annex" unlessM (doesFileExist bootfile) $ do createDirectoryIfMissing True (takeDirectory bootfile) - writeFile (fromOsPath bootfile) "git-annex assistant --autostart" + writeFileString bootfile "git-annex assistant --autostart" , do menufile <- desktopMenuFilePath "git-annex" <$> userDataDir icondir <- iconDir <$> userDataDir @@ -125,7 +125,7 @@ installFileManagerHooks program = unlessM osAndroid $ do userdata <- userDataDir let kdeServiceMenusdir = userdata literalOsPath "kservices5" literalOsPath "ServiceMenus" createDirectoryIfMissing True kdeServiceMenusdir - writeFile (fromOsPath (kdeServiceMenusdir literalOsPath "git-annex.desktop")) + writeFileString (kdeServiceMenusdir literalOsPath "git-annex.desktop") (kdeDesktopFile actions) where genNautilusScript scriptdir action = @@ -136,7 +136,7 @@ installFileManagerHooks program = unlessM osAndroid $ do ] scriptname action = "git-annex " ++ action installscript f c = whenM (safetoinstallscript f) $ do - writeFile (fromOsPath f) c + writeFileString f c modifyFileMode f $ addModes [ownerExecuteMode] safetoinstallscript f = catchDefaultIO True $ elem (encodeBS autoaddedcomment) . fileLines' diff --git a/Assistant/Install/AutoStart.hs b/Assistant/Install/AutoStart.hs index 366e202731..c689f9d2fd 100644 --- a/Assistant/Install/AutoStart.hs +++ b/Assistant/Install/AutoStart.hs @@ -23,7 +23,7 @@ installAutoStart :: String -> OsPath -> IO () installAutoStart command file = do #ifdef darwin_HOST_OS createDirectoryIfMissing True (parentDir file) - writeFile (fromOsPath file) $ genOSXAutoStartFile osxAutoStartLabel command + writeFileString file $ genOSXAutoStartFile osxAutoStartLabel command ["assistant", "--autostart"] #else writeDesktopMenuFile (fdoAutostart command) file diff --git a/Assistant/Restart.hs b/Assistant/Restart.hs index 658d1ddf18..58a17c12a2 100644 --- a/Assistant/Restart.hs +++ b/Assistant/Restart.hs @@ -79,7 +79,7 @@ newAssistantUrl repo = do r <- Git.Config.read =<< Git.Construct.fromPath repo waiturl $ gitAnnexUrlFile r waiturl urlfile = do - v <- tryIO $ readFile (fromOsPath urlfile) + v <- tryIO $ readFileString urlfile case v of Left _ -> delayed $ waiturl urlfile Right url -> ifM (assistantListening url) diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs index 420e1efdab..4cbc79ec61 100644 --- a/Assistant/Ssh.hs +++ b/Assistant/Ssh.hs @@ -224,8 +224,8 @@ genSshKeyPair = withTmpDir (literalOsPath "git-annex-keygen") $ \dir -> do unless ok $ giveup "ssh-keygen failed" SshKeyPair - <$> readFile (fromOsPath (dir literalOsPath "key.pub")) - <*> readFile (fromOsPath (dir literalOsPath "key")) + <$> readFileString (dir literalOsPath "key.pub") + <*> readFileString (dir literalOsPath "key") {- Installs a ssh key pair, and sets up ssh config with a mangled hostname - that will enable use of the key. This way we avoid changing the user's @@ -255,7 +255,7 @@ installSshKeyPair sshkeypair sshdata = do writeFileProtected (sshdir sshPrivKeyFile sshdata) (sshPrivKey sshkeypair) unlessM (doesFileExist $ sshdir sshPubKeyFile sshdata) $ - writeFile (fromOsPath (sshdir sshPubKeyFile sshdata)) + writeFileString (sshdir sshPubKeyFile sshdata) (sshPubKey sshkeypair) setSshConfig sshdata @@ -277,8 +277,10 @@ sshPubKeyFile sshdata = sshPrivKeyFile sshdata <> literalOsPath ".pub" setupSshKeyPair :: SshData -> IO (SshData, SshKeyPair) setupSshKeyPair sshdata = do sshdir <- sshDir - mprivkey <- catchMaybeIO $ readFile (fromOsPath (sshdir sshPrivKeyFile sshdata)) - mpubkey <- catchMaybeIO $ readFile (fromOsPath (sshdir sshPubKeyFile sshdata)) + mprivkey <- catchMaybeIO $ readFileString + (sshdir sshPrivKeyFile sshdata) + mpubkey <- catchMaybeIO $ readFileString + (sshdir sshPubKeyFile sshdata) keypair <- case (mprivkey, mpubkey) of (Just privkey, Just pubkey) -> return $ SshKeyPair { sshPubKey = pubkey @@ -330,15 +332,15 @@ setSshConfig :: SshData -> [(String, String)] -> IO SshData setSshConfig sshdata config = do sshdir <- sshDir createDirectoryIfMissing True sshdir - let configfile = fromOsPath (sshdir literalOsPath "config") - unlessM (catchBoolIO $ isInfixOf mangledhost <$> readFile configfile) $ do - appendFile configfile $ unlines $ + let configfile = sshdir literalOsPath "config" + unlessM (catchBoolIO $ isInfixOf mangledhost <$> readFileString configfile) $ do + appendFileString configfile $ unlines $ [ "" , "# Added automatically by git-annex" , "Host " ++ mangledhost ] ++ map (\(k, v) -> "\t" ++ k ++ " " ++ v) (settings ++ config) - setSshConfigMode (toOsPath configfile) + setSshConfigMode configfile return $ sshdata { sshHostName = T.pack mangledhost diff --git a/Assistant/Upgrade.hs b/Assistant/Upgrade.hs index ca6d5b3ada..1d7c05a5d8 100644 --- a/Assistant/Upgrade.hs +++ b/Assistant/Upgrade.hs @@ -160,7 +160,7 @@ upgradeToDistribution newdir cleanup distributionfile = do unlessM (boolSystem (fromOsPath program) [Param "version"]) $ giveup "New git-annex program failed to run! Not using." pf <- programFile - liftIO $ writeFile (fromOsPath pf) (fromOsPath program) + liftIO $ writeFileString pf (fromOsPath program) #ifdef darwin_HOST_OS {- OS X uses a dmg, so mount it, and copy the contents into place. -} @@ -281,7 +281,7 @@ installBase = "git-annex." ++ deleteFromManifest :: OsPath -> IO () deleteFromManifest dir = do fs <- map (\f -> dir toOsPath f) . lines - <$> catchDefaultIO "" (readFile (fromOsPath manifest)) + <$> catchDefaultIO "" (readFileString manifest) mapM_ (removeWhenExistsWith removeFile) fs removeWhenExistsWith removeFile manifest removeEmptyRecursive dir diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs index 0d6b6f1eb3..4574b0fe53 100644 --- a/Assistant/WebApp/Configurators/Local.hs +++ b/Assistant/WebApp/Configurators/Local.hs @@ -185,7 +185,7 @@ getAndroidCameraRepositoryR = do where addignore = do liftIO $ unlessM (doesFileExist $ literalOsPath ".gitignore") $ - writeFile ".gitignore" ".thumbnails" + writeFileString (literalOsPath ".gitignore") ".thumbnails" void $ inRepo $ Git.Command.runBool [Param "add", File ".gitignore"] diff --git a/Assistant/WebApp/Control.hs b/Assistant/WebApp/Control.hs index 0f0a76584e..a32a05f069 100644 --- a/Assistant/WebApp/Control.hs +++ b/Assistant/WebApp/Control.hs @@ -74,5 +74,5 @@ getLogR :: Handler Html getLogR = page "Logs" Nothing $ do logfile <- liftAnnex $ fromRepo gitAnnexDaemonLogFile logs <- liftIO $ listLogs (fromOsPath logfile) - logcontent <- liftIO $ concat <$> mapM readFile logs + logcontent <- liftIO $ concat <$> mapM (readFileString . toOsPath) logs $(widgetFile "control/log") diff --git a/Assistant/WebApp/Documentation.hs b/Assistant/WebApp/Documentation.hs index a6dcc03853..bd42945118 100644 --- a/Assistant/WebApp/Documentation.hs +++ b/Assistant/WebApp/Documentation.hs @@ -34,7 +34,7 @@ getLicenseR = do Just f -> customPage (Just About) $ do -- no sidebar, just pages of legalese.. setTitle "License" - license <- liftIO $ readFile (fromOsPath f) + license <- liftIO $ readFileString f $(widgetFile "documentation/license") getRepoGroupR :: Handler Html diff --git a/Build/Configure.hs b/Build/Configure.hs index dc5e634016..4b1a0594f9 100644 --- a/Build/Configure.hs +++ b/Build/Configure.hs @@ -12,6 +12,7 @@ import Utility.Env.Basic import qualified Git.Version import Utility.SystemDirectory import Utility.OsPath +import qualified Utility.FileIO as F import Control.Monad import Control.Applicative @@ -93,7 +94,7 @@ getSshConnectionCaching = Config "sshconnectioncaching" . BoolConfig <$> setup :: IO () setup = do createDirectoryIfMissing True (toOsPath tmpDir) - writeFile testFile "test file contents" + F.writeFileString (toOsPath testFile) "test file contents" cleanup :: IO () cleanup = removeDirectoryRecursive (toOsPath tmpDir) diff --git a/Build/DesktopFile.hs b/Build/DesktopFile.hs index b69fd82854..ad066a8937 100644 --- a/Build/DesktopFile.hs +++ b/Build/DesktopFile.hs @@ -74,7 +74,7 @@ install command = do , do programfile <- inDestDir =<< programFile createDirectoryIfMissing True (parentDir programfile) - writeFile (fromOsPath programfile) command + writeFileString programfile command ) installUser :: FilePath -> IO () diff --git a/Build/DistributionUpdate.hs b/Build/DistributionUpdate.hs index c7566a5a9e..b7223fdfa3 100644 --- a/Build/DistributionUpdate.hs +++ b/Build/DistributionUpdate.hs @@ -148,7 +148,7 @@ makeinfos updated changelogversion = do , distributionReleasedate = now , distributionUrgentUpgrade = Just "6.20180626" } - liftIO $ writeFile (fromOsPath infofile) $ formatInfoFile d + liftIO $ writeFileString infofile $ formatInfoFile d void $ inRepo $ runBool [Param "add", File (fromOsPath infofile)] signFile infofile signFile f @@ -173,7 +173,7 @@ makeinfos updated changelogversion = do -- Check for out of date info files. infos <- liftIO $ filter (literalOsPath ".info" `OS.isSuffixOf`) <$> emptyWhenDoesNotExist (dirContentsRecursive $ literalOsPath "git-annex") - ds <- liftIO $ forM infos (readish <$$> readFile . fromOsPath) + ds <- liftIO $ forM infos (readish <$$> readFileString) let dis = zip infos ds let ood = filter outofdate dis return ood diff --git a/Build/LinuxMkLibs.hs b/Build/LinuxMkLibs.hs index c081dd83d5..065ac3b1ea 100644 --- a/Build/LinuxMkLibs.hs +++ b/Build/LinuxMkLibs.hs @@ -29,6 +29,7 @@ import Utility.FileMode import Utility.CopyFile import Utility.SystemDirectory import qualified Utility.OsString as OS +import qualified Utility.FileIO as F mklibs :: OsPath -> a -> IO Bool mklibs top _installedbins = do @@ -47,9 +48,9 @@ mklibs top _installedbins = do -- Various files used by runshell to set up env vars used by the -- linker shims. - writeFile (fromOsPath (top literalOsPath "libdirs")) + F.writeFileString (top literalOsPath "libdirs") (unlines (map fromOsPath libdirs')) - writeFile (fromOsPath (top literalOsPath "gconvdir")) $ + F.writeFileString (top literalOsPath "gconvdir") $ case gconvlibs of [] -> "" (p:_) -> fromOsPath (parentDir p) @@ -171,7 +172,7 @@ installLinkerShim top linker exe = do link <- relPathDirToFile (top exedir) (top <> linker) unlessM (doesFileExist (top exelink)) $ createSymbolicLink (fromOsPath link) (fromOsPath (top exelink)) - writeFile (fromOsPath exe) $ unlines + F.writeFileString exe $ unlines [ "#!/bin/sh" , "exec \"$GIT_ANNEX_DIR/" ++ fromOsPath exelink ++ "\" --library-path \"$GIT_ANNEX_LD_LIBRARY_PATH\" \"$GIT_ANNEX_DIR/shimmed/" ++ fromOsPath base ++ "/" ++ fromOsPath base ++ "\" \"$@\"" ] diff --git a/Build/NullSoftInstaller.hs b/Build/NullSoftInstaller.hs index 8241ff8dd8..b2e1209878 100644 --- a/Build/NullSoftInstaller.hs +++ b/Build/NullSoftInstaller.hs @@ -43,6 +43,7 @@ import Utility.Exception import Utility.Directory import Utility.SystemDirectory import Utility.OsPath +import qualified Utility.FileIO as F import Build.BundledPrograms main = do @@ -55,11 +56,11 @@ main = do mustSucceed "sh" [Param "-c", Param $ "zcat standalone/licences.gz > '" ++ license ++ "'"] webappscript <- vbsLauncher tmpdir "git-annex-webapp" "git annex webapp" autostartscript <- vbsLauncher tmpdir "git-annex-autostart" "git annex assistant --autostart" - let htmlhelp = fromOsPath $ tmpdir literalOsPath "git-annex.html" - writeFile htmlhelp htmlHelpText - let gitannexcmd = fromOsPath $ tmpdir literalOsPath "git-annex.cmd" - writeFile gitannexcmd "git annex %*" - writeFile nsifile $ makeInstaller + let htmlhelp = tmpdir literalOsPath "git-annex.html" + F.writeFileString htmlhelp htmlHelpText + let gitannexcmd = tmpdir literalOsPath "git-annex.cmd" + F.writeFileString gitannexcmd "git annex %*" + F.writeFileString (toOsPath nsifile) $ makeInstaller gitannex gitannexcmd license htmlhelp (winPrograms ++ magicDLLs') magicShare' [ webappscript, autostartscript ] mustSucceed "makensis" [File nsifile] @@ -85,13 +86,13 @@ main = do - box. It expects to be passed the directory where git-annex is installed. -} vbsLauncher :: OsPath -> String -> String -> IO String vbsLauncher tmpdir basename cmd = do - let f = fromOsPath $ tmpdir toOsPath (basename ++ ".vbs") - writeFile f $ unlines + let f = tmpdir toOsPath (basename ++ ".vbs") + F.writeFileString f $ unlines [ "Set objshell=CreateObject(\"Wscript.Shell\")" , "objShell.CurrentDirectory = Wscript.Arguments.item(0)" , "objShell.Run(\"" ++ cmd ++ "\"), 0, False" ] - return f + return (fromOsPath f) gitannexprogram :: FilePath gitannexprogram = "git-annex.exe" diff --git a/Build/Standalone.hs b/Build/Standalone.hs index e0e9e56bee..44e8171707 100644 --- a/Build/Standalone.hs +++ b/Build/Standalone.hs @@ -180,19 +180,19 @@ installSkel topdir _basedir = do installSkelRest :: OsPath -> OsPath -> Bool -> IO () #ifdef darwin_HOST_OS installSkelRest _topdir basedir _hwcaplibs = do - plist <- lines <$> readFile "standalone/osx/Info.plist.template" + plist <- lines <$> F.readFileString (literalOsPath "standalone/osx/Info.plist.template") version <- getVersion - writeFile (fromOsPath (basedir literalOsPath "Contents" literalOsPath "Info.plist")) + F.writeFileString (basedir literalOsPath "Contents" literalOsPath "Info.plist") (unlines (map (expandversion version) plist)) where expandversion v l = replace "GIT_ANNEX_VERSION" v l #else installSkelRest topdir _basedir hwcaplibs = do - runshell <- lines <$> readFile "standalone/linux/skel/runshell" + runshell <- lines <$> F.readFileString (literalOsPath "standalone/linux/skel/runshell") -- GIT_ANNEX_PACKAGE_INSTALL can be set by a distributor and -- runshell will be modified gapi <- getEnv "GIT_ANNEX_PACKAGE_INSTALL" - writeFile (fromOsPath (topdir literalOsPath "runshell")) + F.writeFileString (topdir literalOsPath "runshell") (unlines (map (expandrunshell gapi) runshell)) modifyFileMode (topdir literalOsPath "runshell") diff --git a/Build/TestConfig.hs b/Build/TestConfig.hs index f20972fa8f..c556f7ac25 100644 --- a/Build/TestConfig.hs +++ b/Build/TestConfig.hs @@ -1,6 +1,7 @@ {- Tests the system and generates SysConfig. -} {-# OPTIONS_GHC -fno-warn-tabs #-} +{-# LANGUAGE OverloadedStrings #-} module Build.TestConfig where @@ -9,6 +10,7 @@ import Utility.Monad import Utility.SafeCommand import Utility.SystemDirectory import Utility.OsPath +import qualified Utility.FileIO as F import System.IO @@ -42,7 +44,7 @@ instance Show Config where valuetype (MaybeBoolConfig _) = "Maybe Bool" writeSysConfig :: [Config] -> IO () -writeSysConfig config = writeFile "Build/SysConfig" body +writeSysConfig config = F.writeFileString (literalOsPath "Build/SysConfig") body where body = unlines $ header ++ map show config ++ footer header = [ @@ -100,12 +102,16 @@ findCmdPath k command = do ifM (inSearchPath command) ( return $ Config k $ MaybeStringConfig $ Just command , do - r <- getM find ["/usr/sbin", "/sbin", "/usr/local/sbin"] + r <- getM find + [ literalOsPath "/usr/sbin" + , literalOsPath "/sbin" + , literalOsPath "/usr/local/sbin" + ] return $ Config k $ MaybeStringConfig r ) where find d = - let f = toOsPath d toOsPath command + let f = d toOsPath command in ifM (doesFileExist f) ( return (Just (fromOsPath f)) , return Nothing diff --git a/Build/Version.hs b/Build/Version.hs index 3552814116..762714e89f 100644 --- a/Build/Version.hs +++ b/Build/Version.hs @@ -51,7 +51,7 @@ getVersion = do getChangelogVersion :: IO Version getChangelogVersion = do - changelog <- readFile "CHANGELOG" + changelog <- F.readFileString (literalOsPath "CHANGELOG") let verline = takeWhile (/= '\n') changelog return $ middle (words verline !! 1) where diff --git a/Command/FuzzTest.hs b/Command/FuzzTest.hs index 3534e21e63..cd244c6195 100644 --- a/Command/FuzzTest.hs +++ b/Command/FuzzTest.hs @@ -178,7 +178,7 @@ runFuzzAction :: FuzzAction -> Annex () runFuzzAction (FuzzAdd (FuzzFile f)) = do createWorkTreeDirectory (parentDir (toOsPath f)) n <- liftIO (getStdRandom random :: IO Int) - liftIO $ writeFile f $ show n ++ "\n" + liftIO $ writeFileString (toOsPath f) $ show n ++ "\n" runFuzzAction (FuzzDelete (FuzzFile f)) = liftIO $ removeWhenExistsWith removeFile (toOsPath f) runFuzzAction (FuzzMove (FuzzFile src) (FuzzFile dest)) = liftIO $ diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index 613c9dd0f8..7b66a2b507 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -183,7 +183,7 @@ getFeed o url st = next $ return True debugfeedcontent tmpf msg = do - feedcontent <- liftIO $ readFile tmpf + feedcontent <- liftIO $ readFileString (toOsPath tmpf) fastDebug "Command.ImportFeed" $ unlines [ "start of feed content" , feedcontent @@ -611,7 +611,7 @@ checkFeedBroken url = checkFeedBroken' url =<< feedState url checkFeedBroken' :: URLString -> OsPath -> Annex Bool checkFeedBroken' url f = do prev <- maybe Nothing readish - <$> liftIO (catchMaybeIO $ readFile (fromOsPath f)) + <$> liftIO (catchMaybeIO $ readFileString f) now <- liftIO getCurrentTime case prev of Nothing -> do diff --git a/Command/Map.hs b/Command/Map.hs index 7771014504..c83babd4b9 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -55,7 +55,7 @@ start = startingNoMessage (ActionItemOther Nothing) $ do <$> fromRepo gitAnnexDir <*> pure (literalOsPath "map.dot") - liftIO $ writeFile (fromOsPath file) (drawMap rs trustmap umap) + liftIO $ writeFileString file (drawMap rs trustmap umap) next $ ifM (Annex.getRead Annex.fast) ( runViewer file [] diff --git a/Command/Sim.hs b/Command/Sim.hs index 36357c4398..60e7996e42 100644 --- a/Command/Sim.hs +++ b/Command/Sim.hs @@ -70,7 +70,7 @@ startsim' simfile = do let st = emptySimState rng (fromOsPath simdir) case simfile of Nothing -> startup simdir st [] - Just f -> liftIO (readFile f) >>= \c -> + Just f -> liftIO (readFileString (toOsPath f)) >>= \c -> case parseSimFile c of Left err -> giveup err Right cs -> startup simdir st cs diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index 4679c598e5..c52b539a24 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -49,7 +49,7 @@ start = do createAnnexDirectory $ parentDir f cfg <- getCfg descs <- uuidDescriptions - liftIO $ writeFile (fromOsPath f) $ genCfg cfg descs + liftIO $ writeFileString f $ genCfg cfg descs vicfg cfg f stop @@ -65,7 +65,7 @@ vicfg curcfg f = do liftIO $ removeWhenExistsWith removeFile f case r of Left s -> do - liftIO $ writeFile (fromOsPath f) s + liftIO $ writeFileString f s vicfg curcfg f Right newcfg -> setCfg curcfg newcfg where diff --git a/Command/WebApp.hs b/Command/WebApp.hs index 02e5735d3b..80801c3893 100644 --- a/Command/WebApp.hs +++ b/Command/WebApp.hs @@ -90,7 +90,7 @@ start' allowauto o = do ( if isJust (listenAddress o) || isJust (listenPort o) then giveup "The assistant is already running, so --listen and --port cannot be used." else do - url <- liftIO . readFile . fromOsPath + url <- liftIO . readFileString =<< fromRepo gitAnnexUrlFile liftIO $ if isJust listenAddress' then putStrLn url diff --git a/Config/Files.hs b/Config/Files.hs index 14450fcc72..7b7c6c49c7 100644 --- a/Config/Files.hs +++ b/Config/Files.hs @@ -32,4 +32,4 @@ programFile = userConfigFile (literalOsPath "program") noAnnexFileContent :: Maybe OsPath -> IO (Maybe String) noAnnexFileContent repoworktree = case repoworktree of Nothing -> return Nothing - Just wt -> catchMaybeIO (readFile (fromOsPath (wt literalOsPath ".noannex"))) + Just wt -> catchMaybeIO (readFileString (wt literalOsPath ".noannex")) diff --git a/Config/Files/AutoStart.hs b/Config/Files/AutoStart.hs index 7307e46d5c..31b6b2edf8 100644 --- a/Config/Files/AutoStart.hs +++ b/Config/Files/AutoStart.hs @@ -18,7 +18,7 @@ readAutoStartFile :: IO [OsPath] readAutoStartFile = do f <- autoStartFile filter valid . nub . map (dropTrailingPathSeparator . toOsPath) . lines - <$> catchDefaultIO "" (readFile (fromOsPath f)) + <$> catchDefaultIO "" (readFileString f) where -- Ignore any relative paths; some old buggy versions added eg "." valid = isAbsolute @@ -30,7 +30,7 @@ modifyAutoStartFile func = do when (dirs' /= dirs) $ do f <- autoStartFile createDirectoryIfMissing True (parentDir f) - viaTmp (writeFile . fromRawFilePath . fromOsPath) f + viaTmp writeFileString f (unlines (map fromOsPath dirs')) {- Adds a directory to the autostart file. If the directory is already diff --git a/Config/Smudge.hs b/Config/Smudge.hs index c17eaa1bca..2f38c47725 100644 --- a/Config/Smudge.hs +++ b/Config/Smudge.hs @@ -70,7 +70,7 @@ deconfigureSmudgeFilter = do lf <- Annex.fromRepo Git.attributesLocal ls <- liftIO $ catchDefaultIO [] $ map decodeBS . fileLines' <$> F.readFile' lf - liftIO $ writeFile (fromOsPath lf) $ unlines $ + liftIO $ writeFileString lf $ unlines $ filter (\l -> l `notElem` stdattr && not (null l)) ls unsetConfig (ConfigKey "filter.annex.smudge") unsetConfig (ConfigKey "filter.annex.clean") diff --git a/Database/Keys.hs b/Database/Keys.hs index d3fce7bbd8..93e659f445 100644 --- a/Database/Keys.hs +++ b/Database/Keys.hs @@ -264,7 +264,7 @@ reconcileStaged dbisnew qh = ifM isBareRepo ( return mempty , do gitindex <- inRepo currentIndexFile - indexcache <- fromOsPath <$> calcRepo' gitAnnexKeysDbIndexCache + indexcache <- calcRepo' gitAnnexKeysDbIndexCache withTSDelta (liftIO . genInodeCache gitindex) >>= \case Just cur -> readindexcache indexcache >>= \case Nothing -> go cur indexcache =<< getindextree @@ -278,7 +278,7 @@ reconcileStaged dbisnew qh = ifM isBareRepo lastindexref = Ref "refs/annex/last-index" readindexcache indexcache = liftIO $ maybe Nothing readInodeCache - <$> catchMaybeIO (readFile indexcache) + <$> catchMaybeIO (readFileString indexcache) getoldtree = fromMaybe emptyTree <$> inRepo (Git.Ref.sha lastindexref) @@ -292,7 +292,7 @@ reconcileStaged dbisnew qh = ifM isBareRepo (Just (fromRef oldtree)) (fromRef newtree) (procdiff mdfeeder) - liftIO $ writeFile indexcache $ showInodeCache cur + liftIO $ writeFileString indexcache $ showInodeCache cur -- Storing the tree in a ref makes sure it does not -- get garbage collected, and is available to diff -- against next time. diff --git a/Git/Construct.hs b/Git/Construct.hs index afbe4a5232..cd91fd6461 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -280,7 +280,7 @@ adjustGitDirFile loc = fromMaybe loc <$> adjustGitDirFile' loc adjustGitDirFile' :: RepoLocation -> IO (Maybe RepoLocation) adjustGitDirFile' loc@(Local {}) = do let gd = gitdir loc - c <- firstLine <$> catchDefaultIO "" (readFile (fromOsPath gd)) + c <- firstLine <$> catchDefaultIO "" (readFileString gd) if gitdirprefix `isPrefixOf` c then do top <- takeDirectory <$> absPath gd diff --git a/Git/Hook.hs b/Git/Hook.hs index e5a67bda7d..d1c32fd189 100644 --- a/Git/Hook.hs +++ b/Git/Hook.hs @@ -59,7 +59,7 @@ hookWrite h r = ifM (doesFileExist f) f = hookFile h r go = do -- On Windows, using a ByteString as the file content - -- avoids the newline translation done by writeFile. + -- avoids the newline translation done by writeFileString. -- Hook scripts on Windows could use CRLF endings, but -- they typically use unix newlines, which does work there -- and makes the repository more portable. @@ -85,11 +85,11 @@ data ExpectedContent = UnexpectedContent | ExpectedContent | OldExpectedContent expectedContent :: Hook -> Repo -> IO ExpectedContent expectedContent h r = do - -- Note that on windows, this readFile does newline translation, + -- Note that on windows, this readFileString does newline translation, -- and so a hook file that has CRLF will be treated the same as one -- that has LF. That is intentional, since users may have a reason -- to prefer one or the other. - content <- readFile $ fromOsPath $ hookFile h r + content <- readFileString $ hookFile h r return $ if content == hookScript h then ExpectedContent else if any (content ==) (hookOldScripts h) diff --git a/Git/Objects.hs b/Git/Objects.hs index 4d2a2e907b..d39f410074 100644 --- a/Git/Objects.hs +++ b/Git/Objects.hs @@ -50,7 +50,7 @@ looseObjectFile r sha = objectsDir r toOsPath prefix toOsPath rest listAlternates :: Repo -> IO [FilePath] listAlternates r = catchDefaultIO [] $ - lines <$> readFile (fromOsPath alternatesfile) + lines <$> readFileString alternatesfile where alternatesfile = objectsDir r literalOsPath "info" literalOsPath "alternates" diff --git a/Git/Repair.hs b/Git/Repair.hs index 2f1c31fe71..246b40ed8c 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -269,7 +269,7 @@ explodePackedRefsFile r = do let dest = gitd toOsPath (fromRef' ref) createDirectoryUnder [gitd] (parentDir dest) unlessM (doesFileExist dest) $ - writeFile (fromOsPath dest) (fromRef sha) + writeFileString dest (fromRef sha) packedRefsFile :: Repo -> OsPath packedRefsFile r = localGitDir r literalOsPath "packed-refs" @@ -472,7 +472,7 @@ preRepair :: Repo -> IO () preRepair g = do unlessM (validhead <$> catchDefaultIO "" (decodeBS <$> safeReadFile headfile)) $ do removeWhenExistsWith removeFile headfile - writeFile (fromOsPath headfile) "ref: refs/heads/master" + writeFileString headfile "ref: refs/heads/master" explodePackedRefsFile g unless (repoIsLocalBare g) $ void $ tryIO $ allowWrite $ indexFile g diff --git a/Logs/File.hs b/Logs/File.hs index 882dc25369..71a5baeb1c 100644 --- a/Logs/File.hs +++ b/Logs/File.hs @@ -38,7 +38,7 @@ writeLogFile :: OsPath -> String -> Annex () writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog f c where writelog tmp c' = do - liftIO $ writeFile (fromOsPath tmp) c' + liftIO $ writeFileString tmp c' setAnnexFilePerm tmp -- | Runs the action with a handle connected to a temp file. diff --git a/Logs/FsckResults.hs b/Logs/FsckResults.hs index b938491092..3234af2493 100644 --- a/Logs/FsckResults.hs +++ b/Logs/FsckResults.hs @@ -45,7 +45,7 @@ readFsckResults :: UUID -> Annex FsckResults readFsckResults u = do logfile <- fromRepo $ gitAnnexFsckResultsLog u liftIO $ catchDefaultIO (FsckFoundMissing S.empty False) $ - deserializeFsckResults <$> readFile (fromOsPath logfile) + deserializeFsckResults <$> readFileString logfile deserializeFsckResults :: String -> FsckResults deserializeFsckResults = deserialize . lines diff --git a/Logs/Restage.hs b/Logs/Restage.hs index 3e3c439598..d63391c814 100644 --- a/Logs/Restage.hs +++ b/Logs/Restage.hs @@ -55,7 +55,7 @@ streamRestageLog finalizer processor = do ifM (doesPathExist oldf) ( do h <- F.openFile oldf AppendMode - hPutStr h =<< readFile (fromOsPath logf) + hPutStr h =<< readFileString logf hClose h liftIO $ removeWhenExistsWith removeFile logf , moveFile logf oldf diff --git a/Logs/Schedule.hs b/Logs/Schedule.hs index 6727fdd316..7bd839a545 100644 --- a/Logs/Schedule.hs +++ b/Logs/Schedule.hs @@ -63,9 +63,9 @@ scheduleChange u a = scheduleSet u . S.toList . a =<< scheduleGet u getLastRunTimes :: Annex (M.Map ScheduledActivity LocalTime) getLastRunTimes = do - f <- fromOsPath <$> fromRepo gitAnnexScheduleState + f <- fromRepo gitAnnexScheduleState liftIO $ fromMaybe M.empty - <$> catchDefaultIO Nothing (readish <$> readFile f) + <$> catchDefaultIO Nothing (readish <$> readFileString f) setLastRunTime :: ScheduledActivity -> LocalTime -> Annex () setLastRunTime activity lastrun = do diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 85a5f7b824..e0beadab53 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -263,7 +263,7 @@ writeTransferInfoFile info tfile = writeLogFile tfile $ writeTransferInfo info -- after it's been created with the right perms by writeTransferInfoFile. updateTransferInfoFile :: TransferInfo -> OsPath -> IO () updateTransferInfoFile info tfile = - writeFile (fromOsPath tfile) $ writeTransferInfo info + writeFileString tfile $ writeTransferInfo info {- File format is a header line containing the startedTime and any - bytesComplete value. Followed by a newline and the associatedFile. diff --git a/Logs/View.hs b/Logs/View.hs index 14ee8dcd37..838471f14e 100644 --- a/Logs/View.hs +++ b/Logs/View.hs @@ -54,8 +54,8 @@ removeView v = writeViews =<< filter (/= v) <$> recentViews recentViews :: Annex [View] recentViews = do - f <- fromOsPath <$> fromRepo gitAnnexViewLog - liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFile f) + f <- fromRepo gitAnnexViewLog + liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFileString f) {- Gets the currently checked out view, if there is one. - diff --git a/Remote/Directory/LegacyChunked.hs b/Remote/Directory/LegacyChunked.hs index 3773ed9172..e32b263b98 100644 --- a/Remote/Directory/LegacyChunked.hs +++ b/Remote/Directory/LegacyChunked.hs @@ -33,7 +33,7 @@ withCheckedFiles check d locations k a = go $ locations d k let chunkcount = f ++ Legacy.chunkCount ifM (check chunkcount) ( do - chunks <- Legacy.listChunks f <$> readFile chunkcount + chunks <- Legacy.listChunks f <$> readFileString (toOsPath chunkcount) ifM (allM check chunks) ( a chunks , return False ) , do @@ -85,7 +85,7 @@ storeHelper repotop finalizer key storer tmpdir destdir = do recorder f s = do let f' = toOsPath f void $ tryIO $ allowWrite f' - writeFile f s + writeFileString f' s void $ tryIO $ preventWrite f' store :: FilePath -> ChunkSize -> (OsPath -> OsPath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO () diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs index 2f0cebf188..c58ae362b4 100644 --- a/Remote/Tahoe.hs +++ b/Remote/Tahoe.hs @@ -213,7 +213,7 @@ createClient configdir furl = do writeSharedConvergenceSecret :: TahoeConfigDir -> SharedConvergenceSecret -> IO () writeSharedConvergenceSecret configdir scs = - writeFile (fromOsPath (convergenceFile configdir)) + writeFileString (convergenceFile configdir) (unlines [scs]) {- The tahoe daemon writes the convergenceFile shortly after it starts @@ -223,11 +223,11 @@ writeSharedConvergenceSecret configdir scs = getSharedConvergenceSecret :: TahoeConfigDir -> IO SharedConvergenceSecret getSharedConvergenceSecret configdir = go (60 :: Int) where - f = fromOsPath $ convergenceFile configdir + f = convergenceFile configdir go n - | n == 0 = giveup $ "tahoe did not write " ++ f ++ " after 1 minute. Perhaps the daemon failed to start?" + | n == 0 = giveup $ "tahoe did not write " ++ fromOsPath f ++ " after 1 minute. Perhaps the daemon failed to start?" | otherwise = do - v <- catchMaybeIO (readFile f) + v <- catchMaybeIO (readFileString f) case v of Just s | "\n" `isSuffixOf` s || "\r" `isSuffixOf` s -> return $ takeWhile (`notElem` ("\n\r" :: String)) s diff --git a/Test.hs b/Test.hs index 62cb88c10f..43a15f8952 100644 --- a/Test.hs +++ b/Test.hs @@ -556,8 +556,8 @@ test_magic = intmpclonerepo $ do #ifdef WITH_MAGICMIME git "config" ["annex.largefiles", "mimeencoding=binary"] "git config annex.largefiles" - writeFile "binary" "\127" - writeFile "text" "test\n" + writeFileString (literalOsPath "binary") "\127" + writeFileString (literalOsPath "text") "test\n" git_annex "add" ["binary", "text"] "git-annex add with mimeencoding in largefiles" git_annex "sync" ["--no-content"] @@ -879,7 +879,7 @@ test_lock = intmpclonerepo $ do changecontent annexedfile git "add" [annexedfile] "add of modified file" runchecks [checkregularfile, checkwritable] annexedfile - c <- readFile annexedfile + c <- readFileString (toOsPath annexedfile) assertEqual "content of modified file" c (changedcontent annexedfile) git_annex_shouldfail "drop" [annexedfile] "drop with no known copy of modified file should not be allowed" @@ -921,7 +921,7 @@ test_edit' precommit = intmpclonerepo $ do then git_annex "pre-commit" [] "pre-commit" else git "commit" ["-q", "-m", "contentchanged"] "git commit of edited file" runchecks [checkregularfile, checkwritable] annexedfile - c <- readFile annexedfile + c <- readFileString (toOsPath annexedfile) assertEqual "content of modified file" c (changedcontent annexedfile) git_annex_shouldfail "drop" [annexedfile] "drop no known copy of modified file should not be allowed" @@ -947,7 +947,7 @@ test_fix = intmpclonerepo $ unlessM (hasUnlockedFiles <$> getTestMode) $ do git "mv" [annexedfile, subdir] "git mv" git_annex "fix" [newfile] "fix of moved file" runchecks [checklink, checkunwritable] newfile - c <- readFile newfile + c <- readFileString (toOsPath newfile) assertEqual "content of moved file" c (content annexedfile) where subdir = "s" @@ -1069,7 +1069,8 @@ test_migrate' usegitattributes = intmpclonerepo $ do annexed_present sha1annexedfile if usegitattributes then do - writeFile ".gitattributes" "* annex.backend=SHA1" + writeFileString (literalOsPath ".gitattributes") + "* annex.backend=SHA1" git_annex "migrate" [sha1annexedfile] "migrate sha1annexedfile" git_annex "migrate" [annexedfile] @@ -1085,7 +1086,8 @@ test_migrate' usegitattributes = intmpclonerepo $ do checkbackend sha1annexedfile backendSHA1 -- check that reversing a migration works - writeFile ".gitattributes" "* annex.backend=SHA256" + writeFileString (literalOsPath ".gitattributes") + "* annex.backend=SHA256" git_annex "migrate" [sha1annexedfile] "migrate sha1annexedfile" git_annex "migrate" [annexedfile] "migrate annexedfile" annexed_present annexedfile @@ -1531,7 +1533,7 @@ test_nonannexed_file_conflict_resolution = do length v == 1 @? (what ++ " too many variant files in: " ++ show v) conflictor `elem` l @? (what ++ " conflictor file missing in: " ++ show l) - s <- catchMaybeIO $ readFile $ fromOsPath $ + s <- catchMaybeIO $ readFileString $ toOsPath d toOsPath conflictor s == Just nonannexed_content @? (what ++ " wrong content for nonannexed file: " ++ show s) @@ -2074,9 +2076,9 @@ test_export_import = intmpclonerepo $ do dircontains "import" (content "newimport3") where dircontains f v = do - let df = fromOsPath (literalOsPath "dir" stringToOsPath f) - ((v==) <$> readFile df) - @? ("did not find expected content of " ++ df) + let df = literalOsPath "dir" stringToOsPath f + ((v==) <$> readFileString df) + @? ("did not find expected content of " ++ fromOsPath df) writedir f = writecontent (fromOsPath (literalOsPath "dir" stringToOsPath f)) -- When on an adjusted branch, this updates the master branch -- to match it, which is necessary since the master branch is going @@ -2111,9 +2113,9 @@ test_export_import_subdir = intmpclonerepo $ do testexport where dircontains f v = do - let df = fromOsPath (literalOsPath "dir" toOsPath f) - ((v==) <$> readFile df) - @? ("did not find expected content of " ++ df) + let df = literalOsPath "dir" toOsPath f + ((v==) <$> readFileString df) + @? ("did not find expected content of " ++ fromOsPath df) subdir = "subdir" subannexedfile = fromOsPath $ diff --git a/Test/Framework.hs b/Test/Framework.hs index 3d0a96fa2f..fee78b4875 100644 --- a/Test/Framework.hs +++ b/Test/Framework.hs @@ -391,7 +391,7 @@ checkexists f = checkcontent :: FilePath -> Assertion checkcontent f = do - c <- Utility.Exception.catchDefaultIO "could not read file" $ readFile f + c <- Utility.Exception.catchDefaultIO "could not read file" $ readFileString (toOsPath f) assertEqual ("checkcontent " ++ f) (content f) c checkunwritable :: FilePath -> Assertion @@ -415,7 +415,7 @@ checkdangling :: FilePath -> Assertion checkdangling f = ifM (annexeval Config.crippledFileSystem) ( return () -- probably no real symlinks to test , do - r <- tryIO $ readFile f + r <- tryIO $ readFileString (toOsPath f) case r of Left _ -> return () -- expected; dangling link Right _ -> assertFailure $ f ++ " was not a dangling link as expected" @@ -675,9 +675,10 @@ writecontent :: FilePath -> String -> IO () writecontent f c = go (10000000 :: Integer) where go ticsleft = do - oldmtime <- catchMaybeIO $ getModificationTime (toOsPath f) - writeFile f c - newmtime <- getModificationTime (toOsPath f) + let f' = toOsPath f + oldmtime <- catchMaybeIO $ getModificationTime f' + writeFileString f' c + newmtime <- getModificationTime f' if Just newmtime == oldmtime then do threadDelay 100000 diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs index bd01cb5ab0..215179cc9a 100644 --- a/Upgrade/V2.hs +++ b/Upgrade/V2.hs @@ -87,7 +87,7 @@ locationLogs = do inject :: OsPath -> OsPath -> Annex () inject source dest = do old <- fromRepo olddir - new <- liftIO (readFile $ fromOsPath $ old source) + new <- liftIO $ readFileString (old source) Annex.Branch.change (Annex.Branch.RegardingUUID []) dest $ \prev -> encodeBL $ unlines $ nub $ lines (decodeBL prev) ++ lines new @@ -141,7 +141,7 @@ gitAttributesUnWrite repo = do whenM (doesFileExist attributes) $ do c <- map decodeBS . fileLines' <$> F.readFile' attributes - liftIO $ viaTmp (writeFile . fromOsPath) attributes + liftIO $ viaTmp writeFileString attributes (unlines $ filter (`notElem` attrLines) c) Git.Command.run [Param "add", File (fromOsPath attributes)] repo diff --git a/Upgrade/V7.hs b/Upgrade/V7.hs index caabe13d2f..218096f208 100644 --- a/Upgrade/V7.hs +++ b/Upgrade/V7.hs @@ -136,7 +136,7 @@ updateSmudgeFilter = do <$> catchDefaultIO "" (F.readFile' lf) let ls' = removedotfilter ls when (ls /= ls') $ - liftIO $ writeFile (fromOsPath lf) (unlines ls') + liftIO $ writeFileString lf (unlines ls') where removedotfilter ("* filter=annex":".* !filter":rest) = "* filter=annex" : removedotfilter rest diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs index a95503f0d2..bd654da7dd 100644 --- a/Utility/Daemon.hs +++ b/Utility/Daemon.hs @@ -121,9 +121,9 @@ lockPidFile pidfile = do unlessM (isNothing <$> checkDaemon pidfile) alreadyRunning pid <- getPID - writeFile (fromOsPath pidfile) (show pid) + writeFileString pidfile (show pid) lckfile <- winLockFile pid pidfile - writeFile (fromOsPath lckfile) "" + writeFileString lckfile "" void $ lockExclusive lckfile #endif @@ -147,7 +147,7 @@ checkDaemon pidfile = bracket setup cleanup go cleanup Nothing = return () go (Just fd) = catchDefaultIO Nothing $ do locked <- getLock fd (ReadLock, AbsoluteSeek, 0, 0) - p <- readish <$> readFile (fromOsPath pidfile) + p <- readish <$> readFileString pidfile return (check locked p) go Nothing = return Nothing @@ -161,7 +161,7 @@ checkDaemon pidfile = bracket setup cleanup go "; expected " ++ show pid ++ " )" #else checkDaemon pidfile = maybe (return Nothing) (check . readish) - =<< catchMaybeIO (readFile (fromOsPath pidfile)) + =<< catchMaybeIO (readFileString pidfile) where check Nothing = return Nothing check (Just pid) = do diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs index a4d5cc5a20..8c7de891ea 100644 --- a/Utility/FileMode.hs +++ b/Utility/FileMode.hs @@ -171,7 +171,7 @@ setSticky f = modifyFileMode f $ addModes [stickyMode] - When possible, this is done using the umask. - - On a filesystem that does not support file permissions, this is the same - - as writeFile. + - as writeFileString. -} writeFileProtected :: OsPath -> String -> IO () writeFileProtected file content = writeFileProtected' file diff --git a/Utility/FreeDesktop.hs b/Utility/FreeDesktop.hs index 71ec3a3c7b..8fe6cbf9dc 100644 --- a/Utility/FreeDesktop.hs +++ b/Utility/FreeDesktop.hs @@ -75,7 +75,7 @@ buildDesktopMenuFile d = unlines ("[Desktop Entry]" : map keyvalue d) ++ "\n" writeDesktopMenuFile :: DesktopEntry -> OsPath -> IO () writeDesktopMenuFile d file = do createDirectoryIfMissing True (takeDirectory file) - writeFile (fromOsPath file) $ buildDesktopMenuFile d + writeFileString file $ buildDesktopMenuFile d {- Path to use for a desktop menu file, in either the systemDataDir or - the userDataDir -} diff --git a/Utility/InodeCache.hs b/Utility/InodeCache.hs index 7e1b18aa35..08c4a6c8a6 100644 --- a/Utility/InodeCache.hs +++ b/Utility/InodeCache.hs @@ -234,7 +234,7 @@ noTSDelta = TSDelta (pure 0) writeSentinalFile :: SentinalFile -> IO () writeSentinalFile s = do F.writeFile' (sentinalFile s) mempty - maybe noop (writeFile (fromOsPath (sentinalCacheFile s)) . showInodeCache) + maybe noop (writeFileString (sentinalCacheFile s) . showInodeCache) =<< genInodeCache (sentinalFile s) noTSDelta data SentinalStatus = SentinalStatus @@ -263,7 +263,7 @@ checkSentinalFile s = do Just new -> return $ calc old new where loadoldcache = catchDefaultIO Nothing $ - readInodeCache <$> readFile (fromOsPath (sentinalCacheFile s)) + readInodeCache <$> readFileString (sentinalCacheFile s) gennewcache = genInodeCache (sentinalFile s) noTSDelta calc (InodeCache (InodeCachePrim oldinode oldsize oldmtime)) (InodeCache (InodeCachePrim newinode newsize newmtime)) = SentinalStatus (not unchanged) tsdelta diff --git a/Utility/LockFile/PidLock.hs b/Utility/LockFile/PidLock.hs index 2c480a354d..67cf78d62e 100644 --- a/Utility/LockFile/PidLock.hs +++ b/Utility/LockFile/PidLock.hs @@ -41,6 +41,7 @@ import Utility.Env.Set import Utility.Tmp import Utility.RawFilePath import Utility.OsPath +import qualified Utility.FileIO as F import qualified Utility.LockFile.Posix as Posix import System.IO @@ -77,7 +78,7 @@ mkPidLock = PidLock readPidLock :: PidLockFile -> IO (Maybe PidLock) readPidLock lockfile = (readish =<<) - <$> catchMaybeIO (readFile (fromOsPath lockfile)) + <$> catchMaybeIO (F.readFileString lockfile) -- To avoid races when taking over a stale pid lock, a side lock is used. -- This is a regular posix exclusive lock. @@ -214,7 +215,7 @@ linkToLock (Just _) src dest = do (CloseOnExecFlag True) fdToHandle fd let cleanup = hClose - let go h = readFile (fromOsPath src) >>= hPutStr h + let go h = F.readFileString src >>= hPutStr h bracket setup cleanup go getFileStatus dest' where diff --git a/Utility/Misc.hs b/Utility/Misc.hs index ac98873ab1..c81ca21f28 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -110,7 +110,7 @@ fileLines' = map stripCR . S8.lines fileLines' = S8.lines #endif --- One windows, writeFile does NewlineMode translation, +-- On windows, writeFile does NewlineMode translation, -- adding CR before LF. When converting to ByteString, use this to emulate that. linesFile :: L.ByteString -> L.ByteString #ifndef mingw32_HOST_OS diff --git a/Utility/Shell.hs b/Utility/Shell.hs index 0d43994f98..5f9b08909d 100644 --- a/Utility/Shell.hs +++ b/Utility/Shell.hs @@ -37,7 +37,7 @@ findShellCommand f = do #ifndef mingw32_HOST_OS defcmd #else - l <- catchDefaultIO Nothing $ headMaybe . lines <$> readFile (fromOsPath f) + l <- catchDefaultIO Nothing $ headMaybe . lines <$> readFileString f case l of Just ('#':'!':rest) -> case words rest of [] -> defcmd diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs index c47cdfcb0b..582f6849fc 100644 --- a/Utility/Tmp.hs +++ b/Utility/Tmp.hs @@ -49,13 +49,13 @@ openTmpFileIn dir template = F.openTempFile dir template let loc = ioeGetLocation e ++ " template " ++ decodeBS (fromOsPath template) in annotateIOError e loc Nothing Nothing -{- Runs an action like writeFile, writing to a temp file first and +{- Runs an action like writeFileString, writing to a temp file first and - then moving it into place. The temp file is stored in the same - directory as the final file to avoid cross-device renames. - - While this uses a temp file, the file will end up with the same - - mode as it would when using writeFile, unless the writer action changes - - it. + - mode as it would when using writeFileString, unless the writer action + - changes it. -} viaTmp :: (MonadMask m, MonadIO m) => (OsPath -> v -> m ()) -> OsPath -> v -> m () viaTmp a file content = bracketIO setup cleanup use diff --git a/Utility/Tor.hs b/Utility/Tor.hs index a49d7375a7..05ece394fe 100644 --- a/Utility/Tor.hs +++ b/Utility/Tor.hs @@ -71,7 +71,7 @@ connectHiddenService (OnionAddress address) port = do addHiddenService :: AppName -> UserID -> UniqueIdent -> IO (OnionAddress, OnionPort) addHiddenService appname uid ident = do prepHiddenServiceSocketDir appname uid ident - ls <- lines <$> (readFile . fromOsPath =<< findTorrc) + ls <- lines <$> (readFileString =<< findTorrc) let portssocks = mapMaybe (parseportsock . separate isSpace) ls case filter (\(_, s) -> s == fromOsPath sockfile) portssocks of ((p, _s):_) -> waithiddenservice 1 p @@ -80,7 +80,7 @@ addHiddenService appname uid ident = do let newport = fromMaybe (error "internal") $ headMaybe $ filter (`notElem` map fst portssocks) highports torrc <- findTorrc - writeFile (fromOsPath torrc) $ unlines $ + writeFileString torrc $ unlines $ ls ++ [ "" , "HiddenServiceDir " ++ fromOsPath (hiddenServiceDir appname uid ident) @@ -112,7 +112,7 @@ addHiddenService appname uid ident = do waithiddenservice :: Int -> OnionPort -> IO (OnionAddress, OnionPort) waithiddenservice 0 _ = giveup "tor failed to create hidden service, perhaps the tor service is not running" waithiddenservice n p = do - v <- tryIO $ readFile $ fromOsPath $ + v <- tryIO $ readFileString $ hiddenServiceHostnameFile appname uid ident case v of Right s | ".onion\n" `isSuffixOf` s -> @@ -152,7 +152,7 @@ hiddenServiceSocketFile appname uid ident = getHiddenServiceSocketFile :: AppName -> UserID -> UniqueIdent -> IO (Maybe OsPath) getHiddenServiceSocketFile _appname uid ident = parse . map words . lines <$> catchDefaultIO "" - (readFile . fromOsPath =<< findTorrc) + (readFileString =<< findTorrc) where parse [] = Nothing parse (("HiddenServiceDir":hsdir:[]):("HiddenServicePort":_hsport:hsaddr:[]):rest)