Some Rhombus wrappers

db.rhm

#lang rhombus/static/and_meta

import:
  lib("db/base.rkt") as db_base
  lib("db/sqlite3.rkt") as db_sqlite

export:
  Connection
  ConnectionPool

veneer Statement(this :: satisfying(db_base.#{statement?}))

veneer Connection(this :: satisfying(db_base.#{connection?})):
  method make_kill_safe() :: Connection:
    db_base.#{kill-safe-connection}(this)

  method disconnect():
    db_base.disconnect(this)

  method list_tables() :: List.of(String):
    def raw :~ PairList.of(ReadableString) = db_base.#{list-tables}(this)
    for List (s: raw): s.to_string()

  method query_exec(stmt :: Statement, &args):
    db_base.#{query-exec}(this, stmt, &args)

  method query_value(stmt :: Statement, &args):
    db_base.#{query-value}(this, stmt, &args)

  method query_row(stmt :: Statement, &args) :: maybe(Array):
    db_base.#{query-maybe-row}(this, stmt, &args)

  method query_rows(stmt :: Statement, &args) :: List.of(Array):
    def raw :~ PairList = db_base.#{query-rows}(this, stmt, &args)
    raw.to_list()

  dot '$left . with_transaction':
    ~head_stx: head
    ~tail: '$tail'
    match tail
    | ': $(body :: Block)':
        values('db_base.#{call-with-transaction}($left, fun (): block $body)',
               '')
    | _:
        syntax_meta.error("expected a block afterward", head)

fun Connection.connect(~database: db_file
                                    :: PathString || matching(#'memory))
  :: Connection:
  db_sqlite.#{sqlite3-connect}(~database: db_file,
                               ~mode: #'create,
                               ~#{use-place}: #'#{os-thread})

fun Connection.make_virtual(pool_or_fun) :: Connection:
  db_base.#{virtual-connection}(pool_or_fun)

veneer ConnectionPool(this :: satisfying(db_base.#{connection-pool?}))

fun ConnectionPool.make(~connect: connect_fun,
                        ~max_connections: max_connections = #inf,
                        ~max_idle_connections: max_idle_connections = 10,
                        ~max_idle_seconds: max_idle_seconds = 300)
  :: ConnectionPool:
  db_base.#{connection-pool}(connect_fun,
                             ~#{max-connections}: max_connections,
                             ~#{max-idle-connections}: max_idle_connections,
                             ~#{max-idle-seconds}: max_idle_seconds)

webserver.rhm

#lang rhombus/static/and_meta

import:
  lib("racket/async-channel.rkt") as ch
  lib("web-server/private/connection-manager.rkt"):
    expose #{connection?}
  lib("web-server/http/request-structs.rkt") as req:
    expose:
      #{header?}
      #{request?}
  lib("web-server/http/response-structs.rkt"):
    expose:
      #{response?}
      #{response/full} as _response_full
  lib("web-server/web-server.rkt"):
    expose:
      serve
  net/url
  rhombus/network expose ListenPortNumber
  rhombus/rx expose RX

export:
  Connection
  Header
  Request
  Response
  Dispatcher
  Server

veneer Connection(this :: satisfying(#{connection?}))

veneer Header(this :: satisfying(#{header?})):
  constructor (field :: Bytes, value :: Bytes):
    req.#{header}(field, value)

  property field :~ Bytes: req.#{header-field}(this)
  property value :~ Bytes: req.#{header-value}(this)


veneer Request(this :: satisfying(#{request?})):
  property method :~ Bytes: req.#{request-method}(this)
  property headers :~ List.of(Header):
    def PairList[h, ...] = _headers
    [h, ...]

  private property _headers :~ PairList: req.#{request-headers/raw}(this)

  property uri :~ url.URL: url.URL.from_handle(req.#{request-uri}(this))

  property post_data :~ maybe(Bytes):
    req.#{request-post-data/raw}(this)

  method find_header(name :: Bytes) :: maybe(Header):
    req.#{headers-assq*}(name, _headers)


veneer Response(this :: satisfying(#{response?})):
  export fun make(~code: code :: Int.in(100, 999),
                  ~message: message :: maybe(Bytes) = #false,
                  ~seconds: seconds :: Int = system.seconds(),
                  ~mime: mime :: maybe(Bytes) = #false,
                  ~headers: [headers, ...] :: List.of(Header) = [],
                  ~body: [body, ...] :: List.of(Bytes) = []):
    _response_full(code,
                   message,
                   seconds,
                   mime,
                   PairList[headers, ...],
                   PairList[body, ...])

annot.macro 'Dispatcher':
  '(Connection, Request) -> ~any'

decl.nestable_macro
| 'import_dispatcher $(name :: Identifier)($annots, ...)':
    def modpath:
      def s = to_string(name.unwrap())
      Syntax.make("web-server/dispatchers/dispatch-" ++ s ++ ".rkt", name)
    'import:
       lib($modpath) expose make as _make
     def $name :: ($annots, ...) -> Dispatcher: _make
     export $name'
| 'import_dispatcher $(name :: Identifier) ($annots, ...):
     ~wrap: $(wrap_fun :: Group)':
    def modpath:
      def s = to_string(name.unwrap())
      Syntax.make("web-server/dispatchers/dispatch-" ++ s ++ ".rkt", name)
    'import:
       lib($modpath) expose make
     def $name :: ($annots, ...) -> Dispatcher: ($wrap_fun)(make)
     export $name'

namespace Dispatcher:
  import lib("web-server/dispatchers/dispatch.rkt"):
    expose #{next-dispatcher}
    rename #{next-dispatcher} as next
  export next

  import_dispatcher sequencer(Dispatcher, ...)
  import_dispatcher method(Symbol || List.of(Symbol), Dispatcher)
  import_dispatcher lift(Request -> Response)

  import_dispatcher logresp(~format: Symbol,
                            ~log_path: Port.Output || PathString,
                            Dispatcher):
    ~wrap: fun (make):
             fun (~format: format :: Symbol,
                  ~log_path: log_path :: Port.Output || PathString,
                  dispatcher):
               make(~format: format, ~#{log-path}: log_path, dispatcher)

  import_dispatcher filter(RX, Dispatcher):
    ~wrap: fun (make):
             fun (pat :~ RX, dispatcher):
               make(pat.handle, dispatcher)

class Server(private mutable _port,
             dispatcher :: Dispatcher):
  constructor (port :: ListenPortNumber, dispatcher):
    super(port, dispatcher)

  private field shutdown_proc :: maybe((~any) -> (~any)) = #false
  property port: _port

  method start():
    def complete_ch = ch.#{make-async-channel}()
    shutdown_proc := serve(~port: _port,
                           ~#{confirmation-channel}: complete_ch,
                           ~dispatch: dispatcher)

    match ch.#{async-channel-get}(complete_ch)
    | p :: ListenPortNumber: _port := p
    | e: throw e

  method stop():
    when shutdown_proc
    | shutdown_proc()

module for_test:
  export:
    MockServlet
    Request
    Response
    Dispatcher
    Server

  class MockServlet(make_response :: (Request) -> Response,
                    private mutable _reqs :: List.of(Request) = []):
    property reqs :~ List.of(Request): _reqs
    property dispatcher :: Dispatcher:
      Dispatcher.lift(fun (req):
                        _reqs := _reqs.add(req)
                        make_response(req))