tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

5014c5c41aa63d3b8a52e6cd89600b435505d93325f730b532c9eabaffd58421.tri (3548B)

      1 !import prelude *
      2 !import io *
      3 !export *
      4 
      5 -- Socket primitives for the IO driver.
      6 --   ok value t  -- pair true (pair value t)
      7 --   err msg t   -- pair false (pair msg t)
      8 
      9 socket      = pair 70 t
     10 closeSocket = sock : pair 71 sock
     11 bindSocket  = sock addr port : pair 72 (pair sock (pair addr port))
     12 listen      = sock backlog   : pair 73 (pair sock backlog)
     13 accept      = sock           : pair 74 sock
     14 connect     = sock addr port : pair 75 (pair sock (pair addr port))
     15 recv        = sock maxBytes  : pair 76 (pair sock maxBytes)
     16 send        = sock bytes     : pair 77 (pair sock bytes)
     17 getSocketName = sock         : pair 78 sock
     18 
     19 -- Result-aware wrappers over raw socket actions
     20 onSocket     = onResult socket
     21 onBindSocket = sock addr port : onResult (bindSocket sock addr port)
     22 onListen     = sock backlog   : onResult (listen sock backlog)
     23 onAccept     = sock           : onResult (accept sock)
     24 onConnect    = sock addr port : onResult (connect sock addr port)
     25 onRecv       = sock maxBytes  : onResult (recv sock maxBytes)
     26 onSend       = sock bytes     : onResult (send sock bytes)
     27 onGetSocketName = sock        : onResult (getSocketName sock)
     28 
     29 -- Result-aware wrappers that drop the 'rest' parameter
     30 onSocket_        = onResult_ socket
     31 onBindSocket_    = sock addr port   : onResult_ (bindSocket sock addr port)
     32 onListen_        = sock backlog     : onResult_ (listen sock backlog)
     33 onAccept_        = sock             : onResult_ (accept sock)
     34 onConnect_       = sock addr port   : onResult_ (connect sock addr port)
     35 onRecv_          = sock maxBytes    : onResult_ (recv sock maxBytes)
     36 onSend_          = sock bytes       : onResult_ (send sock bytes)
     37 onGetSocketName_ = sock             : onResult_ (getSocketName sock)
     38 
     39 -- Close a socket, ignoring errors.
     40 closeSocket_ = sock : void (closeSocket sock)
     41 
     42 -- Close only on an ordinary Result failure, preserving its exact message and
     43 -- remainder even if close fails. Not an exception/abortIO cleanup mechanism;
     44 -- ownership of a successful socket transfers to the caller.
     45 closeSocketOnError sock action = (do bind
     46   reply <- action
     47   case reply of
     48     (t, _) = finally (pure reply) (closeSocket_ sock)
     49     _ = pure reply)
     50 
     51 -- Create a listening socket bound to an address and port.
     52 -- Returns ok listenSocket or err message. An acquired socket is closed if
     53 -- binding or listening fails; acquisition failure has nothing to release.
     54 listenSocket addr port backlog = (do onOk_
     55   server <- socket
     56   closeSocketOnError server (do onOk_
     57     bindSocket server addr port
     58     listen server backlog
     59     pure (ok server t)))
     60 
     61 -- Accept a connection with explicit error and ok branches.
     62 -- okHandler receives (clientSocket, peerAddr).
     63 withAccepted = (server errHandler okHandler :
     64   onResult (accept server)
     65     errHandler
     66     (accepted rest :
     67       okHandler (fst accepted) (snd accepted)))
     68 
     69 -- Same as withAccepted, but handlers drop the useless 'rest' parameter.
     70 withAccepted_ = (server errHandler okHandler :
     71   onResult_ (accept server)
     72     errHandler
     73     (accepted :
     74       okHandler (fst accepted) (snd accepted)))
     75 
     76 serveOnce = (server handler :
     77   withAccepted_ server
     78     (err : pure t)
     79     (client peer :
     80       handler client peer))
     81 
     82 serveForkingOnce = (server handler :
     83   withAccepted_ server
     84     (err : pure t)
     85     (client peer :
     86       fork (handler client peer)))
     87 
     88 serveForever = (server handler :
     89   forever (serveForkingOnce server handler))
     90 
     91 connectTo addr port = (do onOk_
     92   client <- socket
     93   closeSocketOnError client (onOk (connect client addr port)
     94     (_ rest : pure (ok client rest))))