ExternalFunctionsSocket.hs 1.56 KB
Newer Older
bbr's avatar
bbr committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
module ExternalFunctionsSocket (module ExternalFunctionsSocket) where

import Curry
import CurryPrelude
import ExternalDataSocket
import CurryIO

import Network
import Network.Socket 
import Control.Concurrent
import System.IO (Handle)

instance ConvertCH C_Int PortID where
  toCurry (PortNumber i) = toCurry (toInteger i)
  fromCurry i = PortNumber (fromInteger (fromCurry i))

prim_listenOn :: State -> C_Int -> C_IO C_Socket
prim_listenOn  = CurryPrelude.ioFunc1 listenOn 

listenOnFresh :: State -> C_IO (T2 C_Int C_Socket)
listenOnFresh  = CurryPrelude.ioFunc0 listenOnFreshPort

listenOnFreshPort :: IO (PortID,Socket)
listenOnFreshPort = do
  s <- listenOn (PortNumber aNY_PORT)
  p <- Network.socketPort s
  return (p,s)


prim_socketListen :: State -> C_Socket -> C_Int -> C_IO T0
prim_socketListen  = CurryPrelude.ioFunc2 listen



prim_socketAccept :: State -> C_Socket -> C_IO (T2 (List C_Char) C_Handle)
prim_socketAccept  = ioFunc1 (\ s -> Network.accept s >>= \ (h,s,_) -> return (s,h))



prim_waitForSocketAccept :: State -> C_Socket -> C_Int -> C_IO (C_Maybe (T2 (List C_Char) C_Handle))
prim_waitForSocketAccept  = CurryPrelude.ioFunc2 wait

wait :: Socket -> Int -> IO (Maybe (String,Handle))
wait s t = do
  mv <- newEmptyMVar
  tacc <- forkIO (Network.accept s >>= \ (h,s,_) ->  putMVar mv (Just (s,h)))
  ttim <- forkIO (threadDelay (t*1000) >> putMVar mv Nothing)
  res <- takeMVar mv
  maybe (killThread tacc) (\_ -> killThread ttim) res
  return res




prim_connectToSocket :: State -> (List C_Char) -> C_Int -> C_IO C_Handle
prim_connectToSocket  = ioFunc2 connectTo