Merge pull request #204 from thedufer/let-syntax

add both native and ppx let-syntax support, and corresponding tests

.travis.yml

@@ -10,6 +10,7 @@ env:
   - PINS="angstrom-async:. angstrom-lwt-unix:. angstrom:."
   - PACKAGE="angstrom"
   - TESTS=true
+  - EXTRA_DEPS="ppx_let"
   - POST_INSTALL_HOOK="opam install --with-test angstrom-async angstrom-lwt-unix && opam exec -- make examples"
   matrix:
   - OCAML_VERSION="4.08"

angstrom.opam

@@ -12,10 +12,12 @@ build: [
 ]
 depends: [
   "ocaml" {>= "4.04.0"}
-  "dune" {>= "1.0"}
+  "dune" {>= "1.8"}
   "alcotest" {with-test & >= "0.8.1"}
   "bigstringaf"
   "result"
+  "ppx_let" {with-test & >= "0.14.0"}
+  "ocaml-syntax-shims" {build}
 ]
 synopsis: "Parser combinators built for speed and memory-efficiency"
 description: """

dune-project

@@ -1,2 +1,2 @@
-(lang dune 1.0)
+(lang dune 1.8)
 (name angstrom)

lib/angstrom.ml

@@ -571,6 +571,33 @@ let consume_with p f =
 let consumed           p = consume_with p Bigstringaf.substring
 let consumed_bigstring p = consume_with p Bigstringaf.copy
 
+let both a b = lift2 (fun a b -> a, b) a b
+let map t ~f = t >>| f
+let bind t ~f = t >>= f
+let map2 a b ~f = lift2 f a b
+let map3 a b c ~f = lift3 f a b c
+let map4 a b c d ~f = lift4 f a b c d
+
+module Let_syntax = struct
+  let return = return
+  let ( >>| ) = ( >>| )
+  let ( >>= ) = ( >>= )
+
+  module Let_syntax = struct
+    let return = return
+    let map = map
+    let bind = bind
+    let both = both
+    let map2 = map2
+    let map3 = map3
+    let map4 = map4
+  end
+end
+
+let ( let+ ) = ( >>| )
+let ( let* ) = ( >>= )
+let ( and+ ) = both
+
 module BE = struct
   (* XXX(seliopou): The pattern in both this module and [LE] are a compromise
    * between efficiency and code reuse. By inlining [ensure] you can recover

lib/angstrom.mli

@@ -271,6 +271,10 @@ val option : 'a -> 'a t -> 'a t
 (** [option v p] runs [p], returning the result of [p] if it succeeds and [v]
     if it fails. *)
 
+
+val both : 'a t -> 'b t -> ('a * 'b) t
+(** [both p q] runs [p] followed by [q] and returns both results in a tuple *)
+
 val list : 'a t list -> 'a list t
 (** [list ps] runs each [p] in [ps] in sequence, returning a list of results of
     each [p]. *)
@@ -387,6 +391,9 @@ val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
 (** [p >>= f] creates a parser that will run [p], pass its result to [f], run
     the parser that [f] produces, and return its result. *)
 
+val bind : 'a t -> f:('a -> 'b t) -> 'b t
+(** [bind] is a prefix version of [>>=] *)
+
 val (>>|) : 'a t -> ('a -> 'b) -> 'b t
 (** [p >>| f] creates a parser that will run [p], and if it succeeds with
     result [v], will return [f v] *)
@@ -426,6 +433,34 @@ val lift4 : ('a -> 'b -> 'c -> 'd -> 'e) -> 'a t -> 'b t -> 'c t -> 'd t -> 'e t
     Even with the partial application, it will be more efficient than the
     applicative implementation. *)
 
+val map : 'a t -> f:('a -> 'b) -> 'b t
+val map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t
+val map3 : 'a t -> 'b t -> 'c t -> f:('a -> 'b -> 'c -> 'd) -> 'd t
+val map4 : 'a t -> 'b t -> 'c t -> 'd t -> f:('a -> 'b -> 'c -> 'd -> 'e) -> 'e t
+(** The [mapn] family of functions are just like [liftn], with a slightly
+    different interface. *)
+
+(** The [Let_syntax] module is intended to be used with the [ppx_let]
+    pre-processor, and just contains copies of functions described elsewhere. *)
+module Let_syntax : sig
+  val return : 'a -> 'a t
+  val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t
+  val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
+
+  module Let_syntax : sig
+    val return : 'a -> 'a t
+    val map : 'a t -> f:('a -> 'b) -> 'b t
+    val bind : 'a t -> f:('a -> 'b t) -> 'b t
+    val both : 'a t -> 'b t -> ('a * 'b) t
+    val map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t
+    val map3 : 'a t -> 'b t -> 'c t -> f:('a -> 'b -> 'c -> 'd) -> 'd t
+    val map4 : 'a t -> 'b t -> 'c t -> 'd t -> f:('a -> 'b -> 'c -> 'd -> 'e) -> 'e t
+  end
+end
+
+val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
+val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
+val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
 
 (** Unsafe Operations on Angstrom's Internal Buffer
 

lib/dune

@@ -2,4 +2,5 @@
  (name angstrom)
  (public_name angstrom)
  (libraries bigstringaf)
- (flags :standard -safe-string))
+ (flags :standard -safe-string)
+ (preprocess future_syntax))

lib_test/dune

@@ -1,5 +1,15 @@
+(library
+ (name angstrom_test)
+ (libraries angstrom)
+ (flags :standard -safe-string)
+ (modules test_let_syntax_native test_let_syntax_ppx)
+ (preprocess
+  (per_module
+   (future_syntax test_let_syntax_native)
+   ((pps ppx_let) test_let_syntax_ppx))))
+
 (executables
- (libraries alcotest angstrom)
+ (libraries alcotest angstrom angstrom_test)
  (modules test_angstrom)
  (names test_angstrom))
 
@@ -14,4 +24,4 @@
  (deps
   (:< test_angstrom.exe))
  (action
-  (run %{<})))
+  (run %{<})))

lib_test/test_let_syntax_native.ml

@@ -0,0 +1,11 @@
+open Angstrom
+
+let (_ : int t) =
+  let* () = end_of_input in
+  return 1
+
+let (_ : int t) =
+  let+ (_ : char) = any_char
+  and+ (_ : string) = string "foo"
+  in
+  2

lib_test/test_let_syntax_ppx.ml

@@ -0,0 +1,22 @@
+open Angstrom
+open Let_syntax
+
+let (_ : int t) =
+  let%bind () = end_of_input in
+  return 1
+
+let (_ : int t) =
+  let%map (_ : char) = any_char
+  and (_ : string) = string "foo"
+  in
+  2
+
+(* [mapn] support was introduced in ppx_let.v0.14.0, which CI does not reliably
+  install. *)
+(*
+let (_ : int t) =
+  let%mapn (_ : char) = any_char
+  and (_ : string) = string "foo"
+  in
+  2
+*)