Port to ppx

.gitignore

@@ -18,3 +18,5 @@ _install/
 *.native
 *.byte
 *.xl
+ppx
+*.mlh

Makefile

@@ -2,16 +2,16 @@
 
 PREFIX ?= /usr/local/bin
 
-all:
+all: ppx
 	@./build.sh
 
-install:
+install: ppx
 	@./build.sh true
 
 clean:
-	rm -rf _build _install
+	rm -rf _build _install ppx lib/conduit_config.mlh
 
-doc:
+doc: ppx
 	@BUILD_DOC=true ./build.sh
 
 github: doc
@@ -39,3 +39,7 @@ release:
 pr:
 	opam publish prepare $(NAME).$(VERSION) $(ARCHIVE)
 	OPAMYES=1 opam publish submit $(NAME).$(VERSION) && rm -rf $(NAME).$(VERSION)
+
+ppx:
+	ocamlfind ocamlopt -predicates ppx_driver -o ppx -linkpkg \
+	  -package ppx_sexp_conv ppx_driver_runner.cmxa

build.sh

@@ -4,20 +4,9 @@ TAGS=principal,annot,bin_annot,short_paths,thread,strict_sequence
 J_FLAG=2
 
 BASE_PKG="sexplib ipaddr cstruct uri stringext"
-SYNTAX_PKG="camlp4.macro pa_sexp_conv"
-
-# The Async backend is only supported in OCaml 4.01.0+
-OCAML_VERSION=`ocamlc -version`
-case $OCAML_VERSION in
-4.01.*|4.00.*|3.*)
-  echo Minimum OCaml version is 4.02
-  ;;
-*)
+
 HAVE_ASYNC=`ocamlfind query async 2>/dev/null || true`
 HAVE_ASYNC_SSL=`ocamlfind query async_ssl 2>/dev/null || true`
-;;
-esac
-
 HAVE_LWT=`ocamlfind query lwt 2>/dev/null || true`
 HAVE_LWT_SSL=`ocamlfind query lwt.ssl 2>/dev/null || true`
 HAVE_LWT_TLS=`ocamlfind query tls.lwt 2>/dev/null || true`
@@ -35,7 +24,25 @@ add_pkg () {
   PKG="$PKG $1"
 }
 
