module AsyncTransmitter(asyncTransmitterF,asyncTransmitterF',closerF) where
import Sockets
import Srequest
import FRequest
import Message(message)
import NullF(getK,nullK,nullF)
import Fudget()
import FudgetIO
import CompOps((>==<))
import IoF(ioF)
import DialogueIO hiding (IOError)
import Queue(QUEUE,empty,enter,qremove)
asyncTransmitterF :: Socket -> F String b
asyncTransmitterF Socket
socket = forall {ans} {ho}. Socket -> F ans ho
closerF Socket
socket forall {a1} {b} {a2}. F a1 b -> F a2 a1 -> F a2 b
>==< Socket -> F String ()
asyncTransmitterF' Socket
socket
asyncTransmitterF' :: Socket -> F String ()
asyncTransmitterF' Socket
socket =
forall {a} {b}. K a b -> F a b
ioF K String ()
idleK
where
idleK :: K String ()
idleK = forall {hi} {ho}.
(FResponse -> K hi ho) -> (hi -> K hi ho) -> K hi ho
getMsg (forall a b. a -> b -> a
const K String ()
idleK) String -> K String ()
high
where
high :: String -> K String ()
high String
"" = forall {hi}. K hi ()
closeK
high String
str = Buffer -> K String ()
goBlockedK (String -> Buffer
buf1 String
str)
goIdleK :: K String ()
goIdleK = forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
[Descriptor] -> f hi ho -> f hi ho
select [] forall a b. (a -> b) -> a -> b
$ K String ()
idleK
goBlockedK :: Buffer -> K String ()
goBlockedK Buffer
buf =
forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
[Descriptor] -> f hi ho -> f hi ho
select [Socket -> Descriptor
OutputSocketDe Socket
socket] forall a b. (a -> b) -> a -> b
$
Buffer -> Int -> K String ()
blockedK Buffer
buf Int
initblocksize
blockedK :: Buffer -> Int -> K String ()
blockedK Buffer
buf Int
n = forall {hi} {ho}.
(FResponse -> K hi ho) -> (hi -> K hi ho) -> K hi ho
getMsg FResponse -> K String ()
low String -> K String ()
high
where
low :: FResponse -> K String ()
low (DResp (AsyncInput (Descriptor
_,AEvent
SocketWritable))) = Buffer -> Int -> K String ()
writeK Buffer
buf Int
n
high :: String -> K String ()
high String
str = Buffer -> Int -> K String ()
blockedK (Buffer -> String -> Buffer
putbuf Buffer
buf String
str) Int
n
writeK :: Buffer -> Int -> K String ()
writeK Buffer
buf Int
n =
case Buffer -> Int -> GetBuf
getbuf Buffer
buf Int
n of
GetBuf
Empty -> K String ()
goIdleK
GetBuf
EoS -> forall {hi}. K hi ()
closeK
More String
ps Buffer
buf' -> forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
SocketRequest
-> (IOError -> f hi ho) -> (SocketResponse -> f hi ho) -> f hi ho
sIOerr (Socket -> String -> SocketRequest
WriteSocketPS Socket
socket String
ps) forall {p}. p -> K String ()
errK SocketResponse -> K String ()
okK
where
okK :: SocketResponse -> K String ()
okK (Wrote Int
n') = Buffer -> Int -> K String ()
blockedK Buffer
buf' Int
n
errK :: p -> K String ()
errK p
_ = Buffer -> Int -> K String ()
blockedK Buffer
buf' Int
n
closeK :: K hi ()
closeK =
forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
[Descriptor] -> f hi ho -> f hi ho
select [] forall a b. (a -> b) -> a -> b
$
forall {f :: * -> * -> *} {ho} {hi}.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh () forall a b. (a -> b) -> a -> b
$
forall {hi} {ho}. K hi ho
nullK
closerF :: Socket -> F ans ho
closerF Socket
socket =
forall {f :: * -> * -> *} {ans} {ho}.
FudgetIO f =>
(ans -> f ans ho) -> f ans ho
getHigh forall a b. (a -> b) -> a -> b
$ \ ans
_ ->
forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
SocketRequest -> f hi ho -> f hi ho
sIOsucc (Socket -> SocketRequest
CloseSocket Socket
socket) forall a b. (a -> b) -> a -> b
$
forall {hi} {ho}. F hi ho
nullF
getMsg :: (FResponse -> K hi ho) -> (hi -> K hi ho) -> K hi ho
getMsg FResponse -> K hi ho
l hi -> K hi ho
h = forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ forall {t1} {t2} {t3}.
(t1 -> t2) -> (t3 -> t2) -> Message t1 t3 -> t2
message FResponse -> K hi ho
l hi -> K hi ho
h
data Buffer = Buf String (QUEUE String)
data GetBuf = More String Buffer | Empty | EoS
buf1 :: String -> Buffer
buf1 String
str = String -> QUEUE String -> Buffer
Buf String
str forall {a}. QUEUE a
empty
putbuf :: Buffer -> String -> Buffer
putbuf (Buf String
s QUEUE String
q) String
str = String -> QUEUE String -> Buffer
Buf String
s (forall {a}. QUEUE a -> a -> QUEUE a
enter QUEUE String
q String
str)
getbuf :: Buffer -> Int -> GetBuf
getbuf (Buf String
s QUEUE String
q) Int
n = String -> QUEUE String -> GetBuf
getbuf' String
s QUEUE String
q
where
getbuf' :: String -> QUEUE String -> GetBuf
getbuf' String
"" QUEUE String
q =
case forall {a}. QUEUE a -> Maybe (a, QUEUE a)
qremove QUEUE String
q of
Maybe (String, QUEUE String)
Nothing -> GetBuf
Empty
Just (String
s,QUEUE String
q') ->
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s
then GetBuf
EoS
else String -> QUEUE String -> GetBuf
getbuf'' String
s QUEUE String
q'
getbuf' String
s QUEUE String
q = String -> QUEUE String -> GetBuf
getbuf'' String
s QUEUE String
q
getbuf'' :: String -> QUEUE String -> GetBuf
getbuf'' String
s QUEUE String
q =
case forall a. Int -> [a] -> ([a], [a])
splitAt Int
n String
s of
(String
s1,String
s2) -> String -> Buffer -> GetBuf
More String
s1 (String -> QUEUE String -> Buffer
Buf String
s2 QUEUE String
q)
initblocksize :: Int
initblocksize = Int
512 :: Int