!import "base.tri"      !Local
!import "io.tri"        !Local

-- Socket primitives for the IO driver.
-- All actions return a Result tree (see lib/base.tri):
--   ok value  -- pair true (pair value t)
--   err msg   -- pair false (pair msg t)

socket      = pair 70 t
closeSocket = sock : pair 71 sock
bindSocket  = sock addr port : pair 72 (pair sock (pair addr port))
listen      = sock backlog   : pair 73 (pair sock backlog)
accept      = sock           : pair 74 sock
connect     = sock addr port : pair 75 (pair sock (pair addr port))
recv        = sock maxBytes  : pair 76 (pair sock maxBytes)
send        = sock bytes     : pair 77 (pair sock bytes)
getSocketName = sock         : pair 78 sock

-- Result-aware wrappers over raw socket actions.
onSocket     = onResult socket
onBindSocket = sock addr port : onResult (bindSocket sock addr port)
onListen     = sock backlog   : onResult (listen sock backlog)
onAccept     = sock           : onResult (accept sock)
onConnect    = sock addr port : onResult (connect sock addr port)
onRecv       = sock maxBytes  : onResult (recv sock maxBytes)
onSend       = sock bytes     : onResult (send sock bytes)
onGetSocketName = sock        : onResult (getSocketName sock)

-- Result-aware wrappers that drop the useless 'rest' parameter.
onSocket_     = onResult_ socket
onBindSocket_ = sock addr port : onResult_ (bindSocket sock addr port)
onListen_     = sock backlog   : onResult_ (listen sock backlog)
onAccept_     = sock           : onResult_ (accept sock)
onConnect_    = sock addr port : onResult_ (connect sock addr port)
onRecv_       = sock maxBytes  : onResult_ (recv sock maxBytes)
onSend_       = sock bytes     : onResult_ (send sock bytes)
onGetSocketName_ = sock       : onResult_ (getSocketName sock)

-- Close a socket, ignoring errors.
closeSocket_ = sock : void (closeSocket sock)

-- Create a listening socket bound to an address and port.
-- Returns ok listenSocket or err message.
listenSocket = addr port backlog :
  onOk_ socket (server :
    onOk_ (bindSocket server addr port) (_ :
      onOk_ (listen server backlog) (_ :
        pure (ok server))))

-- Accept a connection with explicit error and ok branches.
-- okHandler receives (clientSocket, peerAddr).
withAccepted = (server errHandler okHandler :
  onResult (accept server)
    errHandler
    (accepted rest :
      okHandler (fst accepted) (snd accepted)))

-- Same as withAccepted, but handlers drop the useless 'rest' parameter.
withAccepted_ = (server errHandler okHandler :
  onResult_ (accept server)
    errHandler
    (accepted :
      okHandler (fst accepted) (snd accepted)))

serveOnce = (server handler :
  withAccepted_ server
    (err : pure t)
    (client peer :
      handler client peer))

serveForkingOnce = (server handler :
  withAccepted_ server
    (err : pure t)
    (client peer :
      fork (handler client peer)))

serveForever = (server handler :
  forever (serveForkingOnce server handler))

connectTo = (addr port :
  onOk socket (client rest :
    onOk (connect client addr port) (_ rest :
      pure (ok client rest))))