Arrows and the IO monad

Magnus Carlsson magnus@cse.ogi.edu
Tue, 15 Apr 2003 17:40:49 -0700


Hi Peter,

One possibility is to add a constructor that deals with I/O to the
data type for stream processors.  You can
read about it at

  http://www.cs.chalmers.se/~hallgren/Thesis/fudgets-implementation.html#fudgets-on-monadIO

The extended type is called F' there:

  data  F' i o =  PutF o (F' i o)
               |  GetF (i -> F' i o)
               |  NullF
               |  DoIoF (IO (F' i o))

and one way to perform IO operations inside a stream processor is
suggested by:

  doIoF :: IO a -> (a -> F' i o) -> F' i o
  doIoF io c = DoIoF (fmap c io)

Hope this helps,
/M

Peter Simons writes:
 > Hi,
 > 
 > after reading the excellent paper "Generalising Monads to Arrows" from
 > John Hughes, I am trying to use an arrow-based stream processor of
 > type 'SP a b' to implement a network daemon. So far I have defined the
 > arrow successfully:
 > 
 > > data SP a b = Put b (SP a b)
 > >             | Get (a -> SP a b)
 > >             | Null
 > >               deriving (Show)
 > >
 > > instance Arrow SP where
 > >     arr f = get (\x -> put (f x) (arr f))
 > >
 > >     _ >>> Null           = Null
 > >     sp1 >>> Put c sp2    = Put c (sp1 >>> sp2)
 > >     Null >>> Get _       = Null
 > >     Put c sp1 >>> Get f2 = sp1 >>> f2 c
 > >     Get f1 >>> Get f2    = Get (\c -> f1 c >>> Get f2)
 > >
 > >     first f = bypass [] f
 > >         where
 > >         bypass ds (Get f)        = Get (\(b,d) -> bypass (ds ++ [d]) (f b))
 > >         bypass [] (Put c sp)     = Get (\(_,d) -> Put (c,d) (bypass [] sp))
 > >         bypass (d:ds) (Put c sp) = Put (c,d) (bypass ds sp)
 > 
 > But now I have to make the stream processors interact with the IO
 > monad, because I want the actual reading and writing to take place in
 > the processor arrow. Is there any good way to achieve that without
 > being forced to use the type 'SP (IO a) (IO b)' throughout the arrow?
 > 
 > Can I maybe split the data flow for simple non-IO processors off the
 > I/O monad temporarily?
 > 
 > Or is there a way to combine my SP arrow with the IO monad in way that
 > IO actions can be lifted to my SP arrow?
 > 
 > Can anyone recommend some further reading material concerning this
 > topic?
 > 
 > Any feedback is appreciated!
 > 
 > Peter
 > 
 > _______________________________________________
 > Haskell mailing list
 > Haskell@haskell.org
 > http://www.haskell.org/mailman/listinfo/haskell