Minor update, here's how I would handle this problem (using uu-parsinglib and the latest ListLike, mostly untested):
import Data.ListLike (fromString, CharString (..))
import Text.ParserCombinators.UU
import Text.ParserCombinators.UU.BasicInstances
import Text.ParserCombinators.UU.Utils
-- change the local bindings in undumpFile to:
addv m s | BS.null s = m
addv m s = let (k,v) = readKV s
in Map.insert k v m
readKV :: BS.ByteString -> (BS.ByteString, BS.ByteString)
readKV s = let [ks,vs] = parse (pTuple [pQuotedString, pQuotedString]) (createStr (LineColPos 0 0 0) $ CS s)
unCSf = BS.drop 1 . BS.init . unCS
in (unCSf ks, unCSf vs)
And of course change the type of "foldLines" and use
BS.hGetLine, both to enable ByteString IO.
To use uu-parsinglib's character parsers (e.g. pTuple) with ByteStrings, you need to use a newtype wrapper such as CharString from ListLike, "CS" and "unCS" wrap and unwrap the type. The "unCSf" function removes the starting and trailing quotes in addition to unwrapping. This is still quick-and-dirty in that there's no error recovery, but it's easy to add, just see the uu-parsinglib documentation and examples, particularly "pEnd".
I think this will make a significant difference to your application.
John L.
Message: 4
Date: Tue, 22 Mar 2011 20:32:16 -0600
From: Tim Docker <twd2@dockerz.net>
Subject: memory slop (was: Using the GHC heap profiler)
To: glasgow-haskell-users@haskell.org
Message-ID: <4D895BB0.1080902@dockerz.net>
Content-Type: text/plain; charset=ISO-8859-1; format=flowed
-------- Map2.hs --------------------------------------------
module Main where
import qualified Data.Map as Map
import qualified Data.ByteString.Char8 as BS
import System.Environment
import System.IO
type MyMap = Map.Map BS.ByteString BS.ByteString
foldLines :: (a -> String -> a) -> a -> Handle -> IO a
foldLines f a h = do
eof <- hIsEOF h
if eof
then (return a)
else do
l <- hGetLine h
let a' = f a l
a' `seq` foldLines f a' h
undumpFile :: FilePath -> IO MyMap
undumpFile path = do
h <- openFile path ReadMode
m <- foldLines addv Map.empty h
hClose h
return m
where
addv m "" = m
addv m s = let (k,v) = readKV s
in k `seq` v `seq` Map.insert k v m
readKV s = let (ks,vs) = read s in (BS.pack ks, BS.pack vs)
dump :: [(BS.ByteString,BS.ByteString)] -> IO ()
dump vs = mapM_ putV vs
where
putV (k,v) = putStrLn (show (BS.unpack k, BS.unpack v))
main :: IO ()
main = do
args <- getArgs
case args of
[path] -> do
v <- undumpFile path
dump (Map.toList v)
return ()