-add_pkg "$SYNTAX_PKG"
+mlh_exp() {
+  if [ "$1" != "" ]; then
+    echo "#let $2 = true" >> lib/conduit_config.mlh
+  else
+    echo "#let $2 = false" >> lib/conduit_config.mlh
+  fi
+}
+
+mlh_exp "$HAVE_ASYNC" HAVE_ASYNC
+mlh_exp "$HAVE_ASYNC_SSL" HAVE_ASYNC_SSL
+mlh_exp "$HAVE_LWT" HAVE_LWT
+mlh_exp "$HAVE_LWT_SSL" HAVE_LWT_SSL
+mlh_exp "$HAVE_LWT_TLS" HAVE_LWT_TLS
+mlh_exp "$HAVE_MIRAGE" HAVE_MIRAGE
+mlh_exp "$HAVE_MIRAGE_TLS" HAVE_MIRAGE_TLS
+mlh_exp "$HAVE_VCHAN" HAVE_VCHAN
+mlh_exp "$HAVE_VCHAN_LWT" HAVE_VCHAN_LWT
+mlh_exp "$HAVE_LAUNCHD_LWT" HAVE_LAUNCHD_LWT
+
 add_pkg "$BASE_PKG"
 add_target "conduit"
 rm -f lib/*.odocl
@@ -48,7 +55,9 @@ rm -f _tags
 rm -rf _install
 mkdir -p _install
 
-echo 'true: syntax(camlp4o)' >> _tags
+echo "true: config" >> _tags
+
+echo "true: pp($(pwd)/ppx)" >> _tags
 
 if [ "$HAVE_ASYNC" != "" ]; then
   echo "Building with Async support."
@@ -59,7 +68,6 @@ if [ "$HAVE_ASYNC" != "" ]; then
 
   if [ "$HAVE_ASYNC_SSL" != "" ]; then
     echo "Building with Async/SSL support."
-    echo 'true: define(HAVE_ASYNC_SSL)' >> _tags
     ASYNC_REQUIRES="$ASYNC_REQUIRES async_ssl"
     echo Conduit_async_ssl >> lib/conduit-async.mllib
   fi
@@ -80,14 +88,12 @@ if [ "$HAVE_LWT" != "" ]; then
 
   if [ "$HAVE_LWT_SSL" != "" ]; then
     echo "Building with Lwt/SSL support."
-    echo 'true: define(HAVE_LWT_SSL)' >> _tags
     LWT_UNIX_REQUIRES="$LWT_UNIX_REQUIRES lwt.ssl"
     echo Conduit_lwt_unix_ssl >> lib/conduit-lwt-unix.mllib
   fi
 
   if [ "$HAVE_LWT_TLS" != "" ]; then
     echo "Building with Lwt/TLS support."
-    echo 'true: define(HAVE_LWT_TLS)' >> _tags
     LWT_UNIX_REQUIRES="$LWT_UNIX_REQUIRES tls tls.lwt"
     echo Conduit_lwt_tls >> lib/conduit-lwt-unix.mllib
   fi
@@ -97,20 +103,17 @@ if [ "$HAVE_LWT" != "" ]; then
 
   if [ "$HAVE_MIRAGE" != "" ]; then
     echo "Building with Mirage support."
-    echo 'true: define(HAVE_MIRAGE)' >> _tags
     echo Conduit_mirage > lib/conduit-lwt-mirage.mllib
     echo Resolver_mirage >> lib/conduit-lwt-mirage.mllib
     MIRAGE_REQUIRES="mirage-types dns.mirage uri.services"
     if [ "$HAVE_VCHAN" != "" ]; then
       echo "Building with Mirage Vchan support."
-      echo 'true: define(HAVE_VCHAN)' >> _tags
       MIRAGE_REQUIRES="$MIRAGE_REQUIRES vchan"
       echo Conduit_xenstore >> lib/conduit-lwt-mirage.mllib
       echo '"scripts/xenstore-conduit-init" {"xenstore-conduit-init"}' > _install/bin
     fi
     if [ "$HAVE_MIRAGE_TLS" != "" ]; then
       echo "Building with Mirage TLS support."
-      echo 'true: define(HAVE_MIRAGE_TLS)' >> _tags
       MIRAGE_REQUIRES="$MIRAGE_REQUIRES tls tls.mirage"
     fi
     add_target "conduit-lwt-mirage"
@@ -121,13 +124,11 @@ fi
 
 if [ "$HAVE_VCHAN_LWT" != "" ]; then
     echo "Building with Vchan Lwt_unix support."
-    echo 'true: define(HAVE_VCHAN_LWT)' >> _tags
     VCHAN_LWT_REQUIRES="vchan.lwt"
 fi
 
 if [ "$HAVE_LAUNCHD_LWT" != "" ]; then
     echo "Building with Launchd Lwt_unix support."
-    echo 'true: define(HAVE_LAUNCHD_LWT)' >> _tags
     LAUNCHD_LWT_REQUIRES="launchd.lwt"
 fi
 

lib/conduit.ml

@@ -26,7 +26,7 @@ type endp = [
   | `Vchan_domain_socket of string * string
   | `TLS of string * endp         (** wrap in a TLS channel, [hostname,endp] *)
   | `Unknown of string            (** failed resolution *)
-] with sexp
+] [@@deriving sexp]
 
 module type IO = sig
   type +'a t

lib/conduit.mli

@@ -56,7 +56,7 @@ type endp = [
   | `Vchan_domain_socket of string * string (** Vchan Xen domain socket *)
   | `TLS of string * endp          (** Wrap in a TLS channel, [hostname,endp] *)
   | `Unknown of string             (** Failed resolution *)
-] with sexp
+] [@@deriving sexp]
 
 (** Module type for cooperative threading that can be satisfied by
     Lwt or Async *)

lib/conduit_async.ml

@@ -15,25 +15,27 @@
  *
  *)
 
+#import "conduit_config.mlh"
+
 open Core.Std
 open Async.Std
 
-exception Ssl_unsupported with sexp
+exception Ssl_unsupported [@@deriving sexp]
 
-IFDEF HAVE_ASYNC_SSL THEN
+#if HAVE_ASYNC_SSL
 open Async_ssl.Std
-END
+#endif
 
 module Ssl = struct
-IFDEF HAVE_ASYNC_SSL THEN
+#if HAVE_ASYNC_SSL
   type config = {
     version : Ssl.Version.t option;
     name : string option;
     ca_file : string option;
     ca_path : string option;
     session : Ssl.Session.t option sexp_opaque;
     verify : (Ssl.Connection.t -> bool Deferred.t) option;
-  } with sexp
+  } [@@deriving sexp]
 
   let verify_certificate connection =
     match Ssl.Connection.peer_certificate connection with
@@ -43,15 +45,15 @@ IFDEF HAVE_ASYNC_SSL THEN
 
   let configure ?version ?name ?ca_file ?ca_path ?session ?verify () =
     { version; name; ca_file; ca_path; session; verify}
-ELSE
-  type config = unit with sexp
+#else
+  type config = unit [@@deriving sexp]
 
   let verify_certificate _ =
     raise Ssl_unsupported
 
   let configure ?version ?name ?ca_file ?ca_path ?session ?verify () =
     raise Ssl_unsupported
-END
+#endif
 end
 
 type +'a io = 'a Deferred.t
@@ -63,7 +65,7 @@ type addr = [
   | `OpenSSL_with_config of string * Ipaddr.t * int * Ssl.config
   | `TCP of Ipaddr.t * int
   | `Unix_domain_socket of string
-] with sexp
+] [@@deriving sexp]
 
 let connect ?interrupt dst =
   match dst with
@@ -72,24 +74,24 @@ let connect ?interrupt dst =
       >>= fun (_, rd, wr) -> return (rd,wr)
   end
   | `OpenSSL (host, ip, port) -> begin
-IFDEF HAVE_ASYNC_SSL THEN
+#if HAVE_ASYNC_SSL
       Tcp.connect ?interrupt (Tcp.to_host_and_port (Ipaddr.to_string ip) port)
       >>= fun (_, rd, wr) ->
       Conduit_async_ssl.ssl_connect rd wr
-ELSE
+#else
       raise Ssl_unsupported
-END
+#endif
   end
   | `OpenSSL_with_config (host, ip, port, config) -> begin
-IFDEF HAVE_ASYNC_SSL THEN
+#if HAVE_ASYNC_SSL
       Tcp.connect ?interrupt (Tcp.to_host_and_port (Ipaddr.to_string ip) port)
       >>= fun (_, rd, wr) ->
       let open Ssl in
       match config with | {version; name; ca_file; ca_path; session; verify} ->
       Conduit_async_ssl.ssl_connect ?version ?name ?ca_file ?ca_path ?session ?verify rd wr
-ELSE
+#else
       raise Ssl_unsupported
-END
+#endif
   end
   | `Unix_domain_socket file -> begin
       Tcp.connect ?interrupt (Tcp.to_file file)
@@ -103,23 +105,23 @@ type trust_chain = [
   | `Search_file_first_then_path of
       [ `File of string ] *
       [ `Path of string ]
-] with sexp
+] [@@deriving sexp]
 
 type openssl = [
   | `OpenSSL of
       [ `Crt_file_path of string ] *
       [ `Key_file_path of string ]
-] with sexp
+] [@@deriving sexp]
 
 type requires_async_ssl = [
   | openssl
   | `OpenSSL_with_trust_chain of openssl * trust_chain
-] with sexp
+] [@@deriving sexp]
 
 type server = [
   | `TCP
   | requires_async_ssl
-] with sexp
+] [@@deriving sexp]
 
 let serve
       ?max_connections
@@ -128,7 +130,7 @@ let serve
     match mode with
     | `TCP -> handle_request sock rd wr
     | #requires_async_ssl as async_ssl ->
-IFDEF HAVE_ASYNC_SSL THEN
+#if HAVE_ASYNC_SSL
         let (crt_file, key_file, ca_file, ca_path) =
           match async_ssl with
           | `OpenSSL (`Crt_file_path crt_file, `Key_file_path key_file) ->
@@ -146,9 +148,9 @@ IFDEF HAVE_ASYNC_SSL THEN
         in
         Conduit_async_ssl.ssl_listen ?ca_file ?ca_path ~crt_file ~key_file rd wr
         >>= fun (rd,wr) -> handle_request sock rd wr
-ELSE
+#else
         raise Ssl_unsupported
-END
+#endif
     in
     Tcp.Server.create ?max_connections
       ?buffer_age_limit ?on_handler_error

lib/conduit_async.mli

@@ -17,20 +17,21 @@
 
 (** Connection establishment using the
     {{:https://github.com/janestreet/async}Async} library *)
+#import "conduit_config.mlh"
 
 open Core.Std
 open Async.Std
 
-exception Ssl_unsupported with sexp
+exception Ssl_unsupported [@@deriving sexp]
 
-IFDEF HAVE_ASYNC_SSL THEN
+#if HAVE_ASYNC_SSL
 open Async_ssl.Std
-END
+#endif
 
 module Ssl : sig
   type config
 
-IFDEF HAVE_ASYNC_SSL THEN
+#if HAVE_ASYNC_SSL
   val verify_certificate :
     Ssl.Connection.t ->
     bool Deferred.t
@@ -44,7 +45,7 @@ IFDEF HAVE_ASYNC_SSL THEN
     ?verify:(Ssl.Connection.t -> bool Deferred.t) ->
     unit ->
     config
-ELSE
+#else
   val verify_certificate :
     'a ->
     bool Deferred.t
@@ -58,7 +59,7 @@ ELSE
     ?verify:'f ->
     unit ->
     config
-END
+#endif
 end
 
 type +'a io = 'a Deferred.t
@@ -70,7 +71,7 @@ type addr = [
   | `OpenSSL_with_config of string * Ipaddr.t * int * Ssl.config
   | `TCP of Ipaddr.t * int
   | `Unix_domain_socket of string
-] with sexp
+] [@@deriving sexp]
 
 val connect : ?interrupt:unit io -> addr -> (ic * oc) io
 
@@ -80,20 +81,20 @@ type trust_chain =
   | `Search_file_first_then_path of
       [ `File of string ] *
       [ `Path of string ]
-  ] with sexp
+  ] [@@deriving sexp]
 
 type openssl =
   [ `OpenSSL of
       [ `Crt_file_path of string ] *
       [ `Key_file_path of string ]
-  ] with sexp
+  ] [@@deriving sexp]
 
 type server = [
   | openssl
   | `TCP
   | `OpenSSL_with_trust_chain of
       (openssl * trust_chain)
-] with sexp
+] [@@deriving sexp]
 
 val serve :
   ?max_connections:int ->