Làm thế nào để phân tích một tệp XML lớn trong Haskell với số lượng tài nguyên hạn chế?

Question

Tôi muốn trích xuất thông tin từ một tệp XML lớn (khoảng 20G) trong Haskell. Vì đây là một tệp lớn nên tôi đã sử dụng các chức năng phân tích cú pháp SAX từ Hexpath.

Đây là một mã đơn giản tôi thử nghiệm:

import qualified Data.ByteString.Lazy as L 
import Text.XML.Expat.SAX as Sax 

parse :: FilePath -> IO() 
parse path = do 
    inputText <- L.readFile path 
    let saxEvents = Sax.parse defaultParseOptions inputText :: [SAXEvent Text Text] 
    let txt = foldl' processEvent "" saxEvents 
    putStrLn txt 

Sau khi kích hoạt hồ sơ trong Cabal, nó nói rằng parse.saxEvents mất 85% bộ nhớ được phân bổ. Tôi cũng sử dụng foldr và kết quả là như nhau.

Nếu processEvent trở nên phức tạp, chương trình sẽ gặp lỗi stack space overflow.

Tôi đang làm gì sai?

Answer 1

Bạn không nói những gì processEvent là như thế nào. Về nguyên tắc, nó không phải là không có ý nghĩa để sử dụng lười biếng ByteString cho một lần trái nghiêm ngặt trên đầu ra tạo ra lazily, vì vậy tôi không chắc chắn những gì đang xảy ra trong trường hợp của bạn. Nhưng người ta phải sử dụng các loại thích hợp khi giao tiếp với các tệp khổng lồ!

Thực tế, hexpat không có giao diện 'phát trực tiếp' (giống như xml-conduit). Nó sử dụng thư viện List không nổi tiếng và the rather ugly List class it defines. Về nguyên tắc, ListT type từ gói Danh sách sẽ hoạt động tốt. Tôi đã từ bỏ một cách nhanh chóng vì thiếu các combinators, và đã viết một ví dụ thích hợp của các lớp học List xấu xí cho một phiên bản gói của Pipes.ListT mà sau đó tôi được sử dụng để xuất khẩu bình thường Pipes.Producer chức năng như parseProduce. Các thao tác tầm thường cần thiết cho việc này được thêm vào bên dưới là PipesSax.hs

Khi chúng tôi có parseProducer, chúng tôi có thể chuyển đổi một ByteString hoặc Nhà sản xuất văn bản thành Nhà sản xuất SaxEvents với các thành phần văn bản hoặc ByteString. Dưới đây là một số thao tác đơn giản. Tôi đã sử dụng 238M "input.xml"; các chương trình không bao giờ cần nhiều hơn 6 mb bộ nhớ, để đánh giá từ việc xem xét top.

-Sax.hs Hầu hết các hành động IO sử dụng một ống registerIds quy định tại đáy được thiết kế riêng cho một chút khổng lồ của xml trong đó đây là 1000 mảnh hợp lệ http://sprunge.us/WaQK

{-#LANGUAGE OverloadedStrings #-} 
import PipesSax (parseProducer) 
import Data.ByteString (ByteString) 
import Text.XML.Expat.SAX 
import Pipes -- cabal install pipes pipes-bytestring 
import Pipes.ByteString (toHandle, fromHandle, stdin, stdout) 
import qualified Pipes.Prelude as P 
import qualified System.IO as IO 
import qualified Data.ByteString.Char8 as Char8 

sax :: MonadIO m => Producer ByteString m() 
       -> Producer (SAXEvent ByteString ByteString) m() 
sax = parseProducer defaultParseOptions 

-- stream xml from stdin, yielding hexpat tagstream to stdout; 
main0 :: IO() 
main0 = runEffect $ sax stdin >-> P.print 

-- stream the extracted 'IDs' from stdin to stdout 
main1 :: IO() 
main1 = runEffect $ sax stdin >-> registryIds >-> stdout 

-- write all IDs to a file 
main2 = 
IO.withFile "input.xml" IO.ReadMode $ \inp -> 
IO.withFile "output.txt" IO.WriteMode $ \out -> 
    runEffect $ sax (fromHandle inp) >-> registryIds >-> toHandle out 

-- folds: 
-- print number of IDs 
main3 = IO.withFile "input.xml" IO.ReadMode $ \inp -> 
      do n <- P.length $ sax (fromHandle inp) >-> registryIds 
       print n 

-- sum the meaningful part of the IDs - a dumb fold for illustration 
main4 = IO.withFile "input.xml" IO.ReadMode $ \inp -> 
     do let pipeline = sax (fromHandle inp) >-> registryIds >-> P.map readIntId 
      n <- P.fold (+) 0 id pipeline 
      print n 
    where 
    readIntId :: ByteString -> Integer 
    readIntId = maybe 0 (fromIntegral.fst) . Char8.readInt . Char8.drop 2 

-- my xml has tags with attributes that appear via hexpat thus: 
-- StartElement "FacilitySite" [("registryId","110007915364")] 
-- and the like. This is just an arbitrary demo stream manipulation. 
registryIds :: Monad m => Pipe (SAXEvent ByteString ByteString) ByteString m() 
registryIds = do 
    e <- await -- we look for a 'SAXEvent' 
    case e of -- if it matches, we yield, else we go to the next event 
    StartElement "FacilitySite" [("registryId",a)] -> do yield a 
                 yield "\n" 
                 registryIds 
    _ -> registryIds 

- 'thư viện' : PipesSax.hs

Đây chỉ là newtypes Pipes.ListT để có được các phiên bản thích hợp. Chúng tôi không xuất bất cứ điều gì để làm với List hoặc ListT nhưng chỉ sử dụng khái niệm Pipes.Producer tiêu chuẩn.

{-#LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-} 
module PipesSax (parseProducerLocations, parseProducer) where 
import Data.ByteString (ByteString) 
import Text.XML.Expat.SAX 
import Data.List.Class 
import Control.Monad 
import Control.Applicative 
import Pipes 
import qualified Pipes.Internal as I 

parseProducer 
    :: (Monad m, GenericXMLString tag, GenericXMLString text) 
    => ParseOptions tag text 
    -> Producer ByteString m() 
    -> Producer (SAXEvent tag text) m() 
parseProducer opt = enumerate . enumerate_ 
        . parseG opt 
        . Select_ . Select 

parseProducerLocations 
    :: (Monad m, GenericXMLString tag, GenericXMLString text) 
    => ParseOptions tag text 
    -> Producer ByteString m() 
    -> Producer (SAXEvent tag text, XMLParseLocation) m() 
parseProducerLocations opt = 
    enumerate . enumerate_ . parseLocationsG opt . Select_ . Select 

newtype ListT_ m a = Select_ { enumerate_ :: ListT m a } 
    deriving (Functor, Monad, MonadPlus, MonadIO 
      , Applicative, Alternative, Monoid, MonadTrans) 

instance Monad m => List (ListT_ m) where 
type ItemM (ListT_ m) = m 
joinL = Select_ . Select . I.M . liftM (enumerate . enumerate_) 
runList = liftM emend . next . enumerate . enumerate_ 
    where 
    emend (Right (a,q)) = Cons a (Select_ (Select q)) 
    emend _ = Nil