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

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

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

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

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

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

----

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