[left-fold operator for enumerating the lines of a text file]
..
enumLines :: (a -> String -> Either a a) -> a -> FilePath -> IO a
enumLines iter accum filename = do
h <- openFile filename ReadMode
flip fix accum $
\iterate accum -> do
try_line <- try (hGetLine h)
case try_line of
Left e -> hClose h >> return accum
Right line -> do
case iter accum line of
Left accum -> hClose h >> return accum
Right accum -> iterate accum
..
getHeaders :: S.Set String -> FilePath -> IO (S.Set String, M.Map String String)
getHeaders hdrs file = enumLines findHdrs (hdrs,M.empty) file where
we can keep the Left/Right implicit, using either:
getHeaders1 hdrs file = enumLines findHdrs (hdrs,M.empty) file
where
enumLines iter accum filename = do
h <- openFile filename ReadMode
flip fix accum $ \iterate accum ->
join $ (fmap (either
(const $ hClose h >> return accum)
(either ((hClose h >>) . return) iterate . iter
accum)))
(try (hGetLine h))
or extract the reusable loop-with-exit-by-either functionality:
loopME m stop continue acc = m >>= either (stop acc) (continue (loopME m
stop continue) acc)
getHeaders2 hdrs file = enumLines findHdrs (hdrs,M.empty) file
where
enumLines iter accum f = do
h <- openFile f ReadMode
loopME (try (hGetLine h))
(\acc left->hClose h >> return acc)
(\loop acc right->either ((hClose h >>) . return) loop (iter acc
right))
accum
or sneak some lazy i/o back in, using a fold-with-exit-by-either, similar to
loopME:
withFile path m = bracket (openFile path ReadMode) hClose m
withContentsOf path f = withFile path ((((return $!) . f ) =<<) .
hGetContents)
withLinesOf path f = withContentsOf path (f . lines)
foldE f a [] = a
foldE f a (x:xs) = either id (\a'->foldE f a' xs) (f a x)
getHeaders3 hdrs file = withLinesOf file (foldE findHdrs (hdrs,M.empty))
To use this, you provide an "iteratee", a function which takes an
accumulator and a line from the file, and returns a new accumulator
embedded in an Either. Using the Left branch causes immediate
termination of the enumeration. For example, to search for the first
occurrence of each of a set of email headers:
findHdrs accum@(wanted,found) line =
if null line
then Left accum
else
case headerLine line of
Nothing -> Right accum
Just hdr ->
case findDelete hdr wanted of
Nothing -> Right accum
Just wanted ->
let accum = (wanted, M.insert hdr line found) in
if S.null wanted
then Left accum
else Right accum
headerLine :: String -> Maybe String
headerLine (':':xs) = Just []
headerLine (x:xs) = fmap (x:) (headerLine xs)
headerLine [] = Nothing
findDelete :: Ord a => a -> S.Set a -> Maybe (S.Set a)
findDelete e s = if S.member e s
then Just (S.delete e s)
else Nothing
It's a bit of a case-analysis nightmare
indeed, this part can be cleaned up considerably, using Monad Maybe:
findHdrs accum@(wanted,found) line =
if null line || S.null wanted
then Left accum
else maybe (Right accum) id $ do
(field,value) <- headerLine line
wanted' <- findDelete field wanted
let found' = M.insert field value found
return $! (Right $! ((,) $! wanted') $! found')
headerLine :: String -> Maybe (String,String)
headerLine xs = do (field,':':value) <- return (span (/=':') xs)
let value' = dropWhile isSpace value
return $! ((,) $! field) $! strictly value'
findDelete :: Ord a => a -> S.Set a -> Maybe (S.Set a)
findDelete e s = guard (S.member e s) >> return (S.delete e s)
strictly l = length l `seq` l
running the three variants over a moderately sized directory (>3k emails, one
including a hugs-tarball;-), 1/2 are roughly equivalent, but Hugs claims that 3
allocates less and needs fewer garbage collections than 1/2, while GHC claims
that it is the other way round..
claus
_______________________________________________
Haskell-Cafe mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/haskell-cafe
