module Transceivers where
import Socketio
import AsyncTransmitter
import CompOps((>==<),(>=^^<))
import Spops(nullSP)

transmitterF :: Socket -> F [Char] b
transmitterF Socket
s = forall {ans} {ho}. Socket -> F ans ho
closerF Socket
s forall {a1} {b} {a2}. F a1 b -> F a2 a1 -> F a2 b
>==< Socket -> F [Char] ()
transmitterF' Socket
s

receiverF :: Socket -> F e [Char]
receiverF Socket
s = forall {hi}. Socket -> F hi [Char]
receiverF' Socket
s forall c d e. F c d -> SP e c -> F e d
>=^^< forall a b. SP a b
nullSP

transceiverF :: Socket -> F [Char] [Char]
transceiverF Socket
s = forall {hi}. Socket -> F hi [Char]
receiverF' Socket
s forall {a1} {b} {a2}. F a1 b -> F a2 a1 -> F a2 b
>==< Socket -> F [Char] ()
transmitterF' Socket
s

asyncTransceiverF :: Socket -> F [Char] [Char]
asyncTransceiverF Socket
s = forall {hi}. Socket -> F hi [Char]
receiverF' Socket
s forall {a1} {b} {a2}. F a1 b -> F a2 a1 -> F a2 b
>==< Socket -> F [Char] ()
asyncTransmitterF' Socket
s