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

@@ -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)
+	let content' = map encodeBS content
-	when (curr /= content) $ do
+	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 ()

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

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 $

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
 			)
 

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)
+						fmap decodeBS 
-							<$> readFileStrict tmp'
+							. headMaybe 
+							. fileLines'
+							<$> F.readFile' tmp
 	| otherwise = return Nothing
   where
 	lcurl = map toLower url

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 :: [String] -> Maybe PairData
-deserializePairData s = case lines s of
+deserializePairData [] = Nothing
-	[] -> Nothing
+deserializePairData (ha:l) = do
-	(ha:l) -> do
+	addrs <- mapM unformatP2PAddress l
-		addrs <- mapM unformatP2PAddress l
+	return (PairData (HalfAuthToken (T.pack ha)) addrs)
-		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.

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 :: Cfg -> [String] -> Either String Cfg
-parseCfg defcfg = go [] defcfg . lines
+parseCfg defcfg = go [] defcfg
   where
 	go c cfg []
 		| null (mapMaybe fst c) = Right cfg

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 =

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.Lazy.Char8 as L8
-import qualified Data.ByteString.Char8 as S
+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)
+			(feedBytes $ L8.fromStrict $ fromB64 enccreds)
-			(readBytesStrictly $ return . S.unpack)
+			(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

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)

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
+	(firstliner, otherlines) = separate (== '\n') s
-	(secondline, rest) = separate (== '\n') otherlines
+	(secondliner, rest) = separate (== '\n') otherlines
+	firstline = dropWhileEnd (== '\r') firstliner
+	secondline = dropWhileEnd (== '\r') secondliner
+	secondline = 
 	mpid' = readish secondline
 #else
 	(firstline, rest) = separate (== '\n') s

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)
+	f <- fromRepo (gitAnnexUnusedLog prefix)
-	ifM (liftIO $ doesFileExist f)
+	ifM (liftIO $ doesFileExist (fromRawFilePath f))
-		( M.fromList . mapMaybe parse . lines
+		( M.fromList . mapMaybe (parse . decodeBS) . fileLines'
-			<$> liftIO (readFileStrict f)
+			<$> liftIO (F.readFile' (toOsPath f))
 		, return M.empty
 		)
   where

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
+	logfile <- fromRepo gitAnnexUpgradeLog
-	ifM (liftIO $ doesFileExist logfile)
+	ifM (liftIO $ doesFileExist (fromRawFilePath logfile))
-		( mapMaybe parse . lines
+		( mapMaybe (parse . decodeBS) . fileLines'
-			<$> liftIO (readFileStrict logfile)
+			<$> liftIO (F.readFile' (toOsPath logfile))
 		, return []
 		)
   where

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 :: [String] -> Maybe GitAnnexDistribution
-parseInfoFile s = case lines s of
+parseInfoFile (_oldformat:rest) = parseGitAnnexDistribution (unlines rest)
-	(_oldformat:rest) -> parseGitAnnexDistribution (unlines rest)
+parseInfoFile _ = Nothing
-	_ -> Nothing
 
 formatGitAnnexDistribution :: GitAnnexDistribution -> String
 formatGitAnnexDistribution d = unlines

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

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
+		mapMaybe (readInodeCache . decodeBS) . fileLines'
-			<$> readFileStrict (fromRawFilePath f)
+			<$> F.readFile' (toOsPath f)
 
 {- Removes an inode cache. -}
 removeInodeCache :: Key -> Annex ()

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.
  -

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

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)
+  readFile, writeFile, and appendFile on FilePaths.
-  bytestring. Also readFileStrict should be replaced with 
+  Note that the FilePath versions do newline translation on windows, 
-  Utility.FileIO.readFile'
+  which has to be handled when converting to the Utility.FileIO ones.
-  Note that the String versions can do newline translation, which has to be
-  handled when converting to the Utility.FileIO ones.
 
 [[!tag confirmed]]