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 qualified PackedString as PS
import Queue(QUEUE,empty,enter,qremove)

{- asyncTransmitterF has two states:

   - Idle state: we have nothing to send and don't want to be notified when
                 the socket becomes writable.

   - Blocked state: we have something to send and want to be notified when
                   the socket becomes writable.

   idleK handles the idle state. Transistion to the idleState is done
   with goIdleK. idleK should only be called when in the idle state.

   blockedK handles the blocked state. Transition to the blocked state is done
   with goBlockedK. blockedK should only be called when in the blocked state.

   writeK is called in blocked mode when the socket become writable. If there
   is something left in the buffer to write, writeK writes a chunk to the
   socket and continues in blocked mode, otherwise writeK switches to
   idle mode.
-}

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 =
    -- Start in idle mode
    forall {a} {b}. K a b -> F a b
ioF K String ()
idleK
  where
    -- To be called while in idle mode only:
    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)

    -- To swich from blocked to idle mode:
    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

    -- To switch from idle mode to blocked mode:
    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

    -- To be called while in blocked mode only:
    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

    -- To be called while in blocked mode, when socket becomes writable:
    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 -- Ignore errors?!

    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
$
      --sIOsucc (CloseSocket socket) $
      -- Can't close the socket until the receiver (if any) has deselected it!
      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

--buf0 = Buf "" empty
buf1 :: String -> Buffer
buf1 String
str = String -> QUEUE String -> Buffer
Buf String
str forall {a}. QUEUE a
empty -- pre: str/=""

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) -- str=="" to indicate eos

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