Permalink
Browse files

Store local build tree references as 32-bit character strings.

  • Loading branch information...
1 parent e800b3d commit a60f43921f9b429f5df89f8efc737994d63f7fe8 @23Skidoo 23Skidoo committed Jun 23, 2012
Showing with 46 additions and 5 deletions.
  1. +4 −5 cabal-install/Distribution/Client/Index.hs
  2. +42 −0 cabal-install/Distribution/Client/Utils.hs
View
9 cabal-install/Distribution/Client/Index.hs
@@ -14,14 +14,14 @@ module Distribution.Client.Index (index)
import qualified Distribution.Client.Tar as Tar
import Distribution.Client.Setup ( IndexFlags(..) )
-import Distribution.Client.Utils ( makeAbsoluteToCwd )
+import Distribution.Client.Utils ( byteStringToFilePath, filePathToByteString
+ , makeAbsoluteToCwd )
import Distribution.Simple.Setup ( fromFlagOrDefault )
import Distribution.Simple.Utils ( die, debug, notice )
import Distribution.Verbosity ( Verbosity )
import qualified Data.ByteString.Lazy as BS
-import qualified Data.ByteString.Lazy.Char8 as BS.Char8
import Control.Monad ( liftM, when, unless )
import Data.List ( (\\), nub )
import Data.Maybe ( catMaybes )
@@ -60,7 +60,7 @@ readLocalBuildTree :: Tar.Entry -> Maybe FilePath
readLocalBuildTree entry = case Tar.entryContent entry of
(Tar.OtherEntryType typeCode bs size)
| (typeCode == localBuildTreeTypeCode)
- && (size == BS.length bs) -> Just $ BS.Char8.unpack bs
+ && (size == BS.length bs) -> Just $ byteStringToFilePath bs
| otherwise -> Nothing
_ -> Nothing
@@ -77,8 +77,7 @@ readLocalBuildTreesFromFile = liftM (readLocalBuildTrees . Tar.read)
writeLocalBuildTree :: LocalBuildTree -> Tar.Entry
writeLocalBuildTree lbt = Tar.simpleEntry tarPath content
where
- -- TODO: Use utf8-string or text here.
- bs = BS.Char8.pack path
+ bs = filePathToByteString path
path = localBuildTreePath lbt
-- fromRight can't fail because the path is shorter than 255 characters.
tarPath = fromRight $ Tar.toTarPath True tarPath'
View
42 cabal-install/Distribution/Client/Utils.hs
@@ -1,7 +1,14 @@
module Distribution.Client.Utils where
+import qualified Data.ByteString.Lazy as BS
+import Data.Bits
+ ( (.|.), shiftL, shiftR )
+import Data.Char
+ ( ord, chr )
import Data.List
( sortBy, groupBy )
+import Data.Word
+ ( Word8, Word32)
import System.Directory
( doesFileExist, getModificationTime
, getCurrentDirectory, setCurrentDirectory )
@@ -67,3 +74,38 @@ makeAbsoluteToCwd :: FilePath -> IO FilePath
makeAbsoluteToCwd path | isAbsolute path = return path
| otherwise = do cwd <- getCurrentDirectory
return $! cwd </> path
+
+-- | Convert a 'FilePath' to a lazy 'ByteString'. Each 'Char' is
+-- encoded as a little-endian 'Word32'.
+filePathToByteString :: FilePath -> BS.ByteString
+filePathToByteString p =
+ BS.pack $ foldr conv [] codepts
+ where
+ codepts :: [Word32]
+ codepts = map (fromIntegral . ord) p
+
+ conv :: Word32 -> [Word8] -> [Word8]
+ conv w32 rest = b0:b1:b2:b3:rest
+ where
+ b0 = fromIntegral $ w32
+ b1 = fromIntegral $ w32 `shiftR` 8
+ b2 = fromIntegral $ w32 `shiftR` 16
+ b3 = fromIntegral $ w32 `shiftR` 24
+
+-- | Reverse operation to 'filePathToByteString'.
+byteStringToFilePath :: BS.ByteString -> FilePath
+byteStringToFilePath bs | bslen `mod` 4 /= 0 = unexpected
+ | otherwise = go 0
+ where
+ unexpected = "Distribution.Client.Utils.byteStringToFilePath: unexpected"
+ bslen = BS.length bs
+
+ go i | i == bslen = []
+ | otherwise = (chr . fromIntegral $ w32) : go (i+4)
+ where
+ w32 :: Word32
+ w32 = b0 .|. (b1 `shiftL` 8) .|. (b2 `shiftL` 16) .|. (b3 `shiftL` 24)
+ b0 = fromIntegral $ BS.index bs i
+ b1 = fromIntegral $ BS.index bs (i + 1)
+ b2 = fromIntegral $ BS.index bs (i + 2)
+ b3 = fromIntegral $ BS.index bs (i + 3)

0 comments on commit a60f439

Please sign in to comment.