
At 21 Oct 2004 16:48:57 +0200, Peter Simons wrote:
Hi,
I know the stream processors as described in Hughes' paper about Arrows, but those are pure stream processors -- they don't allow for I/O, which I need to handle the Ptr.
Here is a some code I scraped off the net a while ago, though I can't seem to find the origin anymore. Not sure what the license is. Also, I think it might be a little buggy -- I have not used it much... However, it does show how to do IO in stream processing arrows... module ArrowStream where ----------------------------------------------------------------------------- -- -- Definition of continuation based stream processor as an arrow -- -- Reference: Magnus Carlsson, Thomas Hallgren, "Fudgets--Purely Functional -- Processes with applications to Graphical User Interfaces", -- Department of Computing Science, Chalmers University of -- Technology, Goteborg University, Dissertation 1998 -- -- John Hughes, Generalising Monads to Arrows, November 10, 1998 -- -- History: 14-Aug-2002 Shawn Garbett, Creation -- 01-Apr-2004 A -- ------------------------------------------------------------------------------- import Char import Control.Arrow import Control.Concurrent import Monad import System.IO data SP i o = Put o (SP i o) | Get (i -> SP i o) | Null | DoIO (IO (SP i o)) instance Arrow SP where arr f = Get (\x -> Put (f x) (arr f)) sp1 >>> Put c sp2 = Put c (sp1 >>> sp2) Put b sp1 >>> Get f = sp1 >>> f b Get f1 >>> Get f2 = Get (\a -> f1 a >>> Get f2) _ >>> Null = Null Null >>> Get _ = Null -- Process io downstream first sp >>> DoIO io = DoIO (Monad.liftM (sp >>>) io) -- Process io upstream next DoIO io >>> sp = DoIO (Monad.liftM (>>> sp) io) first f = bypass [] f where bypass ds (Get f) = Get (\(b,d) -> bypass (ds++[d]) (f b)) bypass (d:ds) (Put c sp) = Put (c,d) (bypass ds sp) bypass [] (Put c sp) = Get (\(b,d) -> Put (c,d) (bypass [] sp)) -- making it up... bypass ds (DoIO iosp) = DoIO (iosp >>= (\sp -> return (bypass ds sp))) instance ArrowZero SP where zeroArrow = Get (\x -> zeroArrow) instance ArrowPlus SP where Put b sp1 <+> sp2 = Put b (sp1 <+> sp2) sp1 <+> Put b sp2 = Put b (sp1 <+> sp2) Get f1 <+> Get f2 = Get (\a -> f1 a <+> f2 a) sp1 <+> (DoIO ioSP) = DoIO (ioSP >>= (\sp2 -> return (sp1 <+> sp2))) (DoIO ioSP) <+> sp2 = DoIO (ioSP >>= (\sp1 -> return (sp1 <+> sp2))) sp1 <+> Null = sp1 Null <+> sp2 = sp2 instance ArrowChoice SP where left (Put c sp) = Put (Left c) (left sp) left (Get f) = Get (\z -> case z of Left a -> left (f a) Right b -> Put (Right b) (left (Get f))) left (DoIO iosp) = DoIO (iosp >>= return . left) -- | Run the IO in a DoIO -- | the putStrLn's are just for debug... spIO :: Show o => SP i o -> IO () spIO sp = case sp of Null -> putStrLn "Null" >> return () Get _ -> putStrLn ("Get f") >> return () Put n sp' -> putStrLn ("Put " ++ (show n)) >> spIO sp' DoIO io -> io >>= spIO