module Srequest(select,sIOsucc,sIOstr,sIOerr,sIO,Cont(..)) where
import FRequest
import FudgetIO
import EitherUtils(Cont(..))
--import NullF(F,K)
import DialogueIO hiding (IOError) -- Select
import ShowFailure

sIOsucc :: SocketRequest -> f hi ho -> f hi ho
sIOsucc SocketRequest
sreq f hi ho
cont =
  forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
SocketRequest
-> (IOError -> f hi ho)
-> (Either Response SocketResponse -> f hi ho)
-> f hi ho
socketIO SocketRequest
sreq forall {a}. IOError -> a
sFail forall a b. (a -> b) -> a -> b
$ \ Either Response SocketResponse
r ->
  case Either Response SocketResponse
r of
    Left Response
Success -> f hi ho
cont
    Left Response
r -> forall a. HasCallStack => [Char] -> a
error ([Char]
"sIOsucc: Expected Success, but got "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show Response
r)
    Right SocketResponse
r -> forall a. HasCallStack => [Char] -> a
error ([Char]
"sIOsucc: Expected Success, but got "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show SocketResponse
r)

sIO :: SocketRequest -> (SocketResponse -> f hi ho) -> f hi ho
sIO SocketRequest
sreq = forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
SocketRequest
-> (IOError -> f hi ho) -> (SocketResponse -> f hi ho) -> f hi ho
sIOerr SocketRequest
sreq forall {a}. IOError -> a
sFail

sIOerr :: SocketRequest
-> (IOError -> f hi ho) -> (SocketResponse -> f hi ho) -> f hi ho
sIOerr SocketRequest
sreq IOError -> f hi ho
fcont SocketResponse -> f hi ho
rcont =
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
SocketRequest
-> (IOError -> f hi ho)
-> (Either Response SocketResponse -> f hi ho)
-> f hi ho
socketIO SocketRequest
sreq IOError -> f hi ho
fcont forall a b. (a -> b) -> a -> b
$ \ Either Response SocketResponse
r ->
    case Either Response SocketResponse
r of
      Right SocketResponse
sr -> SocketResponse -> f hi ho
rcont SocketResponse
sr
      Left Response
dr -> forall a. HasCallStack => [Char] -> a
error ([Char]
"Socket IO: expected a SocketResponse, but got "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show Response
dr)

sIOstr :: SocketRequest -> ([Char] -> f hi ho) -> f hi ho
sIOstr SocketRequest
sreq [Char] -> f hi ho
cont =
  forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
SocketRequest
-> (IOError -> f hi ho)
-> (Either Response SocketResponse -> f hi ho)
-> f hi ho
socketIO SocketRequest
sreq forall {a}. IOError -> a
sFail forall a b. (a -> b) -> a -> b
$ \ Either Response SocketResponse
r ->
  case Either Response SocketResponse
r of
    Left (Str [Char]
s) -> [Char] -> f hi ho
cont [Char]
s
    Left Response
r -> forall a. HasCallStack => [Char] -> a
error ([Char]
"sIOsucc: Expected Str, but got "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show Response
r)
    Right SocketResponse
r -> forall a. HasCallStack => [Char] -> a
error ([Char]
"sIOsucc: Expected Str, but got "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show SocketResponse
r)
    
---

sFail :: IOError -> a
sFail IOError
f = forall a. HasCallStack => [Char] -> a
error ([Char]
"Socket IO error: "forall a. [a] -> [a] -> [a]
++IOError -> [Char]
showFailure IOError
f)

socketIO :: SocketRequest
-> (IOError -> f hi ho)
-> (Either Response SocketResponse -> f hi ho)
-> f hi ho
socketIO SocketRequest
sreq IOError -> f hi ho
econt Either Response SocketResponse -> f hi ho
scont =
    forall {f :: * -> * -> *} {ans} {hi} {ho}.
FudgetIO f =>
FRequest -> (FResponse -> Maybe ans) -> (ans -> f hi ho) -> f hi ho
cmdContLow (SocketRequest -> FRequest
SReq SocketRequest
sreq) FResponse
-> Maybe (Either IOError (Either Response SocketResponse))
expect forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOError -> f hi ho
econt Either Response SocketResponse -> f hi ho
scont
  where expect :: FResponse
-> Maybe (Either IOError (Either Response SocketResponse))
expect FResponse
msg =
          case FResponse
msg of
            SResp SocketResponse
sr -> forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (forall a b. b -> Either a b
Right SocketResponse
sr))
	    DResp (Failure IOError
f) -> forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left IOError
f)
	    DResp Response
r -> forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (forall a b. a -> Either a b
Left Response
r))
            FResponse
_ -> forall a. Maybe a
Nothing

----

select :: [Descriptor] -> f hi ho -> f hi ho
select [Descriptor]
ds = forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FRequest -> f hi ho -> f hi ho
putLow forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> FRequest
DReq forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Descriptor] -> Request
Select forall a b. (a -> b) -> a -> b
$ [Descriptor]
ds
 -- no response from Select
-- eta expanded because of the monomorphism restriction