strict bytestring encoders and decoders

Only had lazy ones before.

Already sped up a few parts of the code.

Annex/Branch.hs

@@ -243,7 +243,7 @@ getHistorical date file =
 		)
 
 getRef :: Ref -> FilePath -> Annex String
-getRef ref file = withIndex $ decodeBS <$> catFile ref file
+getRef ref file = withIndex $ decodeBL <$> catFile ref file
 
 {- Applies a function to modify the content of a file.
  -
@@ -320,7 +320,7 @@ commitIndex' jl branchref message basemessage retrynum parents = do
   where
 	-- look for "parent ref" lines and return the refs
 	commitparents = map (Git.Ref . snd) . filter isparent .
-		map (toassoc . decodeBS) . L.split newline
+		map (toassoc . decodeBL) . L.split newline
 	newline = fromIntegral (ord '\n')
 	toassoc = separate (== ' ')
 	isparent (k,_) = k == "parent"
@@ -522,7 +522,7 @@ handleTransitions jl localts refs = do
 			return True
   where
 	getreftransition ref = do
-		ts <- parseTransitionsStrictly "remote" . decodeBS
+		ts <- parseTransitionsStrictly "remote" . decodeBL
 			<$> catFile ref transitionsLog
 		return (ref, ts)
 
@@ -595,7 +595,7 @@ performTransitionsLocked jl ts neednewlocalbranch transitionedrefs = do
 
 checkBranchDifferences :: Git.Ref -> Annex ()
 checkBranchDifferences ref = do
-	theirdiffs <- allDifferences . parseDifferencesLog . decodeBS
+	theirdiffs <- allDifferences . parseDifferencesLog . decodeBL
 		<$> catFile ref differenceLog
 	mydiffs <- annexDifferences <$> Annex.getGitConfig
 	when (theirdiffs /= mydiffs) $

Annex/CatFile.hs

@@ -111,7 +111,7 @@ catKey ref = go =<< catObjectMetaData ref
 
 {- Gets a symlink target. -}
 catSymLinkTarget :: Sha -> Annex String
-catSymLinkTarget sha = fromInternalGitPath . decodeBS <$> get
+catSymLinkTarget sha = fromInternalGitPath . decodeBL <$> get
   where
 	-- Avoid buffering the whole file content, which might be large.
 	-- 8192 is enough if it really is a symlink.

Annex/DirHashes.hs

@@ -67,14 +67,14 @@ hashDirs _ sz s = addTrailingPathSeparator $ take sz s </> drop sz s
 
 hashDirLower :: HashLevels -> Hasher
 hashDirLower n k = hashDirs n 3 $ take 6 $ show $ md5 $
-	encodeBS $ key2file $ nonChunkKey k
+	encodeBL $ key2file $ nonChunkKey k
 
 {- This was originally using Data.Hash.MD5 from MissingH. This new version
 - is faster, but ugly as it has to replicate the 4 Word32's that produced. -}
 hashDirMixed :: HashLevels -> Hasher
 hashDirMixed n k = hashDirs n 2 $ take 4 $ concatMap display_32bits_as_dir $
 	encodeWord32 $ map fromIntegral $ Data.ByteArray.unpack $
-		Utility.Hash.md5 $ encodeBS $ key2file $ nonChunkKey k
+		Utility.Hash.md5 $ encodeBL $ key2file $ nonChunkKey k
   where
 	encodeWord32 (b1:b2:b3:b4:rest) =
 		(shiftL b4 24 .|. shiftL b3 16 .|. shiftL b2 8 .|. b1)

Annex/Link.hs

@@ -228,7 +228,7 @@ unableToRestage mf = unwords
  - lines. -}
 parseLinkOrPointer :: L.ByteString -> Maybe Key
 parseLinkOrPointer = parseLinkOrPointer' 
-	. decodeBS . L.take (fromIntegral maxPointerSz)
+	. decodeBL . L.take (fromIntegral maxPointerSz)
   where
 
 {- Want to avoid buffering really big files in git into

Annex/Ssh.hs

@@ -300,7 +300,7 @@ hostport2socket host (Just port) = hostport2socket' $
 	fromSshHost host ++ "!" ++ show port
 hostport2socket' :: String -> FilePath
 hostport2socket' s
-	| length s > lengthofmd5s = show $ md5 $ encodeBS s
+	| length s > lengthofmd5s = show $ md5 $ encodeBL s
 	| otherwise = s
   where
 	lengthofmd5s = 32

Annex/VariantFile.hs

@@ -41,4 +41,4 @@ variantFile file key
 	doubleconflict = variantMarker `isInfixOf` file
 
 shortHash :: String -> String
-shortHash = take 4 . show . md5 . encodeBS
+shortHash = take 4 . show . md5 . encodeBL

Backend/Utilities.hs

@@ -20,7 +20,7 @@ genKeyName s
 	-- Avoid making keys longer than the length of a SHA256 checksum.
 	| bytelen > sha256len =
 		truncateFilePath (sha256len - md5len - 1) s' ++ "-" ++ 
-			show (md5 (encodeBS s))
+			show (md5 (encodeBL s))
 	| otherwise = s'
   where
 	s' = preSanitizeKeyName s

Git/CatFile.hs

@@ -207,7 +207,7 @@ catTree h treeref = go <$> catObjectDetails h treeref
 	dropsha = L.drop 21
 
 	parsemodefile b = 
-		let (modestr, file) = separate (== ' ') (decodeBS b)
+		let (modestr, file) = separate (== ' ') (decodeBL b)
 		in (file, readmode modestr)
 	readmode = fromMaybe 0 . fmap fst . headMaybe . readOct
 

Remote/BitTorrent.hs

@@ -350,7 +350,7 @@ btshowmetainfo torrent field =
 torrentFileSizes :: FilePath -> IO [(FilePath, Integer)]
 torrentFileSizes torrent = do
 #ifdef WITH_TORRENTPARSER
-	let mkfile = joinPath . map (scrub . decodeBS)
+	let mkfile = joinPath . map (scrub . decodeBL)
 	b <- B.readFile torrent
 	return $ case readTorrent b of
 		Left e -> giveup $ "failed to parse torrent: " ++ e

Test.hs

@@ -1704,7 +1704,7 @@ test_add_subdirs = intmpclonerepo $ do
 	 - calculated correctly for files in subdirs. -}
 	unlessM (unlockedFiles <$> getTestMode) $ do
 		git_annex "sync" [] @? "sync failed"
-		l <- annexeval $ Utility.FileSystemEncoding.decodeBS
+		l <- annexeval $ Utility.FileSystemEncoding.decodeBL
 			<$> Annex.CatFile.catObject (Git.Types.Ref "HEAD:dir/foo")
 		"../.git/annex/" `isPrefixOf` l @? ("symlink from subdir to .git/annex is wrong: " ++ l)
 

Utility/Aeson.hs

@@ -22,7 +22,6 @@ import qualified Data.Aeson
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString as S
 import qualified Data.Set
 import qualified Data.Vector
 import Prelude
@@ -53,7 +52,7 @@ instance ToJSON' String where
 -- Note that if the string contains invalid UTF8 characters not using
 -- the FileSystemEncoding, this is the same as Data.Text.pack.
 packString :: String -> T.Text
-packString s = case T.decodeUtf8' (S.concat $ L.toChunks $ encodeBS s) of
+packString s = case T.decodeUtf8' (encodeBS s) of
 	Right t -> t
 	Left _ -> T.pack s
 

Utility/Base64.hs

@@ -19,10 +19,10 @@ import Data.ByteString.UTF8 (fromString, toString)
 import Data.Char
 
 toB64 :: String -> String	
-toB64 = toString . B64.encode . L.toStrict . encodeBS
+toB64 = toString . B64.encode . encodeBS
 
 fromB64Maybe :: String -> Maybe String
-fromB64Maybe s = either (const Nothing) (Just . decodeBS . L.fromStrict)
+fromB64Maybe s = either (const Nothing) (Just . decodeBL . L.fromStrict)
 	(B64.decode $ fromString s)
 
 fromB64 :: String -> String

Utility/FileSystemEncoding.hs

@@ -15,7 +15,9 @@ module Utility.FileSystemEncoding (
 	RawFilePath,
 	fromRawFilePath,
 	toRawFilePath,
+	decodeBL,
 	decodeBS,
+	encodeBL,
 	encodeBS,
 	decodeW8,
 	encodeW8,
@@ -38,6 +40,7 @@ import Data.List
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 #ifdef mingw32_HOST_OS
+import qualified Data.ByteString.UTF8 as S8
 import qualified Data.ByteString.Lazy.UTF8 as L8
 #endif
 
@@ -107,21 +110,35 @@ _encodeFilePath fp = unsafePerformIO $ do
 		`catchNonAsync` (\_ -> return fp)
 
 {- Decodes a ByteString into a FilePath, applying the filesystem encoding. -}
-decodeBS :: L.ByteString -> FilePath
+decodeBL :: L.ByteString -> FilePath
 #ifndef mingw32_HOST_OS
-decodeBS = encodeW8NUL . L.unpack
+decodeBL = encodeW8NUL . L.unpack
 #else
 {- On Windows, we assume that the ByteString is utf-8, since Windows
  - only uses unicode for filenames. -}
-decodeBS = L8.toString
+decodeBL = L8.toString
+#endif
+
+decodeBS :: S.ByteString -> FilePath
+#ifndef mingw32_HOST_OS
+decodeBS = encodeW8NUL . S.unpack
+#else
+decodeBS = S8.toString
 #endif
 
 {- Encodes a FilePath into a ByteString, applying the filesystem encoding. -}
-encodeBS :: FilePath -> L.ByteString
+encodeBL :: FilePath -> L.ByteString
 #ifndef mingw32_HOST_OS
-encodeBS = L.pack . decodeW8NUL
+encodeBL = L.pack . decodeW8NUL
 #else
-encodeBS = L8.fromString
+encodeBL = L8.fromString
+#endif
+
+encodeBS :: FilePath -> S.ByteString
+#ifndef mingw32_HOST_OS
+encodeBS = S.pack . decodeW8NUL
+#else
+encodeBS = S8.fromString
 #endif
 
 {- Recent versions of the unix package have this alias; defined here

Utility/LockFile/PidLock.hs

@@ -102,7 +102,7 @@ sideLockFile lockfile = do
 	let shortbase = reverse $ take 32 $ reverse base
 	let md5sum = if base == shortbase
 		then ""
-		else show (md5 (encodeBS base))
+		else show (md5 (encodeBL base))
 	dir <- ifM (doesDirectoryExist "/dev/shm")
 		( return "/dev/shm"
 		, return "/tmp"