diff --git a/src/Subversion/Dump.hs b/src/Subversion/Dump.hs --- a/src/Subversion/Dump.hs +++ b/src/Subversion/Dump.hs @@ -64,7 +64,7 @@ data Operation = Operation { opKind :: OpKind , opAction :: OpAction , opPathname :: FilePath - , opContents :: ByteString + , opContents :: BL.ByteString , opContentLength :: Int , opChecksumMD5 :: Maybe Text , opChecksumSHA1 :: Maybe Text diff --git a/src/Subversion/Dump/Raw.hs b/src/Subversion/Dump/Raw.hs --- a/src/Subversion/Dump/Raw.hs +++ b/src/Subversion/Dump/Raw.hs @@ -27,29 +27,30 @@ data Entry = Entry { entryTags :: FieldMap , entryProps :: FieldMap - , entryBody :: ByteString } + , entryBody :: BL.ByteString } deriving Show readSvnDumpRaw :: BL.ByteString -> [Entry] readSvnDumpRaw dump = case parse parseHeader dump of - Fail _ _ _ -> error "Stream is not a Subversion dump file" + Fail {} -> error "Stream is not a Subversion dump file" Done contents _ -> parseDumpFile contents parseDumpFile :: BL.ByteString -> [Entry] -parseDumpFile contents = do +parseDumpFile contents = case parse parseEntry contents of - Fail _ _ _ -> [] - Done contents' entry -> do - entry : parseDumpFile contents' + Fail {} -> [] + Done contents' (entry, bodyLen) -> + entry { entryBody = BL.take (fromIntegral bodyLen) contents' } + : parseDumpFile (BL.drop (fromIntegral bodyLen) contents') -- These are the Parsec parsers for the various parts of the input file. space :: Parser Word8 -space = satisfy (== 32) +space = word8 32 newline :: Parser Word8 -newline = satisfy (== 10) +newline = word8 10 parseTag :: Parser (ByteString, ByteString) parseTag = @@ -75,27 +76,22 @@ parseProperty = (,) <$> parseSpecValue -- K <*> parseSpecValue -- V -readInt :: ByteString -> Int -readInt bs = B.foldl' addup 0 bs - where addup acc x = acc * 10 + (fromIntegral x - 48) -- '0' - -parseEntry :: Parser Entry +parseEntry :: Parser (Entry, Int) parseEntry = do - fields <- many1 parseTag <* newline - - props <- case L.lookup "Prop-content-length" fields of - Nothing -> return [] - Just _ -> manyTill parseProperty (try (string "PROPS-END\n")) - - body <- case L.lookup "Text-content-length" fields of - Nothing -> return B.empty - Just len -> AL.take (readInt len) + fields <- AL.takeWhile (== 10) *> many1 parseTag <* newline + props <- case L.lookup "Prop-content-length" fields of + Nothing -> return [] + Just _ -> manyTill parseProperty (try (string "PROPS-END\n")) - _ <- AL.takeWhile (== 10) + -- Don't read the body here in AttoParsec, let the caller extract it from + -- the ByteString (which might be lazy, saving us from strictifying it in + -- AttoParsec). + let bodyLen = fromMaybe 0 (readInt <$> L.lookup "Text-content-length" fields) - return Entry { entryTags = fields - , entryProps = props - , entryBody = body } + return ( Entry { entryTags = fields + , entryProps = props + , entryBody = BL.empty } + , bodyLen ) parseHeader :: Parser ByteString parseHeader = do @@ -106,5 +102,14 @@ where -- Accept any hexadecimal character, or '-' uuidMember w = w == 45 || (w >= 48 && w <= 57) || (w >= 97 && w <= 102) + +-- | Efficiently convert a ByteString of integers into an Int. +-- +-- >>> readInt (Data.ByteString.Char8.pack "12345") +-- 12345 + +readInt :: ByteString -> Int +readInt = B.foldl' addup 0 + where addup acc x = acc * 10 + (fromIntegral x - 48) -- '0' -- SvnDump.hs ends here diff --git a/svndump.cabal b/svndump.cabal --- a/svndump.cabal +++ b/svndump.cabal @@ -1,6 +1,6 @@ name: svndump category: Subversion -version: 0.3.0 +version: 0.4.0 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE @@ -45,6 +45,18 @@ ghc-options: -Wall -fwarn-tabs -O2 hs-source-dirs: src +-- Verify the results of the examples +test-suite doctests + type: exitcode-stdio-1.0 + main-is: doctests.hs + build-depends: + base == 4.*, + directory >= 1.0 && < 1.2, + doctest >= 0.8 && <= 0.9, + filepath >= 1.3 && < 1.4 + ghc-options: -Wall -Werror + hs-source-dirs: test + -- Test the raw dump file parser test-suite test-raw type: exitcode-stdio-1.0 @@ -57,7 +69,7 @@ zlib >= 0.5 && < 0.6, svndump - ghc-options: -Wall -Werror -O2 + ghc-options: -Wall -Werror hs-source-dirs: test -- Test the raw dump file parser @@ -71,5 +83,5 @@ zlib >= 0.5 && < 0.6, svndump - ghc-options: -Wall -Werror -O2 + ghc-options: -Wall -Werror hs-source-dirs: test diff --git a/test/doctests.hs b/test/doctests.hs new file mode 100644 --- /dev/null +++ b/test/doctests.hs @@ -0,0 +1,29 @@ +module Main where + +import Test.DocTest +import System.Directory +import System.FilePath +import Control.Applicative +import Control.Monad +import Data.List + +main :: IO () +main = getSources >>= \sources -> doctest $ + "-isrc" + : "-idist/build/autogen" + : "-optP-include" + : "-optPdist/build/autogen/cabal_macros.h" + : sources + +getSources :: IO [FilePath] +getSources = filter (isSuffixOf ".hs") <$> go "src" + where + go dir = do + (dirs, files) <- getFilesAndDirectories dir + (files ++) . concat <$> mapM go dirs + +getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) +getFilesAndDirectories dir = do + c <- map (dir ) . filter (`notElem` ["..", "."]) + <$> getDirectoryContents dir + (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c diff --git a/test/test-raw.hs b/test/test-raw.hs --- a/test/test-raw.hs +++ b/test/test-raw.hs @@ -4,14 +4,22 @@ import qualified Data.ByteString.Lazy as B import Subversion.Dump.Raw import System.Exit +import System.Environment main :: IO () main = do - file <- B.readFile "data/cunit.dump.gz" - let len = length $ readSvnDumpRaw (GZip.decompress file) - putStrLn $ show len ++ " raw entries found, expecting 1950" - if len == 1950 - then exitSuccess - else exitFailure + args <- getArgs + case args of + [] -> do + file <- B.readFile "data/cunit.dump.gz" + let len = length $ readSvnDumpRaw (GZip.decompress file) + putStrLn $ show len ++ " raw entries found, expecting 1950" + if len == 1950 + then exitSuccess + else exitFailure + + (fileName:_) -> do + contents <- B.readFile fileName + print $ length $ readSvnDumpRaw contents -- test-raw.hs ends here