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 :: SP (Path, Response) (Path, Request) -> IO ()
spIO SP (Path, Response) (Path, Request)
mainSP = SP Response Request -> IO ()
dialogueSpIO (SP
  (Either (Path, Request) Response) (Either (Path, Response) Request)
-> SP (Path, Response) (Path, Request) -> SP Response Request
forall a1 a2 a3 b.
SP (Either a1 a2) (Either a3 b) -> SP a3 a1 -> SP a2 b
loopThroughRightSP SP
  (Either (Path, Request) Response) (Either (Path, Response) Request)
tagRequestsSP SP (Path, Response) (Path, Request)
mainSP)

tagRequestsSP :: SP
  (Either (Path, Request) Response) (Either (Path, Response) Request)
tagRequestsSP = DTable
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
tagRequests DTable
dtable0
tagRequests :: DTable
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
tagRequests DTable
dtable =
  Cont
  (SP
     (Either (Path, Request) Response)
     (Either (Path, Response) Request))
  (Either (Path, Request) Response)
forall a b. Cont (SP a b) a
getSP Cont
  (SP
     (Either (Path, Request) Response)
     (Either (Path, Response) Request))
  (Either (Path, Request) Response)
-> Cont
     (SP
        (Either (Path, Request) Response)
        (Either (Path, Response) Request))
     (Either (Path, Request) Response)
forall a b. (a -> b) -> a -> b
$ \Either (Path, Request) Response
msg ->
  case Either (Path, Request) Response
msg of
    Left (Path
path', Request
cmd) ->
      case Request
cmd of
	Select [Descriptor]
ds -> let dtable' :: DTable
dtable' = Path -> [Descriptor] -> DTable -> DTable
updateDe Path
path' [Descriptor]
ds DTable
dtable
		     in Request
-> (Response
    -> SP
         (Either (Path, Request) Response)
         (Either (Path, Response) Request))
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
forall b t a1 a.
b
-> (t -> SP (Either a1 t) (Either a b))
-> SP (Either a1 t) (Either a b)
doReqSP ([Descriptor] -> Request
Select (DTable -> [Descriptor]
listDe DTable
dtable')) ((Response
  -> SP
       (Either (Path, Request) Response)
       (Either (Path, Response) Request))
 -> SP
      (Either (Path, Request) Response)
      (Either (Path, Response) Request))
-> (Response
    -> SP
         (Either (Path, Request) Response)
         (Either (Path, Response) Request))
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
forall a b. (a -> b) -> a -> b
$ \ Response
resp ->
			Response
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
forall p. Response -> p -> p
checkErr Response
resp (DTable
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
tagRequests DTable
dtable')
	XCommand (XDisplay, XWId, XCommand)
_ -> Request
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
forall b a a. b -> SP a (Either a b) -> SP a (Either a b)
putReqSP Request
cmd (SP
   (Either (Path, Request) Response) (Either (Path, Response) Request)
 -> SP
      (Either (Path, Request) Response)
      (Either (Path, Response) Request))
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
forall a b. (a -> b) -> a -> b
$  -- \ resp ->
		      -- The response to an XCommand is always Success
		      -- and is not propagated to the originating fudget.
		      DTable
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
tagRequests DTable
dtable
	Request
_ -> Request
-> (Response
    -> SP
         (Either (Path, Request) Response)
         (Either (Path, Response) Request))
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
forall b t a1 a.
b
-> (t -> SP (Either a1 t) (Either a b))
-> SP (Either a1 t) (Either a b)
doReqSP Request
cmd ((Response
  -> SP
       (Either (Path, Request) Response)
       (Either (Path, Response) Request))
 -> SP
      (Either (Path, Request) Response)
      (Either (Path, Response) Request))
-> (Response
    -> SP
         (Either (Path, Request) Response)
         (Either (Path, Response) Request))
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
forall a b. (a -> b) -> a -> b
$ \ Response
resp ->
	     Either (Path, Response) Request
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
forall b a. b -> SP a b -> SP a b
putSP ((Path, Response) -> Either (Path, Response) Request
forall a b. a -> Either a b
Left (Path
path', Response
resp)) (SP
   (Either (Path, Request) Response) (Either (Path, Response) Request)
 -> SP
      (Either (Path, Request) Response)
      (Either (Path, Response) Request))
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
forall a b. (a -> b) -> a -> b
$
	     DTable
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
tagRequests DTable
dtable
    Right ai :: Response
ai@(AsyncInput (Descriptor
d, AEvent
i)) ->
      Either (Path, Response) Request
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
forall b a. b -> SP a b -> SP a b
putSP ((Path, Response) -> Either (Path, Response) Request
forall a b. a -> Either a b
Left (DTable -> Descriptor -> Path
lookupDe DTable
dtable Descriptor
d, Response
ai)) (SP
   (Either (Path, Request) Response) (Either (Path, Response) Request)
 -> SP
      (Either (Path, Request) Response)
      (Either (Path, Response) Request))
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
forall a b. (a -> b) -> a -> b
$
      DTable
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
tagRequests DTable
dtable
    Either (Path, Request) Response
_ -> [Char]
-> SP
     (Either (Path, Request) Response) (Either (Path, Response) Request)
forall a. HasCallStack => [Char] -> a
error ([Char]
"tagRequests: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Either (Path, Request) Response -> [Char]
forall a. Show a => a -> [Char]
show Either (Path, Request) Response
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n")

checkErr :: Response -> p -> p
checkErr Response
resp p
cont =
    case Response
resp of
      Response
Success -> p
cont
      Failure IOError
ioerr -> [Char] -> p
forall a. HasCallStack => [Char] -> a
error ([Char]
"IOerror: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ IOError -> [Char]
showFailure IOError
ioerr)

doReqSP :: b
-> (t -> SP (Either a1 t) (Either a b))
-> SP (Either a1 t) (Either a b)
doReqSP b
req = b -> SP (Either a1 t) (Either a b) -> SP (Either a1 t) (Either a b)
forall b a a. b -> SP a (Either a b) -> SP a (Either a b)
putReqSP b
req (SP (Either a1 t) (Either a b) -> SP (Either a1 t) (Either a b))
-> ((t -> SP (Either a1 t) (Either a b))
    -> SP (Either a1 t) (Either a b))
-> (t -> SP (Either a1 t) (Either a b))
-> SP (Either a1 t) (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> SP (Either a1 t) (Either a b))
-> SP (Either a1 t) (Either a b)
forall t a1 b. (t -> SP (Either a1 t) b) -> SP (Either a1 t) b
getRespSP
  where
    getRespSP :: (t -> SP (Either a1 t) b) -> SP (Either a1 t) b
getRespSP = (t -> SP (Either a1 t) b) -> SP (Either a1 t) b
forall t a1 b. (t -> SP (Either a1 t) b) -> SP (Either a1 t) b
getRightSP

putReqSP :: b -> SP a (Either a b) -> SP a (Either a b)
putReqSP = Either a b -> SP a (Either a b) -> SP a (Either a b)
forall b a. b -> SP a b -> SP a b
putSP (Either a b -> SP a (Either a b) -> SP a (Either a b))
-> (b -> Either a b) -> b -> SP a (Either a b) -> SP a (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right