[Haskell-cafe] Problem with pipes interpretation of Lazy MapM program.
Lyndon Maydwell
maydwell at gmail.com
Thu Jul 11 09:03:05 CEST 2013
Hi café.
I've come up with a little version of 'uniq' that should take into account
md5 sums of the file changes... In essence, this:
main :: IO ()
main = getContents
>>= mapM check . lines -- PROBLEM!!!!
>>= mapM_ (putStrLn . (" --> " ++ )) . strip
check :: String -> IO (String, ABCD)
check s = (s,) . md5 . Str <$> readFile s
strip :: (Ord a, Eq b) => [(a,b)] -> [a]
strip = concat . uncurry (zipWith look) . (id &&& maps)
look :: (Ord a, Eq b) => (a,b) -> M.Map a b -> [a]
look (k,v) m | M.lookup k m == Just v = []
| otherwise = [k]
maps :: Ord a => [(a,b)] -> [M.Map a b]
maps = scanl (flip (uncurry M.insert)) M.empty
Unfortunately mapM isn't lazy, so this doesn't work. I thought this would
be a good opportunity to try out the Pipes library for a simple real-world
task, but I've come up against some issues with using 'zip' and 'scan' like
functions when translating the code.
This is what I've got so far, but I'm not sure how to proceed:
main :: IO ()
main = runProxy $ stdinS >-> pipe >-> stdoutD
pipe :: () -> ProxyFast () String () String IO ()
pipe = mapMD check
>-> mapScan
-- zip, check, output go here
>-> mapD ((" --> " ++) . show)
mapScan :: () -> ProxyFast () (String, ABCD) () (M.Map String ABCD) IO b
mapScan = scanlp (uncurry M.insert) (M.empty)
check :: String -> IO (String, ABCD)
check s = (s,) . md5 . Str <$> readFile s
-- Utils
scanlp :: (Monad (p () t a b1 m), Monad m, Functor (p () t a b1 m), Proxy
p) =>
(t -> b1 -> b1) -> b1 -> () -> p () t a b1 m b
scanlp f a b = do
void $ respond a
v <- request ()
scanlp f (f v a) b
There doesn't seem to be any easy zipLike functions, and having to write my
own scan function seems odd. Can someone point me in the right direction
for this?
Thanks!
- Lyndon
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20130711/61fcdfbc/attachment.htm>
More information about the Haskell-Cafe
mailing list