Skip to content


Subversion checkout URL

You can clone with
Download ZIP
Fetching contributors…
Cannot retrieve contributors at this time
113 lines (90 sloc) 4.26 KB
Copyright © 2011 MLstate
This file is part of OPA.
OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.
OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.
You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <>.
(** This module provide some common utils and types for bsl modules : projection, ...*)
(* Field names, used when creating OPA-understandable records.*)
let fnone = ServerLib.static_field_of_name "none"
let fsome = ServerLib.static_field_of_name "some"
let fkey = ServerLib.static_field_of_name "key"
let freq = ServerLib.static_field_of_name "request"
let fcon = ServerLib.static_field_of_name "connexion"
let fdetails = ServerLib.static_field_of_name "details"
let fconstraint = ServerLib.static_field_of_name "constraint"
let fclient = ServerLib.static_field_of_name "client"
let fserver = ServerLib.static_field_of_name "server"
let fnothing = ServerLib.static_field_of_name "nothing"
let fsuccess = ServerLib.static_field_of_name "success"
let ffailure = ServerLib.static_field_of_name "failure"
let ffree = ServerLib.static_field_of_name "free"
let fno_client_calls = ServerLib.static_field_of_name "no_client_calls"
let rnone = ServerLib.make_record (ServerLib.add_field ServerLib.empty_record_constructor (fnone) (ServerLib.make_record ServerLib.empty_record_constructor))
let rsome x = ServerLib.make_record (ServerLib.add_field ServerLib.empty_record_constructor (fsome) x)
let rclient x = ServerLib.make_record (ServerLib.add_field ServerLib.empty_record_constructor (fclient) x)
let rserver x = ServerLib.make_record (ServerLib.add_field ServerLib.empty_record_constructor (fserver) x)
let rnothing = ServerLib.make_record (ServerLib.add_field ServerLib.empty_record_constructor (fnone) (ServerLib.make_record ServerLib.empty_record_constructor))
let rfree = ServerLib.make_record (ServerLib.add_field ServerLib.empty_record_constructor (ffree) (ServerLib.make_record ServerLib.empty_record_constructor))
##opa-type ThreadContext.t
##opa-type ThreadContext.client
##opa-type outcome('a, 'b)
(** Project an ['a -> void] opa function rewrited by cps to an ['a ->
unit] ml function, usefull for [cps-bypass].
['a, continuation(opa[void]) -> void] => ['a -> unit]
@param pk Parent continuation
let proj_cps pk f =
fun x -> f x (QmlCpsServerLib.ccont_ml pk (fun (_:ServerLib.ty_void) -> ()))
let proj_cps0 pk f =
fun () -> f (QmlCpsServerLib.ccont_ml pk (fun (_:ServerLib.ty_void) -> ()))
(** Create an opa thread context *)
(* ThreadContext: Be careful, Thread context is hard coded here. Change it if you change type *)
let create_ctx key request =
let rkey = match key with
| `client client -> rclient client
| `server server -> rserver server
| `nothing -> rnothing in
let rreq = match request with
| None -> rnone
| Some (req, con) ->
let req (*opa HttpRequest.request *) =
ServerLib.make_record (
ServerLib.add_field (
freq req)
fcon con)
rsome req in
let rdetails = rnone in
let rconstraint = rfree in
(ServerLib.add_field ServerLib.empty_record_constructor (fkey) rkey)
(freq) rreq)
(fdetails) rdetails)
(fconstraint) rconstraint)
let get_serverkey context =
let rkey = ServerLib.unsafe_dot context fkey in rkey fserver
let create_outcome = function
| `success success ->
(ServerLib.add_field ServerLib.empty_record_constructor
fsuccess success))
| `failure failure ->
(ServerLib.add_field ServerLib.empty_record_constructor
ffailure failure))
Jump to Line
Something went wrong with that request. Please try again.