SpIO.hs

module SpIO(spIO) where
--import Command
--import Event
import Loopthrough
import Path(Path(..))
import Cont(getRightSP)
import ShowFailure
--import Sockets
import Spops
import SP(SP)
import Tables2
--import Xtypes
import DialogueSpIO
import DialogueIO hiding (IOError)
--import Table(Table) -- nhc bug workaround

spIO :: (SP (Path, Response) (Path, Request)) -> IO ()
spIO mainSP = dialogueSpIO (loopThroughRightSP tagRequestsSP mainSP)

tagRequestsSP = tagRequests dtable0
tagRequests dtable =
  getSP $ \msg ->
  case msg of
    Left (path', cmd) ->
      case cmd of
	Select ds -> let dtable' = updateDe path' ds dtable
		     in doReqSP (Select (listDe dtable')) $ \ resp ->
			checkErr resp (tagRequests dtable')
	XCommand _ -> putReqSP cmd $  -- \ resp ->
		      -- The response to an XCommand is always Success
		      -- and is not propagated to the originating fudget.
		      tagRequests dtable
	_ -> doReqSP cmd $ \ resp ->
	     putSP (Left (path', resp)) $
	     tagRequests dtable
    Right ai@(AsyncInput (d, i)) ->
      putSP (Left (lookupDe dtable d, ai)) $
      tagRequests dtable
    _ -> error ("tagRequests: " ++ show msg ++ "\n")

checkErr resp cont =
    case resp of
      Success -> cont
      Failure ioerr -> error ("IOerror: " ++ showFailure ioerr)

doReqSP req = putReqSP req . getRespSP
  where
    getRespSP = getRightSP

putReqSP = putSP . Right