On 6/22/07, David Roundy <[EMAIL PROTECTED]> wrote:
Or make this lazy with:
> main = do ...
> origLinks <- mapM (unsafeInterleaveIO . getLinksAfterImgByAttr ...)
picLinks
--
David Roundy
Department of Physics
Oregon State University
Just for info I used your tip to bring laziness into the function that
fetches the URLs. Work great and lazy now!
-- | create sections from tag type and attribute
getSectionsByTypeAndAttr :: String -> (String, String) -> String -> IO [[Tag]]
getSectionsByTypeAndAttr tagType attr url = do
tags <- unsafeInterleaveIO $ liftM parseTags $ openURL $ url
(return . filterByTypeAndAttr tagType attr) tags
where
filterByTypeAndAttr :: String -> (String, String) -> [Tag] -> [[Tag]]
filterByTypeAndAttr t a = sections (~== TagOpen t [a])
Thanks,
Olivier.
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe