diff --git a/src/Subversion/Dump.hs b/src/Subversion/Dump.hs --- a/src/Subversion/Dump.hs +++ b/src/Subversion/Dump.hs @@ -13,23 +13,29 @@ , readSvnDump , readSvnDumpRaw + + , parseHeader + , parseEntry ) where -import Control.Applicative hiding (many, (<|>)) +import Control.Applicative hiding (many) import Control.Monad -import qualified Data.ByteString.Lazy as B ---import qualified Data.ByteString.Lazy.Char8 as BC +import qualified Data.Attoparsec.Char8 as AC +import Data.Attoparsec.Combinator +import Data.Attoparsec.Lazy as AL +import Data.ByteString as B hiding (map) +import qualified Data.ByteString.Char8 as BC hiding (map) +import qualified Data.ByteString.Lazy as BL hiding (map) import qualified Data.List as L +import Data.Text (Text) +import qualified Data.Text.Encoding as E import Data.Maybe -import Data.Text.Lazy hiding (map, count) -import Data.Text.Lazy.Encoding as E +import Data.Word (Word8) import System.FilePath -import Text.Parsec -import Text.Parsec.ByteString.Lazy as PB import Prelude hiding (getContents) -default (Data.Text.Lazy.Text) +default (ByteString) -- | A parser for Subversion dump files. The objective is to convert a dump -- file into a series of data structures representing that same information. @@ -69,10 +75,10 @@ data Operation = Operation { opKind :: OpKind , opAction :: OpAction , opPathname :: FilePath - , opContents :: B.ByteString + , opContents :: ByteString , opContentLength :: Int - , opChecksumMD5 :: Maybe String - , opChecksumSHA1 :: Maybe String + , opChecksumMD5 :: Maybe Text + , opChecksumSHA1 :: Maybe Text , opCopyFromRev :: Maybe Int , opCopyFromPath :: Maybe FilePath } deriving Show @@ -93,10 +99,11 @@ -- | Reads a dump file from a ByteString in the IO monad into a list of -- Revision values. This is the "cooked" parallel of 'readSvnDumpRaw'. -readSvnDump :: B.ByteString -> IO (Either ParseError [Revision]) +readSvnDump :: BL.ByteString -> Either String [Revision] readSvnDump io = do - result <- readSvnDumpRaw io - return $ map processRevs <$> (L.groupBy sameRev <$> result) + case readSvnDumpRaw io of + Fail _ _ y -> Left y + Done _ result -> Right $ map processRevs (L.groupBy sameRev result) where sameRev _ y = isNothing $ L.lookup "Revision-number" (entryTags y) @@ -110,24 +117,24 @@ processRevs [] = error "Unexpected" processRevs (rev:ops) = Revision { - revNumber = read $ tag "Revision-number" rev + revNumber = readInt $ tag "Revision-number" rev , revDate = parseDate $ prop "svn:date" rev - , revAuthor = propM "svn:author" rev - , revComment = propM "svn:log" rev + , revAuthor = E.decodeUtf8 <$> propM "svn:author" rev + , revComment = E.decodeUtf8 <$> propM "svn:log" rev , revOperations = map processOp ops } processOp op = Operation { opKind = getOpKind $ tag "Node-kind" op , opAction = getOpAction $ tag "Node-action" op - , opPathname = tag "Node-path" op + , opPathname = BC.unpack $ tag "Node-path" op , opContents = entryBody op - , opContentLength = read $ tag "Text-content-length" op - , opCopyFromRev = read <$> + , opContentLength = readInt $ tag "Text-content-length" op + , opCopyFromRev = readInt <$> tagM "Node-copyfrom-rev" op - , opCopyFromPath = tagM "Node-copyfrom-path" op - , opChecksumMD5 = tagM "Text-content-md5" op - , opChecksumSHA1 = tagM "Text-content-sha1" op } + , opCopyFromPath = BC.unpack <$> tagM "Node-copyfrom-path" op + , opChecksumMD5 = E.decodeUtf8 <$> tagM "Text-content-md5" op + , opChecksumSHA1 = E.decodeUtf8 <$> tagM "Text-content-sha1" op } getOpKind kind = case kind of "file" -> File @@ -141,83 +148,84 @@ "replace" -> Replace _ -> error "Unexpected" -type FieldMap a = [(String, a)] +type FieldMap = [(ByteString, ByteString)] -data Entry = Entry { entryTags :: FieldMap String - , entryProps :: FieldMap Text - , entryBody :: B.ByteString } - deriving Show +data Entry = Entry { entryTags :: FieldMap + , entryProps :: FieldMap + , entryBody :: ByteString } + deriving Show -readSvnDumpRaw :: B.ByteString -> IO (Either ParseError [Entry]) -readSvnDumpRaw dump = return $ parse parseSvnDump "" dump +readSvnDumpRaw :: BL.ByteString -> Result [Entry] +readSvnDumpRaw dump = parse parseSvnDump dump -- These are the Parsec parsers for the various parts of the input file. -parseTag :: PB.Parser (String, String) -parseTag = (,) <$> fieldKey <* char ':' <* space - <*> fieldValue <* newline - where - fieldKey = (:) <$> letter <*> many fieldChar - fieldChar = letter <|> digit <|> oneOf "-_" - fieldValue = many1 (noneOf "\n") +space :: Parser Word8 +space = satisfy (== 32) -parseIndicator :: PB.Parser (Char, Integer) -parseIndicator = (,) <$> oneOf "KV" <* space - <*> (read <$> many1 digit <* newline) +newline :: Parser Word8 +newline = satisfy (== 10) -readTextRange :: Integer -> PB.Parser B.ByteString -readTextRange len = do - input <- getInput - let value = B.take (fromIntegral len) input - setInput $ B.drop (fromIntegral len) input - return value +parseTag :: Parser (ByteString, ByteString) +parseTag = + (,) <$> takeWhile1 fieldChar <* string ": " -- : + <*> takeWhile1 (/= 10) <* newline + where fieldChar w = (w >= 65 && w <= 90) -- A-Z + || (w >= 97 && w <= 121) -- a-z + || (w >= 48 && w <= 57) -- 0-9 + || w == 45 -- - + || w == 95 -- _ ---readTextRange' :: Integer -> PB.Parser B.ByteString ---readTextRange' len = BC.pack <$> count (fromIntegral len) anyChar +parseIndicator :: Parser (Word8, Int) +parseIndicator = (,) <$> satisfy (oneOf 75 86) <* space -- K or V + <*> AC.decimal <* newline + where oneOf x y w = w == x || w == y -parseSpecValue :: Char -> PB.Parser Text -parseSpecValue expected = do - (kind, len) <- parseIndicator - when (kind /= expected) $ unexpected "Unexpected spec value char" - value <- readTextRange len - --trace ("Value: " ++ (show value)) $ return () - _ <- newline - return $ E.decodeUtf8 value +parseSpecValue :: Parser ByteString +parseSpecValue = do + (_, len) <- parseIndicator + AL.take len <* newline -parseProperty :: PB.Parser (String, Text) -parseProperty = (,) <$> (unpack <$> parseSpecValue 'K') - <*> parseSpecValue 'V' +parseProperty :: Parser (ByteString, ByteString) +parseProperty = (,) <$> parseSpecValue -- K + <*> parseSpecValue -- V -parseEntry :: PB.Parser Entry +readInt :: ByteString -> Int +readInt bs = B.foldl' addup 0 bs + where addup acc x = acc * 10 + (fromIntegral x - 48) -- '0' + +parseEntry :: Parser Entry parseEntry = do fields <- many1 parseTag <* newline props <- case L.lookup "Prop-content-length" fields of Nothing -> return [] - Just _ -> many parseProperty <* string "PROPS-END\n" + Just _ -> manyTill parseProperty (try (string "PROPS-END\n")) body <- case L.lookup "Text-content-length" fields of Nothing -> return B.empty - Just len -> readTextRange (read len) + Just len -> AL.take (readInt len) - _ <- many newline "entry-terminating newline" + _ <- AL.takeWhile (== 10) return Entry { entryTags = fields , entryProps = props , entryBody = body } -parseHeader :: PB.Parser () +parseHeader :: Parser ByteString parseHeader = do _ <- string "SVN-fs-dump-format-version: 2\n\n" "Dump file starts without a recognizable tag" - _ <- string "UUID: " <* many1 (hexDigit <|> char '-') - <* newline <* newline - return () + string "UUID: " *> takeWhile1 uuidMember + <* newline <* newline + where + -- Accept any hexadecimal character, or '-' + uuidMember w = w == 45 || (w >= 48 && w <= 57) || (w >= 97 && w <= 102) -parseSvnDump :: PB.Parser [Entry] -parseSvnDump = parseHeader >> many parseEntry +parseSvnDump :: Parser [Entry] +parseSvnDump = parseHeader >> many1 parseEntry -parseDate :: Text -> RevDate -parseDate = id +parseDate :: ByteString -> RevDate +parseDate = E.decodeUtf8 -- 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.1.1 +version: 0.2.0 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE @@ -31,9 +31,10 @@ library build-depends: base >= 4.3 && < 5, - parsec >= 3.1.3, + attoparsec >= 0.10.2, filepath >= 1.3, bytestring >= 0.9 && < 0.10, + containers >= 0.4.2, text >= 0.11 && < 0.12 exposed-modules: @@ -50,6 +51,7 @@ build-depends: base >= 4.3 && < 5, + attoparsec >= 0.10.2, bytestring >= 0.9 && < 0.10, zlib >= 0.5 && < 0.6, svndump diff --git a/test/test-cooked.hs b/test/test-cooked.hs --- a/test/test-cooked.hs +++ b/test/test-cooked.hs @@ -8,8 +8,7 @@ main :: IO () main = do file <- B.readFile "data/cunit.dump.gz" - dump <- readSvnDump $ GZip.decompress file - case dump of + case readSvnDump (GZip.decompress file) of Left _ -> exitFailure Right xs -> do let len = length xs @@ -18,4 +17,4 @@ then exitSuccess else exitFailure --- raw-parser.hs ends here +-- test-cooked.hs ends here diff --git a/test/test-raw.hs b/test/test-raw.hs --- a/test/test-raw.hs +++ b/test/test-raw.hs @@ -1,6 +1,7 @@ module Main where import qualified Codec.Compression.GZip as GZip +import Data.Attoparsec.Lazy import qualified Data.ByteString.Lazy as B import Subversion.Dump import System.Exit @@ -8,14 +9,13 @@ main :: IO () main = do file <- B.readFile "data/cunit.dump.gz" - dump <- readSvnDumpRaw $ GZip.decompress file - case dump of - Left _ -> exitFailure - Right xs -> do + case readSvnDumpRaw (GZip.decompress file) of + Fail _ _ _ -> exitFailure + Done _ xs -> do let len = length xs putStrLn $ show len ++ " raw entries found, expecting 1950" if len == 1950 then exitSuccess else exitFailure --- raw-parser.hs ends here +-- test-raw.hs ends here