Merge pull request #1 from benbellick/prepare-for-release

Prepare for release

.github/workflows/main.yaml

@@ -0,0 +1,23 @@
+name: Build and test
+on: [push]
+jobs:
+  build-and-test:
+    strategy:
+      fail-fast: false
+      matrix:
+        os:
+          - ubuntu-latest
+          - macos-latest
+          - windows-latest
+
+    runs-on: ${{ matrix.os }}    
+    steps:
+      - name: Check out repository code
+        uses: actions/checkout@v4
+      - name: Set-up OCaml
+        uses: ocaml/setup-ocaml@v3
+        with:
+          ocaml-compiler: 5
+      - run: opam install . --deps-only --with-test
+      - run: opam exec -- dune build
+      - run: opam exec -- dune runtest        

README.md

@@ -0,0 +1,195 @@
+# ppx_deriving_decoders: Automatically write mattjbray/ocaml-decoders
+
+[mattjbray/ocaml-decoders](https://github.com/mattjbray/ocaml-decoders) is an excellent library for writing decoders using decoding combinators. However, writing out decoders by hand for more complicated types can be quite time-intensive. 
+
+This library helps by automatically producing the appropriate decoder for a particular type. 
+
+There are two primary ways in which this library can be of use. (More details of both follows.)
+
+1. "I want to write a (e.g. JSON) decoder for a particular type but don't care about the details" --> You can then use this library via `[@@deriving decoders]` applied to your types. 
+2. "I want to write a (e.g. JSON) decoder for a particular type, but I care a lot about how it works and just want a good starting place" --> You can use this library via `[@@deriving_inline decoders]` applied to your types to generate the implementation in place.
+
+> [!WARNING]
+> This is still a fairly experimental library. Use at your own risk! If you would like to use it and be extra safe, use approach 2 above, by using the library to generate boilerplate and then removing the dependency in production code. 
+
+## Getting Started
+
+```
+opam install ppx_deriving_decoders
+```
+
+The implementation is agnostic to the underlying decoders back-end. The only requirement is the presence of a module with the signature [`Decoders.Decode.S`](https://github.com/mattjbray/ocaml-decoders/blob/59c0dfbe6026af27fce96af82e650a875157385d/src/sig.ml#L8) as specified in [mattjbray/ocaml-decoders](https://github.com/mattjbray/ocaml-decoders), which is aliased to module `D`.
+
+E.g., if you wanted to decode using `yojson`, you could use 
+```
+opam install decoders-yojson
+```
+
+## Just generate the decoder for me
+
+Suppose we have the following file: 
+
+```ocaml
+(* In file foo.ml *)
+
+type bar = Int of int | String of string
+```
+
+To generate a decoder for `bar`, first add the preprocessing directive to the appropriate dune file: 
+```lisp
+ (preprocess (pps ppx_deriving_decoders))
+```
+
+Then just add an implementer of `Decoders.Decode.S` to the file, aliased to `D`, and add the deriving extension:
+```ocaml
+(* In file foo.ml *)
+module D = Decoders_yojson.Safe.Decode
+
+type bar = Int of int | String of string [@@deriving decoders]
+```
+
+After doing this, you will have available in this module a value `bar_decoder` of type `bar D.decoder`. Then you'll be able to use this decoder freely, e.g.:
+```ocaml
+let () = assert (
+  match D.decode_string my_basic_cstr_decoder {|{"Int": [10]}|} with
+  | Ok b -> b = Int 10
+  | Error _ -> false
+)
+```
+
+## Only get the decoder started for me
+Suppose we have the same file again:
+```ocaml
+(* In file foo.ml *)
+
+type bar = Int of int | String of string
+```
+To generate a decoder for `bar`, we again first add the preprocessing directive to the appropriate dune file: 
+```lisp
+ (preprocess (pps ppx_deriving_decoders))
+```
+We change the file to be
+```ocaml
+(* In file foo.ml *)
+module D = Decoders_yojson.Safe.Decode
+
+type bar = Int of int | String of string [@@deriving_inline decoders]
+
+[@@@deriving.end]
+```
+
+Then, after running `dune build --auto-promote`, our file will become:
+```ocaml
+(* In file foo.ml *)
+module D = Decoders_yojson.Safe.Decode
+
+type bar = Int of int | String of string [@@deriving_inline decoders]
+
+let _ = fun (_ : bar) -> ()
+let bar_decoder =
+  let open D in
+    one_of
+      [("Int",
+         (D.field "Int"
+            (let open D in
+               let (>>=::) fst rest = uncons rest fst in
+               D.int >>=:: (fun arg0 -> succeed (Int arg0)))));
+      ("String",
+        (D.field "String"
+           (let open D in
+              let (>>=::) fst rest = uncons rest fst in
+              D.string >>=:: (fun arg0 -> succeed (String arg0)))))]
+let _ = bar_decoder
+[@@@deriving.end]
+```
+
+You can now freely remove the deriving attributes, and edit the decoder as you see fit!
+
+## More complicated example
+The following file:
+```ocaml
+(* In file foo.ml *)
+module D = Decoders_yojson.Safe.Decode
+
+type expr = Num of int | BinOp of op * expr * expr
+
+and op = Add | Sub | Mul | Div
+
+[@@@deriving.end]
+```
+after invoking `dune build --auto-promote` will yield:
+```ocaml 
+(* In file foo.ml *)
+module D = Decoders_yojson.Safe.Decode
+
+type expr = Num of int | BinOp of op * expr * expr
+
+and op = Add | Sub | Mul | Div
+[@@deriving decoders] [@@deriving_inline decoders]
+
+let _ = fun (_ : expr) -> ()
+let _ = fun (_ : op) -> ()
+[@@@ocaml.warning "-27"]
+let expr_decoder op_decoder =
+  D.fix
+    (fun expr_decoder_aux ->
+       let open D in
+         one_of
+           [("Num",
+              (D.field "Num"
+                 (let open D in
+                    let (>>=::) fst rest = uncons rest fst in
+                    D.int >>=:: (fun arg0 -> succeed (Num arg0)))));
+           ("BinOp",
+             (D.field "BinOp"
+                (let open D in
+                   let (>>=::) fst rest = uncons rest fst in
+                   op_decoder >>=::
+                     (fun arg0 ->
+                        expr_decoder_aux >>=::
+                          (fun arg1 ->
+                             expr_decoder_aux >>=::
+                               (fun arg2 ->
+                                  succeed (BinOp (arg0, arg1, arg2))))))))])
+let _ = expr_decoder
+let op_decoder op_decoder =
+  let open D in
+    one_of
+      [("Add",
+         (D.string >>=
+            ((function | "Add" -> succeed Add | _ -> fail "Failure"))));
+      ("Sub",
+        (D.string >>=
+           ((function | "Sub" -> succeed Sub | _ -> fail "Failure"))));
+      ("Mul",
+        (D.string >>=
+           ((function | "Mul" -> succeed Mul | _ -> fail "Failure"))));
+      ("Div",
+        (D.string >>=
+           ((function | "Div" -> succeed Div | _ -> fail "Failure"))))]
+let _ = op_decoder
+let op_decoder = D.fix op_decoder
+let _ = op_decoder
+let expr_decoder = expr_decoder op_decoder
+let _ = expr_decoder
+[@@@ocaml.warning "+27"]
+[@@@deriving.end]
+```
+Notice that the mutual recursion is handled for you!
+
+## Limitations
+- Some of the decoders can be quite complicated relative to what you would write by hand
+- There is not great support for types which feature type variables
+- There are a lot of rough edges in places like: 
+  - Error reporting
+  - Correctly handling `loc`
+
+## Future Work
+- [ ] Automatically generate corresponding encoders which are inverses of the decoders
+- [ ] Better handling of type variables 
+- [ ] Simplify generated decoders
+- [ ] Generate decoders from a module
+
+## Contributing
+
+Contributions are always welcome. Please create an issue as appropriate, and open a PR into the `main` branch and I'll have a look :) 

dune-project

@@ -4,23 +4,32 @@
 
 (generate_opam_files true)
 
+(version 0.1)
+
 (source
  (github benbellick/ppx_deriving_decoders))
 
 (authors "Ben Bellick")
 
 (maintainers "Ben Bellick")
 
-(license LICENSE)
+(license MIT)
 
-(documentation https://url/to/documentation)
+(documentation https://github.com/benbellick/ppx_deriving_decoders)
 
 (package
  (name ppx_deriving_decoders)
  (synopsis "Deriving Decoders using PPX")
- (description "A longer description")
- (depends ocaml dune ppxlib decoders containers decoders-yojson)
+ (description "Using mattjbray/ocaml-decoders, use a ppx to automatically \
+              generate instances of a decoder for a particular type using PPX.")
+ (depends
+   ocaml
+   dune
+   ppxlib
+   decoders
+   containers
+  (decoders-yojson :with-test)
+  (ppx_inline_test :with-test))
  (tags
-  (topics "to describe" your project)))
+  (topics "decoders" "decoding" "json" "ppx")))
 
-; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project

ppx_deriving_decoders.opam

@@ -1,21 +1,24 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
+version: "0.1"
 synopsis: "Deriving Decoders using PPX"
-description: "A longer description"
+description:
+  "Using mattjbray/ocaml-decoders, use a ppx to automatically generate instances of a decoder for a particular type using PPX."
 maintainer: ["Ben Bellick"]
 authors: ["Ben Bellick"]
-license: "LICENSE"
-tags: ["topics" "to describe" "your" "project"]
+license: "MIT"
+tags: ["topics" "decoders" "decoding" "json" "ppx"]
 homepage: "https://github.com/benbellick/ppx_deriving_decoders"
-doc: "https://url/to/documentation"
+doc: "https://github.com/benbellick/ppx_deriving_decoders"
 bug-reports: "https://github.com/benbellick/ppx_deriving_decoders/issues"
 depends: [
   "ocaml"
   "dune" {>= "3.11"}
   "ppxlib"
   "decoders"
   "containers"
-  "decoders-yojson"
+  "decoders-yojson" {with-test}
+  "ppx_inline_test" {with-test}
   "odoc" {with-doc}
 ]
 build: [

src/expander.ml

@@ -16,6 +16,37 @@ let apply_substitution ~orig ~substi =
   in
   mapper#expression
 
+let generate_attribute v ~loc =
+  let open Ast_builder.Default in
+  pstr_attribute ~loc
+    (attribute ~loc
+       ~name:(Located.mk ~loc "ocaml.warning")
+       ~payload:(PStr [ pstr_eval ~loc (estring ~loc v) [] ]))
+
+let suppress_warning_27 ~loc = generate_attribute ~loc "-27"
+let enforce_warning_27 ~loc = generate_attribute ~loc "+27"
+
+let wrap_27 xs =
+  (suppress_warning_27 ~loc:Location.none :: xs)
+  @ [ enforce_warning_27 ~loc:Location.none ]
+
+(* let suppress_warning_27 = *)
+(*   let suppress_warning_27 = *)
+(*     let loc = Location.none in *)
+(*     let payload = *)
+(*       PStr *)
+(*         [ *)
+(*           Ast_helper.Str.eval *)
+(*             (Ast_helper.Exp.constant (Pconst_string ("-27", loc, None))); *)
+(*         ] *)
+(*     in *)
+(*     let attr_name = "ocaml.warning"  *)
+
+(*   in *)
+(*   let attribute = Ast_builder.Default.attribute ~loc ~name:attr_name ~payload in *)
+(*   Ast_builder.Default.pstr_attribute ~loc attribute *)
+
+(* let enforce_warning_27 = _ *)
 let to_decoder_name i = i ^ "_decoder"
 
 let decoder_pvar_of_type_decl type_decl =
@@ -325,6 +356,24 @@ let rec mutual_rec_fun_gen ~loc
         pvar ~loc:type_decl.ptype_name.loc
           (to_decoder_name type_decl.ptype_name.txt)
       in
+      let substitutions =
+        match really_recursive Recursive [ type_decl ] with
+        | Recursive ->
+            let name = to_decoder_name type_decl.ptype_name.txt in
+            let substi = Ast_builder.Default.evar ~loc (name ^ "_aux") in
+            let new_substitution =
+              (core_type_of_type_declaration type_decl, substi)
+            in
+            (* TODO this should be bundled into a module *)
+            let updated_orig_substitutions =
+              let open CCList.Infix in
+              let+ typ, expr = substitutions in
+              let orig = decoder_evar_of_type_decl type_decl in
+              (typ, apply_substitution ~orig ~substi expr)
+            in
+            new_substitution :: updated_orig_substitutions
+        | Nonrecursive -> substitutions
+      in
       let imple =
         implementation_generator ~loc ~rec_flag:Recursive ~substitutions
           type_decl
@@ -352,6 +401,7 @@ let rec mutual_rec_fun_gen ~loc
       let new_substitution =
         (core_type_of_type_declaration type_decl, substi)
       in
+      (* TODO this should be bundled into a module *)
       let updated_orig_substitutions =
         let open CCList.Infix in
         let+ typ, expr = substitutions in
@@ -388,7 +438,9 @@ let str_gens ~(loc : location) ~(path : label)
   match (really_recursive rec_flag type_decls, type_decls) with
   | Nonrecursive, _ ->
       List.(flatten (map (single_type_decoder_gen ~loc ~rec_flag) type_decls))
-  | Recursive, [ type_decl ] -> single_type_decoder_gen ~loc ~rec_flag type_decl
+  | Recursive, [ type_decl ] ->
+      wrap_27 @@ single_type_decoder_gen ~loc ~rec_flag type_decl
   | Recursive, _type_decls ->
-      mutual_rec_fun_gen ~substitutions:[] ~loc type_decls
+      wrap_27
+      @@ mutual_rec_fun_gen ~substitutions:[] ~loc type_decls
       @ fix_mutual_rec_funs ~loc type_decls