From 6e27b0d4d1548e4e7346c86b3272b24dd65ba66d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 22 Jan 2025 16:19:06 -0400 Subject: [PATCH] convert from readFileStrict This removes that function, using file-io readFile' instead. Had to deal with newline conversion, which readFileStrict does on Windows. In a few cases, that was pretty ugly to deal with. Sponsored-by: Kevin Mueller --- Assistant/Install.hs | 15 +++++++++------ Assistant/Threads/TransferPoller.hs | 2 +- Assistant/Threads/TransferWatcher.hs | 2 +- Assistant/Upgrade.hs | 6 ++++-- CmdLine/GitRemoteAnnex.hs | 6 ++++-- Command/P2P.hs | 19 ++++++++++--------- Command/Vicfg.hs | 10 +++++++--- Config/Smudge.hs | 8 +++++--- Creds.hs | 16 ++++++++++------ Git/Repair.hs | 11 +++++++---- Logs/Transfer.hs | 18 +++++++++++------- Logs/Unused.hs | 9 +++++---- Logs/Upgrade.hs | 9 +++++---- Types/Distribution.hs | 7 +++---- Upgrade/V2.hs | 6 ++++-- Upgrade/V5/Direct.hs | 4 ++-- Utility/Misc.hs | 5 ----- Utility/SshConfig.hs | 4 +++- doc/todo/RawFilePath_conversion.mdwn | 8 +++----- 19 files changed, 94 insertions(+), 71 deletions(-) diff --git a/Assistant/Install.hs b/Assistant/Install.hs index b2b7b91c62..db34000672 100644 --- a/Assistant/Install.hs +++ b/Assistant/Install.hs @@ -29,6 +29,7 @@ import Utility.Android #endif import System.PosixCompat.Files (ownerExecuteMode) +import qualified Data.ByteString.Char8 as S8 standaloneAppBase :: IO (Maybe FilePath) standaloneAppBase = getEnv "GIT_ANNEX_APP_BASE" @@ -83,7 +84,7 @@ ensureInstalled = ifM (isJust <$> getEnv "GIT_ANNEX_PACKAGE_INSTALL") let runshell var = "exec " ++ base "runshell " ++ var let rungitannexshell var = runshell $ "git-annex-shell -c \"" ++ var ++ "\"" - installWrapper (toRawFilePath (sshdir "git-annex-shell")) $ unlines + installWrapper (toRawFilePath (sshdir "git-annex-shell")) $ [ shebang , "set -e" , "if [ \"x$SSH_ORIGINAL_COMMAND\" != \"x\" ]; then" @@ -92,7 +93,7 @@ ensureInstalled = ifM (isJust <$> getEnv "GIT_ANNEX_PACKAGE_INSTALL") , rungitannexshell "$@" , "fi" ] - installWrapper (toRawFilePath (sshdir "git-annex-wrapper")) $ unlines + installWrapper (toRawFilePath (sshdir "git-annex-wrapper")) $ [ shebang , "set -e" , runshell "\"$@\"" @@ -100,12 +101,14 @@ ensureInstalled = ifM (isJust <$> getEnv "GIT_ANNEX_PACKAGE_INSTALL") installFileManagerHooks program -installWrapper :: RawFilePath -> String -> IO () +installWrapper :: RawFilePath -> [String] -> IO () installWrapper file content = do - curr <- catchDefaultIO "" $ readFileStrict (fromRawFilePath file) - when (curr /= content) $ do + let content' = map encodeBS content + curr <- catchDefaultIO [] $ fileLines' <$> F.readFile' (toOsPath file) + when (curr /= content') $ do createDirectoryIfMissing True (fromRawFilePath (parentDir file)) - viaTmp (writeFile . fromRawFilePath . fromOsPath) (toOsPath file) content + viaTmp F.writeFile' (toOsPath file) $ + linesFile' (S8.unlines content') modifyFileMode file $ addModes [ownerExecuteMode] installFileManagerHooks :: FilePath -> IO () diff --git a/Assistant/Threads/TransferPoller.hs b/Assistant/Threads/TransferPoller.hs index 067bd0b022..f5e9cff7da 100644 --- a/Assistant/Threads/TransferPoller.hs +++ b/Assistant/Threads/TransferPoller.hs @@ -47,7 +47,7 @@ transferPollerThread = namedThread "TransferPoller" $ do | otherwise = do let (f, _, _) = transferFileAndLockFile t g mi <- liftIO $ catchDefaultIO Nothing $ - readTransferInfoFile Nothing (fromRawFilePath f) + readTransferInfoFile Nothing f maybe noop (newsize t info . bytesComplete) mi newsize t info sz diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs index 3dc40fb1e1..bff9263fb6 100644 --- a/Assistant/Threads/TransferWatcher.hs +++ b/Assistant/Threads/TransferWatcher.hs @@ -75,7 +75,7 @@ onAdd file = case parseTransferFile (toRawFilePath file) of onModify :: Handler onModify file = case parseTransferFile (toRawFilePath file) of Nothing -> noop - Just t -> go t =<< liftIO (readTransferInfoFile Nothing file) + Just t -> go t =<< liftIO (readTransferInfoFile Nothing (toRawFilePath file)) where go _ Nothing = noop go t (Just newinfo) = alterTransferInfo t $ diff --git a/Assistant/Upgrade.hs b/Assistant/Upgrade.hs index 075ce57286..3d448c4998 100644 --- a/Assistant/Upgrade.hs +++ b/Assistant/Upgrade.hs @@ -41,10 +41,11 @@ import qualified Utility.Url as Url import qualified Annex.Url as Url hiding (download) import Utility.Tuple import qualified Utility.RawFilePath as R -import qualified System.FilePath.ByteString as P +import qualified Utility.FileIO as F import Data.Either import qualified Data.Map as M +import qualified System.FilePath.ByteString as P {- Upgrade without interaction in the webapp. -} unattendedUpgrade :: Assistant () @@ -329,7 +330,8 @@ downloadDistributionInfo = do ifM (isRight <$> Url.download nullMeterUpdate Nothing distributionInfoUrl infof uo <&&> (isRight <$> Url.download nullMeterUpdate Nothing distributionInfoSigUrl sigf uo) <&&> verifyDistributionSig gpgcmd sigf) - ( parseInfoFile <$> readFileStrict infof + ( parseInfoFile . map decodeBS . fileLines' + <$> F.readFile' (toOsPath (toRawFilePath infof)) , return Nothing ) diff --git a/CmdLine/GitRemoteAnnex.hs b/CmdLine/GitRemoteAnnex.hs index d15fe3fd89..91bdc0b263 100644 --- a/CmdLine/GitRemoteAnnex.hs +++ b/CmdLine/GitRemoteAnnex.hs @@ -502,8 +502,10 @@ resolveSpecialRemoteWebUrl url Url.download' nullMeterUpdate Nothing url tmp' uo >>= \case Left err -> giveup $ url ++ " " ++ err Right () -> liftIO $ - (headMaybe . lines) - <$> readFileStrict tmp' + fmap decodeBS + . headMaybe + . fileLines' + <$> F.readFile' tmp | otherwise = return Nothing where lcurl = map toLower url diff --git a/Command/P2P.hs b/Command/P2P.hs index cef725bf43..14f6d24fa4 100644 --- a/Command/P2P.hs +++ b/Command/P2P.hs @@ -26,6 +26,7 @@ import Utility.FileMode import Utility.ThreadScheduler import Utility.SafeOutput import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F import qualified Utility.MagicWormhole as Wormhole import Control.Concurrent.Async @@ -193,12 +194,11 @@ serializePairData :: PairData -> String serializePairData (PairData (HalfAuthToken ha) addrs) = unlines $ T.unpack ha : map formatP2PAddress addrs -deserializePairData :: String -> Maybe PairData -deserializePairData s = case lines s of - [] -> Nothing - (ha:l) -> do - addrs <- mapM unformatP2PAddress l - return (PairData (HalfAuthToken (T.pack ha)) addrs) +deserializePairData :: [String] -> Maybe PairData +deserializePairData [] = Nothing +deserializePairData (ha:l) = do + addrs <- mapM unformatP2PAddress l + return (PairData (HalfAuthToken (T.pack ha)) addrs) data PairingResult = PairSuccess @@ -245,13 +245,14 @@ wormholePairing remotename ouraddrs ui = do then return ReceiveFailed else do r <- liftIO $ tryIO $ - readFileStrict recvf + map decodeBS . fileLines' <$> F.readFile' + (toOsPath (toRawFilePath recvf)) case r of Left _e -> return ReceiveFailed - Right s -> maybe + Right ls -> maybe (return ReceiveFailed) (finishPairing 100 remotename ourhalf) - (deserializePairData s) + (deserializePairData ls) -- | Allow the peer we're pairing with to authenticate to us, -- using an authtoken constructed from the two HalfAuthTokens. diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index 806b5e5df0..426177ec69 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -35,6 +35,7 @@ import Remote import Git.Types (fromConfigKey, fromConfigValue) import Utility.DataUnits import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F cmd :: Command cmd = command "vicfg" SectionSetup "edit configuration in git-annex branch" @@ -60,7 +61,10 @@ vicfg curcfg f = do -- Allow EDITOR to be processed by the shell, so it can contain options. unlessM (liftIO $ boolSystem "sh" [Param "-c", Param $ unwords [vi, shellEscape f]]) $ giveup $ vi ++ " exited nonzero; aborting" - r <- parseCfg (defCfg curcfg) <$> liftIO (readFileStrict f) + r <- liftIO $ parseCfg (defCfg curcfg) + . map decodeBS + . fileLines' + <$> F.readFile' (toOsPath (toRawFilePath f)) liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f) case r of Left s -> do @@ -278,8 +282,8 @@ lcom = map (\l -> if "#" `isPrefixOf` l then l else '#' : l) {- If there's a parse error, returns a new version of the file, - with the problem lines noted. -} -parseCfg :: Cfg -> String -> Either String Cfg -parseCfg defcfg = go [] defcfg . lines +parseCfg :: Cfg -> [String] -> Either String Cfg +parseCfg defcfg = go [] defcfg where go c cfg [] | null (mapMaybe fst c) = Right cfg diff --git a/Config/Smudge.hs b/Config/Smudge.hs index 7d880c05cf..aa89990c0a 100644 --- a/Config/Smudge.hs +++ b/Config/Smudge.hs @@ -19,6 +19,7 @@ import Utility.Directory.Create import Annex.Version import qualified Utility.FileIO as F +import qualified Data.ByteString as S import qualified System.FilePath.ByteString as P configureSmudgeFilter :: Annex () @@ -45,11 +46,12 @@ configureSmudgeFilter = unlessM (fromRepo Git.repoIsLocalBare) $ do lfs <- readattr lf gfs <- readattr gf gittop <- Git.localGitDir <$> gitRepo - liftIO $ unless ("filter=annex" `isInfixOf` (lfs ++ gfs)) $ do + liftIO $ unless ("filter=annex" `S.isInfixOf` (lfs <> gfs)) $ do createDirectoryUnder [gittop] (P.takeDirectory lf) - writeFile (fromRawFilePath lf) (lfs ++ "\n" ++ unlines stdattr) + F.writeFile' (toOsPath lf) $ + linesFile' (lfs <> encodeBS ("\n" ++ unlines stdattr)) where - readattr = liftIO . catchDefaultIO "" . readFileStrict . fromRawFilePath + readattr = liftIO . catchDefaultIO mempty . F.readFile' . toOsPath configureSmudgeFilterProcess :: Annex () configureSmudgeFilterProcess = diff --git a/Creds.hs b/Creds.hs index e429d796cf..3bbf6f7b28 100644 --- a/Creds.hs +++ b/Creds.hs @@ -37,9 +37,10 @@ import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, Encry import Utility.Env (getEnv) import Utility.Base64 import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F -import qualified Data.ByteString.Lazy.Char8 as L -import qualified Data.ByteString.Char8 as S +import qualified Data.ByteString.Lazy.Char8 as L8 +import qualified Data.ByteString.Char8 as S8 import qualified Data.Map as M import qualified System.FilePath.ByteString as P @@ -99,7 +100,7 @@ setRemoteCredPair' pc encsetup gc storage mcreds = case mcreds of storeconfig creds key (Just cipher) = do cmd <- gpgCmd <$> Annex.getGitConfig s <- liftIO $ encrypt cmd (pc, gc) cipher - (feedBytes $ L.pack $ encodeCredPair creds) + (feedBytes $ L8.pack $ encodeCredPair creds) (readBytesStrictly return) storeconfig' key (Accepted (decodeBS (toB64 s))) storeconfig creds key Nothing = @@ -135,8 +136,8 @@ getRemoteCredPair c gc storage = maybe fromcache (return . Just) =<< fromenv fromenccreds enccreds cipher storablecipher = do cmd <- gpgCmd <$> Annex.getGitConfig mcreds <- liftIO $ catchMaybeIO $ decrypt cmd (c, gc) cipher - (feedBytes $ L.fromStrict $ fromB64 enccreds) - (readBytesStrictly $ return . S.unpack) + (feedBytes $ L8.fromStrict $ fromB64 enccreds) + (readBytesStrictly $ return . S8.unpack) case mcreds of Just creds -> fromcreds creds Nothing -> do @@ -202,7 +203,10 @@ writeCreds creds file = do liftIO $ writeFileProtected (d P. toRawFilePath file) creds readCreds :: FilePath -> Annex (Maybe Creds) -readCreds f = liftIO . catchMaybeIO . readFileStrict =<< credsFile f +readCreds f = do + f' <- toOsPath . toRawFilePath <$> credsFile f + liftIO $ catchMaybeIO $ decodeBS . S8.unlines . fileLines' + <$> F.readFile' f' credsFile :: FilePath -> Annex FilePath credsFile basefile = do diff --git a/Git/Repair.hs b/Git/Repair.hs index d69cdc2648..ed46161cfe 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -47,6 +47,7 @@ import qualified Utility.RawFilePath as R import qualified Utility.FileIO as F import qualified Data.Set as S +import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified System.FilePath.ByteString as P @@ -263,7 +264,9 @@ explodePackedRefsFile r = do let f = packedRefsFile r let f' = toRawFilePath f whenM (doesFileExist f) $ do - rs <- mapMaybe parsePacked . lines + rs <- mapMaybe parsePacked + . map decodeBS + . fileLines' <$> catchDefaultIO "" (safeReadFile f') forM_ rs makeref removeWhenExistsWith R.removeLink f' @@ -474,7 +477,7 @@ displayList items header -} preRepair :: Repo -> IO () preRepair g = do - unlessM (validhead <$> catchDefaultIO "" (safeReadFile headfile)) $ do + unlessM (validhead <$> catchDefaultIO "" (decodeBS <$> safeReadFile headfile)) $ do removeWhenExistsWith R.removeLink headfile writeFile (fromRawFilePath headfile) "ref: refs/heads/master" explodePackedRefsFile g @@ -652,7 +655,7 @@ runRepair' removablebranch fsckresult forced referencerepo g = do successfulRepair :: (Bool, [Branch]) -> Bool successfulRepair = fst -safeReadFile :: RawFilePath -> IO String +safeReadFile :: RawFilePath -> IO B.ByteString safeReadFile f = do allowRead f - readFileStrict (fromRawFilePath f) + F.readFile' (toOsPath f) diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 603a8446b0..098ecb9465 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -22,6 +22,7 @@ import Annex.LockPool import Utility.TimeStamp import Logs.File import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F #ifndef mingw32_HOST_OS import Annex.Perms #endif @@ -119,7 +120,7 @@ checkTransfer t = debugLocks $ do (Just oldlck, _) -> getLockStatus oldlck case v' of StatusLockedBy pid -> liftIO $ catchDefaultIO Nothing $ - readTransferInfoFile (Just pid) (fromRawFilePath tfile) + readTransferInfoFile (Just pid) tfile _ -> do mode <- annexFileMode -- Ignore failure due to permissions, races, etc. @@ -140,7 +141,7 @@ checkTransfer t = debugLocks $ do v <- liftIO $ lockShared lck liftIO $ case v of Nothing -> catchDefaultIO Nothing $ - readTransferInfoFile Nothing (fromRawFilePath tfile) + readTransferInfoFile Nothing tfile Just lockhandle -> do dropLock lockhandle deletestale @@ -181,7 +182,7 @@ getFailedTransfers u = catMaybes <$> (liftIO . getpairs =<< concat <$> findfiles where getpairs = mapM $ \f -> do let mt = parseTransferFile f - mi <- readTransferInfoFile Nothing (fromRawFilePath f) + mi <- readTransferInfoFile Nothing f return $ case (mt, mi) of (Just t, Just i) -> Just (t, i) _ -> Nothing @@ -285,9 +286,9 @@ writeTransferInfo info = unlines in maybe "" fromRawFilePath afile ] -readTransferInfoFile :: Maybe PID -> FilePath -> IO (Maybe TransferInfo) +readTransferInfoFile :: Maybe PID -> RawFilePath -> IO (Maybe TransferInfo) readTransferInfoFile mpid tfile = catchDefaultIO Nothing $ - readTransferInfo mpid <$> readFileStrict tfile + readTransferInfo mpid . decodeBS <$> F.readFile' (toOsPath tfile) readTransferInfo :: Maybe PID -> String -> Maybe TransferInfo readTransferInfo mpid s = TransferInfo @@ -304,8 +305,11 @@ readTransferInfo mpid s = TransferInfo <*> pure False where #ifdef mingw32_HOST_OS - (firstline, otherlines) = separate (== '\n') s - (secondline, rest) = separate (== '\n') otherlines + (firstliner, otherlines) = separate (== '\n') s + (secondliner, rest) = separate (== '\n') otherlines + firstline = dropWhileEnd (== '\r') firstliner + secondline = dropWhileEnd (== '\r') secondliner + secondline = mpid' = readish secondline #else (firstline, rest) = separate (== '\n') s diff --git a/Logs/Unused.hs b/Logs/Unused.hs index 6bb1011e84..5e8416a605 100644 --- a/Logs/Unused.hs +++ b/Logs/Unused.hs @@ -32,6 +32,7 @@ import qualified Data.Map as M import qualified Data.Set as S import Data.Time.Clock.POSIX import Data.Time +import qualified Utility.FileIO as F import Annex.Common import qualified Annex @@ -73,10 +74,10 @@ writeUnusedLog prefix l = do readUnusedLog :: RawFilePath -> Annex UnusedLog readUnusedLog prefix = do - f <- fromRawFilePath <$> fromRepo (gitAnnexUnusedLog prefix) - ifM (liftIO $ doesFileExist f) - ( M.fromList . mapMaybe parse . lines - <$> liftIO (readFileStrict f) + f <- fromRepo (gitAnnexUnusedLog prefix) + ifM (liftIO $ doesFileExist (fromRawFilePath f)) + ( M.fromList . mapMaybe (parse . decodeBS) . fileLines' + <$> liftIO (F.readFile' (toOsPath f)) , return M.empty ) where diff --git a/Logs/Upgrade.hs b/Logs/Upgrade.hs index f1ff0bd56c..bdc4f40d90 100644 --- a/Logs/Upgrade.hs +++ b/Logs/Upgrade.hs @@ -19,6 +19,7 @@ import Annex.Common import Utility.TimeStamp import Logs.File import Types.RepoVersion +import qualified Utility.FileIO as F import Data.Time.Clock.POSIX @@ -31,10 +32,10 @@ writeUpgradeLog v t = do readUpgradeLog :: Annex [(RepoVersion, POSIXTime)] readUpgradeLog = do - logfile <- fromRawFilePath <$> fromRepo gitAnnexUpgradeLog - ifM (liftIO $ doesFileExist logfile) - ( mapMaybe parse . lines - <$> liftIO (readFileStrict logfile) + logfile <- fromRepo gitAnnexUpgradeLog + ifM (liftIO $ doesFileExist (fromRawFilePath logfile)) + ( mapMaybe (parse . decodeBS) . fileLines' + <$> liftIO (F.readFile' (toOsPath logfile)) , return [] ) where diff --git a/Types/Distribution.hs b/Types/Distribution.hs index 3a7aca1f2e..7616efc9e7 100644 --- a/Types/Distribution.hs +++ b/Types/Distribution.hs @@ -40,10 +40,9 @@ formatInfoFile :: GitAnnexDistribution -> String formatInfoFile d = replace "keyVariant = " "keyBackendName = " (show d) ++ "\n" ++ formatGitAnnexDistribution d -parseInfoFile :: String -> Maybe GitAnnexDistribution -parseInfoFile s = case lines s of - (_oldformat:rest) -> parseGitAnnexDistribution (unlines rest) - _ -> Nothing +parseInfoFile :: [String] -> Maybe GitAnnexDistribution +parseInfoFile (_oldformat:rest) = parseGitAnnexDistribution (unlines rest) +parseInfoFile _ = Nothing formatGitAnnexDistribution :: GitAnnexDistribution -> String formatGitAnnexDistribution d = unlines diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs index db6add236b..7690921232 100644 --- a/Upgrade/V2.hs +++ b/Upgrade/V2.hs @@ -20,6 +20,7 @@ import Annex.Content import Utility.Tmp import Logs import Messages.Progress +import qualified Utility.FileIO as F olddir :: Git.Repo -> FilePath olddir g @@ -138,10 +139,11 @@ gitAttributesUnWrite repo = do let attributes = Git.attributes repo let attributes' = fromRawFilePath attributes whenM (doesFileExist attributes') $ do - c <- readFileStrict attributes' + c <- map decodeBS . fileLines' + <$> F.readFile' (toOsPath attributes) liftIO $ viaTmp (writeFile . fromRawFilePath . fromOsPath) (toOsPath attributes) - (unlines $ filter (`notElem` attrLines) $ lines c) + (unlines $ filter (`notElem` attrLines) c) Git.Command.run [Param "add", File attributes'] repo stateDir :: FilePath diff --git a/Upgrade/V5/Direct.hs b/Upgrade/V5/Direct.hs index 672f320ca3..f03d7b3780 100644 --- a/Upgrade/V5/Direct.hs +++ b/Upgrade/V5/Direct.hs @@ -119,8 +119,8 @@ goodContent key file = recordedInodeCache :: Key -> Annex [InodeCache] recordedInodeCache key = withInodeCacheFile key $ \f -> liftIO $ catchDefaultIO [] $ - mapMaybe readInodeCache . lines - <$> readFileStrict (fromRawFilePath f) + mapMaybe (readInodeCache . decodeBS) . fileLines' + <$> F.readFile' (toOsPath f) {- Removes an inode cache. -} removeInodeCache :: Key -> Annex () diff --git a/Utility/Misc.hs b/Utility/Misc.hs index 50982e6cf8..ac98873ab1 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -10,7 +10,6 @@ module Utility.Misc ( hGetContentsStrict, - readFileStrict, separate, separate', separateEnd', @@ -47,10 +46,6 @@ import Prelude hGetContentsStrict :: Handle -> IO String hGetContentsStrict = hGetContents >=> \s -> length s `seq` return s -{- A version of readFile that is not lazy. -} -readFileStrict :: FilePath -> IO String -readFileStrict = readFile >=> \s -> length s `seq` return s - {- Like break, but the item matching the condition is not included - in the second result list. - diff --git a/Utility/SshConfig.hs b/Utility/SshConfig.hs index 8657beef7a..fb7a6b95ac 100644 --- a/Utility/SshConfig.hs +++ b/Utility/SshConfig.hs @@ -34,6 +34,7 @@ import Data.Char import Data.Ord import Data.Either import System.PosixCompat.Files (groupWriteMode, otherWriteMode) +import qualified Data.ByteString.Char8 as S8 data SshConfig = GlobalConfig SshSetting @@ -135,7 +136,8 @@ changeUserSshConfig modifier = do sshdir <- sshDir let configfile = sshdir "config" whenM (doesFileExist configfile) $ do - c <- readFileStrict configfile + c <- decodeBS . S8.unlines . fileLines' + <$> F.readFile' (toOsPath (toRawFilePath configfile)) let c' = modifier c when (c /= c') $ do -- If it's a symlink, replace the file it diff --git a/doc/todo/RawFilePath_conversion.mdwn b/doc/todo/RawFilePath_conversion.mdwn index dd7ff4a843..6d08e95efd 100644 --- a/doc/todo/RawFilePath_conversion.mdwn +++ b/doc/todo/RawFilePath_conversion.mdwn @@ -18,11 +18,9 @@ status. mechanical, with only some wrapper functions in Utility.FileIO and Utility.RawFilePath needing to be changed. * Utility.FileIO is used for most withFile and openFile, but not yet for - readFile, writeFile, and appendFile (except most ones on bytestrings) - bytestring. Also readFileStrict should be replaced with - Utility.FileIO.readFile' - Note that the String versions can do newline translation, which has to be - handled when converting to the Utility.FileIO ones. + readFile, writeFile, and appendFile on FilePaths. + Note that the FilePath versions do newline translation on windows, + which has to be handled when converting to the Utility.FileIO ones. [[!tag confirmed]]