-- | Haskell 1.2 Dialogue I/O,
-- extended for Fudgets with Xlib calls, network sockets, etc
module DialogueIO(Request(..), Response(..), IOError(..)
       , Dialogue(..), SigAct(..) , dialogueToIO
       --, module _LibDialogue
	) where
import Prelude hiding (IOError)
import P_IO_data
import DoRequest
import Control.Concurrent.Chan

-- | Included just to illustrate that it is possible to convert a Dialogue
-- IO function to a monadic IO function. The implementation relies on
-- 'getChanContents' to construct the lazy list of responses needed by
-- the dialogue IO function. (See also the functions 'doRequest' and
-- 'Fudgets.fudlogue'.)
dialogueToIO :: Dialogue -> IO ()
dialogueToIO :: Dialogue -> IO ()
dialogueToIO Dialogue
f =
  do XCallState
st <- IO XCallState
initXCall
     Chan Response
respchan <- forall a. IO (Chan a)
newChan
     [Request]
reqs <- Dialogue
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. Chan a -> IO [a]
getChanContents Chan Response
respchan
     let doReq :: Request -> IO ()
doReq Request
req = forall a. Chan a -> a -> IO ()
writeChan Chan Response
respchan forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< XCallState -> Request -> IO Response
doRequest XCallState
st Request
req
     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Request -> IO ()
doReq [Request]
reqs