[Haskell-cafe] Stream processors

[Jeremy Shaw]

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