module SpIO(spIO) where
import Loopthrough
import Path(Path(..))
import Cont(getRightSP)
import ShowFailure
import Spops
import SP(SP)
import Tables2
import DialogueSpIO
import DialogueIO hiding (IOError)
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
$
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