├── .gitignore ├── .travis.yml ├── CHANGES.md ├── LICENSE.md ├── README.md ├── deriver ├── dune ├── ppx_enum.ml └── ppx_enum.mli ├── dune-project ├── lib ├── dune ├── enum.ml ├── enum.mli ├── raise.ml ├── raise.mli ├── utils.ml └── utils.mli ├── ppx_enum.opam └── test ├── deriver ├── dune ├── pp.ml ├── test_enum.expected.ml └── test_enum.ml └── lib ├── dune ├── test_ppx_enum_lib.ml ├── test_ppx_enum_lib.mli ├── test_utils.ml └── test_utils.mli /.gitignore: -------------------------------------------------------------------------------- 1 | *.install 2 | *.merlin 3 | _build 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: false 3 | services: 4 | - docker 5 | install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-docker.sh 6 | script: bash ./.travis-docker.sh 7 | env: 8 | global: 9 | - PACKAGE=ppx_enum 10 | - DISTRO=debian-stable 11 | matrix: 12 | - OCAML_VERSION=4.07 13 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## v0.0.2 2 | 3 | *2019-06-14* 4 | 5 | - Rename the deriver from `enum` to `str_enum` to avoid a naming conflict with `ppx_deriving.enum` 6 | 7 | ## v0.0.1 8 | 9 | *2019-05-27* 10 | 11 | - Initial release 12 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2019, Cryptosense SA All rights reserved. 2 | 3 | Redistribution and use in source and binary forms, with or without modification, are permitted 4 | provided that the following conditions are met: 5 | 6 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions 7 | and the following disclaimer. 8 | 9 | 2. Redistributions in binary form must reproduce the above copyright notice, this list of 10 | conditions and the following disclaimer in the documentation and/or other materials provided 11 | with the distribution. 12 | 13 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 14 | IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 15 | FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR 16 | CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 17 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 18 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 19 | IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF 20 | THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.com/cryptosense/ppx_enum.svg?branch=master)](https://travis-ci.com/cryptosense/ppx_enum) 2 | 3 | # ppx_enum 4 | 5 | `ppx_enum` is an OCaml preprocessor to derive enum-like modules from variant definitions. 6 | 7 | ## Overview 8 | 9 | Enums are bare variants that are intended to represent a flag that can have more values than just true and false. 10 | 11 | `ppx_enum` makes it easier to work with enums, in particular handling the conversion to and from strings. This is useful when (de)serializing values (for example, when serializing to store in a database), and cuts down on repetitive boilerplate code. 12 | 13 | Consider the following simple example: 14 | 15 | ```ocaml 16 | type my_enum = 17 | | Foo 18 | | Bar 19 | | Baz 20 | [@@deriving str_enum] 21 | ``` 22 | 23 | The use of `[@@deriving str_enum]` will generate the following functions: 24 | 25 | ```ocaml 26 | let my_enum_to_string = function 27 | | Foo -> "Foo" 28 | | Bar -> "Bar" 29 | | Baz -> "Baz" 30 | 31 | let my_enum_from_string = function 32 | | "Foo" -> Ok Foo 33 | | "Bar" -> Ok Bar 34 | | "Foo" -> Ok Foo 35 | | _ -> Error ... 36 | 37 | let my_enum_from_string_exn = function 38 | | "Foo" -> Foo 39 | | "Bar" -> Bar 40 | | "Foo" -> Foo 41 | | _ -> invalid_arg ... 42 | ``` 43 | 44 | ### Naming of Generated Functions 45 | 46 | Generally, the generated functions for type `mytype` will be `mytype_to_string`, `mytype_from_string` and `mytype_from_string_exn`. 47 | 48 | The only exception is when using `type t = ...`, in which case `to_string`, `from_string` and `from_string_exn` will be used. 49 | 50 | ## Installation and Usage 51 | 52 | You can install `ppx_enum` using [opam](https://opam.ocaml.org): 53 | ``` 54 | $ opam install ppx_enum 55 | ``` 56 | 57 | If you're building your library or app with dune, add the following field to your `library`, 58 | `executable` or `test` stanza: 59 | ``` 60 | (preprocess (pps ppx_enum)) 61 | ``` 62 | or simply add `ppx_enum` to your `preprocess` field if it's already there. 63 | 64 | You can now add the `enum` plugin to `[@@deriving ...]` attributes on variant type definitions. 65 | 66 | ## Customizing the Generated Functions 67 | 68 | ### Custom Values for Specific Variants 69 | 70 | It is possible to customize the string value that will be used to represent a specific variant by using an `[@value]` attribute. An example is worth 1000 words here: 71 | 72 | ```ocaml 73 | type myenum = 74 | | Foo [@value "baz"] 75 | | Bar 76 | [@deriving str_enum] 77 | 78 | my_enum_to_string Foo (* "baz" *) 79 | my_enum_to_string Bar (* "bar" *) 80 | 81 | my_enum_from_string "foo" (* Error ... *) 82 | my_enum_from_string "bar" (* Ok Bar *) 83 | my_enum_from_string "baz" (* Ok Foo *) 84 | ``` 85 | 86 | The attributes will accept any valid suffix of `ppx_enum.str_enum.value`, so the following will work: 87 | 88 | ```ocaml 89 | type myenum = 90 | | Foo [@value "foo-1"] 91 | | Bar [@str_enum.value "bar-1"] 92 | | Baz [@ppx_enum.str_enum.value "baz-1"] 93 | [@deriving str_enum] 94 | ``` 95 | -------------------------------------------------------------------------------- /deriver/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name ppx_enum) 3 | (kind ppx_deriver) 4 | (libraries 5 | ppx_enum_lib 6 | ppxlib 7 | ) 8 | ) 9 | -------------------------------------------------------------------------------- /deriver/ppx_enum.ml: -------------------------------------------------------------------------------- 1 | let enum = 2 | Ppxlib.Deriving.add 3 | "str_enum" 4 | ~str_type_decl:Ppx_enum_lib.Enum.from_str_type_decl 5 | ~sig_type_decl:Ppx_enum_lib.Enum.from_sig_type_decl 6 | -------------------------------------------------------------------------------- /deriver/ppx_enum.mli: -------------------------------------------------------------------------------- 1 | val enum : Ppxlib.Deriving.t 2 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.1) 2 | (name ppx_enum) 3 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ppx_enum_lib) 3 | (public_name ppx_enum._lib) 4 | (libraries 5 | ppxlib 6 | ) 7 | (preprocess 8 | (pps 9 | ppxlib.metaquot 10 | ) 11 | ) 12 | ) 13 | -------------------------------------------------------------------------------- /lib/enum.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | 3 | module Attr = struct 4 | let value = 5 | Attribute.declare 6 | "ppx_enum.str_enum.value" 7 | Attribute.Context.constructor_declaration 8 | Ast_pattern.(single_expr_payload (estring __)) 9 | (fun x -> x) 10 | 11 | let packed = [Attribute.T value] 12 | end 13 | 14 | module Str = struct 15 | let string_to_constant_expression ~loc ~str = 16 | Ast_builder.Default.pexp_constant 17 | ~loc 18 | (Pconst_string (str, None)) 19 | 20 | let string_to_constant_pattern ~loc ~str = 21 | Ast_builder.Default.ppat_constant 22 | ~loc 23 | (Pconst_string (str, None)) 24 | 25 | let string_to_constructor_pattern ~loc ~str = 26 | Ast_builder.Default.ppat_construct 27 | ~loc 28 | {txt = Lident str; loc} 29 | None 30 | 31 | let string_to_constructor_expression ~loc ~str = 32 | Ast_builder.Default.pexp_construct 33 | ~loc 34 | {txt = Lident str; loc} 35 | None 36 | 37 | let constructor_name_and_value ({pcd_name = {txt = name; _}; _} as constructor) = 38 | let attribute_value = Attribute.get Attr.value constructor in 39 | let value = 40 | match attribute_value with 41 | | Some value -> value 42 | | None -> name 43 | in 44 | (name, value) 45 | 46 | let to_string_case_from_name_and_value ~loc (name, value) = 47 | let lhs = string_to_constructor_pattern ~loc ~str:name in 48 | let rhs = string_to_constant_expression ~loc ~str:value in 49 | Ast_builder.Default.case ~lhs ~guard:None ~rhs 50 | 51 | let assert_no_duplicate_values ~loc constructor_details = 52 | let unique_values = List.sort_uniq String.compare @@ snd @@ List.split constructor_details in 53 | if List.compare_lengths constructor_details unique_values != 0 then 54 | Raise.Enum.errorf ~loc "cannot derive enum. Enums must have unique values" 55 | 56 | let to_string_constructor_cases ~loc constructors = 57 | let constructor_details = List.map constructor_name_and_value constructors in 58 | assert_no_duplicate_values ~loc constructor_details; 59 | List.map (to_string_case_from_name_and_value ~loc) constructor_details 60 | 61 | let to_string_function ~loc ~type_name ~constructors = 62 | let function_name = Utils.to_string_function_name ~enum_name:type_name in 63 | let pat = Ast_builder.Default.ppat_var ~loc {txt=function_name; loc} in 64 | let cases =to_string_constructor_cases ~loc constructors in 65 | let expr = 66 | Ast_builder.Default.pexp_function 67 | ~loc 68 | cases 69 | in 70 | let value_description = 71 | Ast_builder.Default.value_binding 72 | ~loc 73 | ~pat 74 | ~expr 75 | in 76 | Ast_builder.Default.pstr_value ~loc Nonrecursive [value_description] 77 | 78 | let from_string_case_from_name_and_value ~loc ~raises (name, value) = 79 | let lhs = string_to_constant_pattern ~loc ~str:value in 80 | let value_t = string_to_constructor_expression ~loc ~str:name in 81 | let rhs = 82 | if raises then 83 | value_t 84 | else 85 | [%expr Ok [%e value_t]] 86 | in 87 | Ast_builder.Default.case ~lhs ~guard:None ~rhs 88 | 89 | let from_string_constructor_cases ~loc ~raises constructors = 90 | constructors 91 | |> List.map constructor_name_and_value 92 | |> List.map (from_string_case_from_name_and_value ~loc ~raises) 93 | 94 | let invalid_case_for_from_string ~loc ~raises ~function_name = 95 | let lhs = [%pat? s] in 96 | let error_message = 97 | [%expr 98 | Printf.sprintf 99 | "Unexpected value for %s.%s: %s" 100 | __MODULE__ 101 | [%e string_to_constant_expression ~loc ~str:function_name] 102 | s 103 | ] 104 | in 105 | let rhs = 106 | if raises then 107 | [%expr invalid_arg [%e error_message]] 108 | else 109 | [%expr Error [%e error_message]] 110 | in 111 | Ast_builder.Default.case ~lhs ~guard:None ~rhs 112 | 113 | let from_string_function_base ~loc ~raises ~function_name ~constructors = 114 | let pat = Ast_builder.Default.ppat_var ~loc {txt=function_name; loc} in 115 | let cases = from_string_constructor_cases ~loc ~raises constructors in 116 | let cases = cases @ [invalid_case_for_from_string ~loc ~raises ~function_name] in 117 | let expr = Ast_builder.Default.pexp_function ~loc cases in 118 | let value_description = 119 | Ast_builder.Default.value_binding 120 | ~loc 121 | ~pat 122 | ~expr 123 | in 124 | Ast_builder.Default.pstr_value ~loc Nonrecursive [value_description] 125 | 126 | let from_string_function ~type_name = 127 | let function_name = Utils.from_string_function_name ~enum_name:type_name in 128 | from_string_function_base ~raises:false ~function_name 129 | 130 | let from_string_exn_function ~type_name = 131 | let function_name = Utils.from_string_exn_function_name ~enum_name:type_name in 132 | from_string_function_base ~raises:true ~function_name 133 | 134 | let from_enummable_variant 135 | ~loc 136 | ~type_name 137 | ~constructors 138 | = 139 | [ to_string_function ~loc ~type_name ~constructors 140 | ; from_string_function ~loc ~type_name ~constructors 141 | ; from_string_exn_function ~loc ~type_name ~constructors 142 | ] 143 | 144 | let from_type_declaration ~loc type_ = 145 | match type_ with 146 | | { ptype_kind = Ptype_variant constructors 147 | ; ptype_params = [] 148 | ; ptype_name = {txt = type_name; _} 149 | ; ptype_loc 150 | ; _ 151 | } 152 | when (Utils.constructors_are_bare constructors) 153 | -> 154 | from_enummable_variant ~loc:ptype_loc ~type_name ~constructors 155 | | {ptype_kind = Ptype_variant _; ptype_params = []; _} 156 | -> 157 | Raise.Enum.unhandled_type_kind ~loc "variant with arguments" 158 | | {ptype_kind = Ptype_variant _; ptype_params = _::_; _} 159 | -> 160 | Raise.Enum.unhandled_type_kind ~loc "parametrized variant" 161 | | {ptype_kind = Ptype_record _; _} 162 | -> 163 | Raise.Enum.unhandled_type_kind ~loc "record" 164 | | {ptype_kind = Ptype_abstract; _} 165 | -> 166 | Raise.Enum.unhandled_type_kind ~loc "abstract" 167 | | {ptype_kind = Ptype_open; _} 168 | -> 169 | Raise.Enum.unhandled_type_kind ~loc "open" 170 | 171 | (** By giving this to the Deriving.Generator.make_noarg function below, ppxlib 172 | * will apply the function the parameters: 173 | * ~loc: Information about the current location in the code base (file, lineno etc) 174 | * ~path: The current file path? 175 | * rec_flag: ??? 176 | * type_declarations: A list of the type declarations at the point of call 177 | *) 178 | let from_type_decl ~loc ~path:_ (_rec_flag, type_declarations) = 179 | List.flatten @@ List.map (from_type_declaration ~loc) type_declarations 180 | end 181 | 182 | module Sig = struct 183 | let to_string_function_val ~loc ~type_name = 184 | let function_name = Utils.to_string_function_name ~enum_name:type_name in 185 | let type_lident = {txt = Lident type_name; loc} in 186 | let lhs_type = Ast_builder.Default.ptyp_constr ~loc type_lident [] in 187 | let type_ = [%type: [%t lhs_type] -> string] in 188 | let value_description = 189 | Ast_builder.Default.value_description 190 | ~loc 191 | ~name:{txt = function_name; loc} 192 | ~type_ 193 | ~prim:[] 194 | in 195 | Ast_builder.Default.psig_value ~loc value_description 196 | 197 | let from_string_function_val_base ~loc ~raises ~function_name ~type_name = 198 | let type_lident = {txt = Lident type_name; loc} in 199 | let type_t = Ast_builder.Default.ptyp_constr ~loc type_lident [] in 200 | let rhs_type = 201 | if raises 202 | then 203 | type_t 204 | else 205 | [%type: ([%t type_t], string) result] 206 | in 207 | let type_ = [%type: string -> [%t rhs_type]] in 208 | let value_description = 209 | Ast_builder.Default.value_description 210 | ~loc 211 | ~name:{txt = function_name; loc} 212 | ~type_ 213 | ~prim:[] 214 | in 215 | Ast_builder.Default.psig_value ~loc value_description 216 | 217 | let from_string_function_val ~type_name = 218 | let function_name = Utils.from_string_function_name ~enum_name:type_name in 219 | from_string_function_val_base ~raises:false ~function_name ~type_name 220 | 221 | let from_string_exn_function_val ~type_name = 222 | let function_name = Utils.from_string_exn_function_name ~enum_name:type_name in 223 | from_string_function_val_base ~raises:true ~function_name ~type_name 224 | 225 | let assert_no_values_for_constructors ~loc constructors = 226 | let value_opts = List.map (Attribute.get Attr.value) constructors in 227 | let value_present = 228 | List.exists 229 | ( function 230 | | Some _ -> true 231 | | None -> false 232 | ) 233 | value_opts 234 | in 235 | if value_present then 236 | Raise.Enum.errorf ~loc "custom enum values must not be declared in signatures." 237 | 238 | 239 | let from_enummable_variant ~loc ~type_name = 240 | [ to_string_function_val ~loc ~type_name 241 | ; from_string_function_val ~loc ~type_name 242 | ; from_string_exn_function_val ~loc ~type_name 243 | ] 244 | 245 | let from_type_declaration ~loc type_ = 246 | match type_ with 247 | | { ptype_kind = Ptype_variant constructors 248 | ; ptype_params = [] 249 | ; ptype_name = {txt = type_name; _} 250 | ; ptype_loc 251 | ; _ 252 | } 253 | when Utils.constructors_are_bare constructors 254 | -> 255 | assert_no_values_for_constructors ~loc:ptype_loc constructors; 256 | from_enummable_variant ~loc:ptype_loc ~type_name 257 | | {ptype_kind = Ptype_variant _; ptype_params = []; _} 258 | -> 259 | Raise.Enum.unhandled_type_kind ~loc "variant with arguments" 260 | | {ptype_kind = Ptype_variant _; ptype_params = _::_; _} 261 | -> 262 | Raise.Enum.unhandled_type_kind ~loc "parametrized variant" 263 | | {ptype_kind = Ptype_record _; _} -> Raise.Enum.unhandled_type_kind ~loc "record" 264 | | {ptype_kind = Ptype_abstract; _} -> Raise.Enum.unhandled_type_kind ~loc "abstract" 265 | | {ptype_kind = Ptype_open; _} -> Raise.Enum.unhandled_type_kind ~loc "open" 266 | 267 | let from_type_decl ~loc ~path:_ (_rec_flag, type_declarations) = 268 | List.flatten @@ List.map (from_type_declaration ~loc) type_declarations 269 | end 270 | 271 | 272 | let from_str_type_decl = 273 | Deriving.Generator.make_noarg 274 | ~attributes:Attr.packed 275 | Str.from_type_decl 276 | 277 | let from_sig_type_decl = 278 | Deriving.Generator.make_noarg Sig.from_type_decl 279 | -------------------------------------------------------------------------------- /lib/enum.mli: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | 3 | (** Structure generator *) 4 | val from_str_type_decl : (structure, rec_flag * type_declaration list) Deriving.Generator.t 5 | 6 | (** Signature generator *) 7 | val from_sig_type_decl : (signature, rec_flag * type_declaration list) Deriving.Generator.t 8 | -------------------------------------------------------------------------------- /lib/raise.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | 3 | let errorf ~loc fmt = 4 | Printf.ksprintf (Location.raise_errorf ~loc "ppx_enum: %s") fmt 5 | 6 | module Enum = struct 7 | let errorf ~loc fmt = 8 | Printf.ksprintf (Location.raise_errorf ~loc "ppx_enum.enum: %s") fmt 9 | 10 | let unhandled_type_kind ~loc kind = 11 | errorf ~loc "cannot derive from %s type. Enums can only be derived from variants without arguments." kind 12 | end 13 | -------------------------------------------------------------------------------- /lib/raise.mli: -------------------------------------------------------------------------------- 1 | (** Functions to raise ppx errors in ppx_enum 2 | 3 | The [loc] argument should be the loc of the problematic node within the type declaration and not 4 | the [loc] argument of the generator to provide the user accurate information as to which part 5 | of the type declaration can't be handled. 6 | *) 7 | 8 | (** Raise an error with the formatted message prefixed by "ppx_enum: ". *) 9 | val errorf : loc: Ppxlib.Location.t -> ('a, unit, string, 'b) format4 -> 'a 10 | 11 | module Enum : sig 12 | (** Functions to raise errors specific to [[@@deriving enum]] *) 13 | 14 | (** Raise an error with the formatted message prefixed by "ppx_enum.enum: " *) 15 | val errorf : loc: Ppxlib.Location.t -> ('a, unit, string, 'b) format4 -> 'a 16 | 17 | (** Use when trying to derive an enum for an unhandled type kind. 18 | The message indicates factory can only be derived from variant types without arguments. 19 | *) 20 | val unhandled_type_kind : loc: Ppxlib.Location.t -> string -> 'a 21 | end 22 | -------------------------------------------------------------------------------- /lib/utils.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | 3 | let _prefix_from_enum_name = function 4 | | "t" -> "" 5 | | s -> s ^ "_" 6 | 7 | let to_string_function_name ~enum_name = (_prefix_from_enum_name enum_name) ^ "to_string" 8 | let from_string_function_name ~enum_name = (_prefix_from_enum_name enum_name) ^ "from_string" 9 | let from_string_exn_function_name ~enum_name = (_prefix_from_enum_name enum_name) ^ "from_string_exn" 10 | 11 | let constructor_is_bare constructor = 12 | match constructor with 13 | | {pcd_args = Pcstr_tuple []; pcd_res = None; _} -> true 14 | | _ -> false 15 | 16 | let constructors_are_bare constructors = 17 | List.for_all constructor_is_bare constructors 18 | 19 | -------------------------------------------------------------------------------- /lib/utils.mli: -------------------------------------------------------------------------------- 1 | (** The to_string function should be named foo_to_string for variant foo, and 2 | * just to_string for the special t variant 3 | *) 4 | val to_string_function_name : enum_name: string -> string 5 | 6 | (** The from_string function should be named foo_from_string for variant foo, and 7 | * just from_string for the special t variant 8 | *) 9 | val from_string_function_name : enum_name: string -> string 10 | 11 | (** The from_string_exn function should be named foo_from_string_exn for variant foo, and 12 | * just from_string_exn for the special t variant 13 | *) 14 | val from_string_exn_function_name : enum_name: string -> string 15 | 16 | (** Test whether a constructor is a "bare" constructor - that is it is 17 | * declared in the form 18 | * | Name 19 | * for some name 20 | *) 21 | val constructor_is_bare : Parsetree.constructor_declaration -> bool 22 | 23 | (** Test whether a list of constructors are all "bare" *) 24 | val constructors_are_bare : Parsetree.constructor_declaration list -> bool 25 | -------------------------------------------------------------------------------- /ppx_enum.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "Cryptosense " 3 | author: "James Owen " 4 | homepage: "https://github.com/cryptosense/ppx_enum" 5 | bug-reports: "https://github.com/cryptosense/ppx_enum/issues" 6 | license: "BSD-2" 7 | dev-repo: "git+https://github.com/cryptosense/ppx_enum.git" 8 | doc: "https://cryptosense.github.io/ppx_enum/doc" 9 | build: [ 10 | [ "dune" "build" "-p" name "-j" jobs ] 11 | ] 12 | run-test: [ 13 | [ "dune" "runtest" "-p" name "-j" jobs ] 14 | ] 15 | depends: [ 16 | "dune" {build} 17 | "ocaml" {>= "4.07.0"} 18 | "ounit" {with-test & >= "2.0.0"} 19 | "ppxlib" {>= "0.3.0"} 20 | "ppx_deriving" {with-test} 21 | ] 22 | tags: ["org:cryptosense"] 23 | synopsis: "PPX to derive enum-like modules from variant type definitions" 24 | description: """ 25 | This PPX derives simple enum-like modules from variant type definitions. 26 | """ 27 | -------------------------------------------------------------------------------- /test/deriver/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name pp) 3 | (modules pp) 4 | (libraries 5 | ppx_enum 6 | ppxlib 7 | ) 8 | ) 9 | 10 | (rule 11 | (targets test_enum.actual.ml) 12 | (deps test_enum.ml) 13 | (action (run ./pp.exe -deriving-keep-w32 both --impl %{deps} -o %{targets})) 14 | ) 15 | 16 | (alias 17 | (name runtest) 18 | (action (diff test_enum.expected.ml test_enum.actual.ml)) 19 | ) 20 | 21 | (tests 22 | (names test_enum) 23 | (modules test_enum) 24 | (preprocess 25 | (pps 26 | ppx_enum 27 | ) 28 | ) 29 | ) 30 | -------------------------------------------------------------------------------- /test/deriver/pp.ml: -------------------------------------------------------------------------------- 1 | Ppxlib.Driver.standalone (); 2 | -------------------------------------------------------------------------------- /test/deriver/test_enum.expected.ml: -------------------------------------------------------------------------------- 1 | module S : 2 | sig 3 | type t = 4 | | Foo 5 | | Bar [@@deriving str_enum] 6 | val to_string : t -> string 7 | val from_string : string -> (t, string) result 8 | val from_string_exn : string -> t 9 | type simple_enum = 10 | | Foo 11 | | Bar [@@deriving str_enum] 12 | val simple_enum_to_string : simple_enum -> string 13 | val simple_enum_from_string : string -> (simple_enum, string) result 14 | val simple_enum_from_string_exn : string -> simple_enum 15 | type enum_with_custom_value = 16 | | Foo 17 | | Bar 18 | | Baz [@@deriving str_enum] 19 | val enum_with_custom_value_to_string : enum_with_custom_value -> string 20 | val enum_with_custom_value_from_string : 21 | string -> (enum_with_custom_value, string) result 22 | val enum_with_custom_value_from_string_exn : 23 | string -> enum_with_custom_value 24 | end = 25 | struct 26 | type t = 27 | | Foo 28 | | Bar [@@deriving str_enum] 29 | let to_string = function | Foo -> "Foo" | Bar -> "Bar" 30 | let from_string = 31 | function 32 | | "Foo" -> Ok Foo 33 | | "Bar" -> Ok Bar 34 | | s -> 35 | Error 36 | (Printf.sprintf "Unexpected value for %s.%s: %s" __MODULE__ 37 | "from_string" s) 38 | let from_string_exn = 39 | function 40 | | "Foo" -> Foo 41 | | "Bar" -> Bar 42 | | s -> 43 | invalid_arg 44 | (Printf.sprintf "Unexpected value for %s.%s: %s" __MODULE__ 45 | "from_string_exn" s) 46 | type simple_enum = 47 | | Foo 48 | | Bar [@@deriving str_enum] 49 | let simple_enum_to_string = function | Foo -> "Foo" | Bar -> "Bar" 50 | let simple_enum_from_string = 51 | function 52 | | "Foo" -> Ok Foo 53 | | "Bar" -> Ok Bar 54 | | s -> 55 | Error 56 | (Printf.sprintf "Unexpected value for %s.%s: %s" __MODULE__ 57 | "simple_enum_from_string" s) 58 | let simple_enum_from_string_exn = 59 | function 60 | | "Foo" -> Foo 61 | | "Bar" -> Bar 62 | | s -> 63 | invalid_arg 64 | (Printf.sprintf "Unexpected value for %s.%s: %s" __MODULE__ 65 | "simple_enum_from_string_exn" s) 66 | type enum_with_custom_value = 67 | | Foo [@value "foo-1"] 68 | | Bar [@str_enum.value "bar-1"] 69 | | Baz [@ppx_enum.str_enum.value "baz-1"][@@deriving str_enum] 70 | let enum_with_custom_value_to_string = 71 | function | Foo -> "foo-1" | Bar -> "bar-1" | Baz -> "baz-1" 72 | let enum_with_custom_value_from_string = 73 | function 74 | | "foo-1" -> Ok Foo 75 | | "bar-1" -> Ok Bar 76 | | "baz-1" -> Ok Baz 77 | | s -> 78 | Error 79 | (Printf.sprintf "Unexpected value for %s.%s: %s" __MODULE__ 80 | "enum_with_custom_value_from_string" s) 81 | let enum_with_custom_value_from_string_exn = 82 | function 83 | | "foo-1" -> Foo 84 | | "bar-1" -> Bar 85 | | "baz-1" -> Baz 86 | | s -> 87 | invalid_arg 88 | (Printf.sprintf "Unexpected value for %s.%s: %s" __MODULE__ 89 | "enum_with_custom_value_from_string_exn" s) 90 | end 91 | -------------------------------------------------------------------------------- /test/deriver/test_enum.ml: -------------------------------------------------------------------------------- 1 | module S : sig 2 | type t = 3 | | Foo 4 | | Bar 5 | [@@deriving str_enum] 6 | 7 | type simple_enum = 8 | | Foo 9 | | Bar 10 | [@@deriving str_enum] 11 | 12 | type enum_with_custom_value = 13 | | Foo 14 | | Bar 15 | | Baz 16 | [@@deriving str_enum] 17 | end = struct 18 | type t = 19 | | Foo 20 | | Bar 21 | [@@deriving str_enum] 22 | 23 | type simple_enum = 24 | | Foo 25 | | Bar 26 | [@@deriving str_enum] 27 | 28 | type enum_with_custom_value = 29 | | Foo [@value "foo-1"] 30 | | Bar [@str_enum.value "bar-1"] 31 | | Baz [@ppx_enum.str_enum.value "baz-1"] 32 | [@@deriving str_enum] 33 | end 34 | -------------------------------------------------------------------------------- /test/lib/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name test_ppx_enum_lib) 3 | (libraries 4 | oUnit 5 | ppx_enum_lib 6 | ) 7 | (preprocess 8 | (pps 9 | ppx_deriving.std 10 | ) 11 | ) 12 | ) 13 | -------------------------------------------------------------------------------- /test/lib/test_ppx_enum_lib.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | let suite = 4 | "ppx_enum_lib" >::: 5 | [ Test_utils.suite 6 | ] 7 | 8 | let () = run_test_tt_main suite 9 | -------------------------------------------------------------------------------- /test/lib/test_ppx_enum_lib.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/ppx_enum/3309987d638f3667e89e5aaf833177e0efb373af/test/lib/test_ppx_enum_lib.mli -------------------------------------------------------------------------------- /test/lib/test_utils.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | open OUnit2 3 | 4 | module Fixtures = struct 5 | let location = 6 | Location.{ loc_start = {pos_fname = "test.ml"; pos_lnum = 1; pos_bol = 0; pos_cnum = 5} 7 | ; loc_end = {pos_fname = "test.ml"; pos_lnum = 1; pos_bol = 0; pos_cnum = 10} 8 | ; loc_ghost = false 9 | } 10 | end 11 | 12 | module Factories = struct 13 | let ast_name_node ?(loc=Fixtures.location) name = 14 | {txt = name; loc } 15 | 16 | let ast_type_node type_name = 17 | { ptyp_desc = Ptyp_constr ((ast_name_node (Lident type_name)), []) 18 | ; ptyp_loc = Fixtures.location 19 | ; ptyp_attributes = [] 20 | } 21 | 22 | let ast_constructor_node ~name ~pcd_args ~pcd_res = 23 | { pcd_name = ast_name_node name 24 | ; pcd_args 25 | ; pcd_res 26 | ; pcd_loc = Fixtures.location 27 | ; pcd_attributes = [] 28 | } 29 | end 30 | 31 | 32 | let test_constructor_is_bare = 33 | let open Parsetree in 34 | let test ~constructor ~expected ctxt = 35 | let actual = Ppx_enum_lib.Utils.constructor_is_bare constructor in 36 | assert_equal ~ctxt ~cmp:[%eq: bool] ~printer:[%show: bool] expected actual 37 | in 38 | (* This list of possible formulations is based on the comments in parsetree.mli. 39 | * However, I was unable to get the last entry in that list (`| C of {...} as t`) 40 | * to compile.*) 41 | "constructor_is_bare" >::: 42 | [ "| C" >:: 43 | test 44 | ~constructor: ( 45 | Factories.ast_constructor_node 46 | ~name: "C" 47 | ~pcd_args: (Pcstr_tuple []) 48 | ~pcd_res: None 49 | ) 50 | ~expected:true 51 | ; "| C of int * string" >:: 52 | test 53 | ~constructor: ( 54 | Factories.ast_constructor_node 55 | ~name: "C" 56 | ~pcd_args: (Pcstr_tuple [ Factories.ast_type_node "int" 57 | ; Factories.ast_type_node "string" 58 | ]) 59 | ~pcd_res: None 60 | ) 61 | ~expected:false 62 | ; "| C: int" >:: 63 | test 64 | ~constructor: ( 65 | Factories.ast_constructor_node 66 | ~name: "C" 67 | ~pcd_args: (Pcstr_tuple []) 68 | ~pcd_res: (Some (Factories.ast_type_node "int")) 69 | ) 70 | ~expected:false 71 | ; "| C: int * string -> int" >:: 72 | test 73 | ~constructor: ( 74 | Factories.ast_constructor_node 75 | ~name: "C" 76 | ~pcd_args: (Pcstr_tuple [ Factories.ast_type_node "int" 77 | ; Factories.ast_type_node "string" 78 | ]) 79 | ~pcd_res: (Some (Factories.ast_type_node "int")) 80 | ) 81 | ~expected:false 82 | ; "| C of {test: int}" >:: 83 | test 84 | ~constructor: ( 85 | Factories.ast_constructor_node 86 | ~name: "C" 87 | ~pcd_args: (Pcstr_record [{ pld_name = Factories.ast_name_node "test" 88 | ; pld_mutable = Immutable 89 | ; pld_type = Factories.ast_type_node "int" 90 | ; pld_loc = Fixtures.location 91 | ; pld_attributes = [] 92 | }]) 93 | ~pcd_res: None 94 | ) 95 | ~expected:false 96 | ; "| C of {test: int} -> int" >:: 97 | test 98 | ~constructor: ( 99 | Factories.ast_constructor_node 100 | ~name: "C" 101 | ~pcd_args: (Pcstr_record [{ pld_name = Factories.ast_name_node "test" 102 | ; pld_mutable = Immutable 103 | ; pld_type = Factories.ast_type_node "int" 104 | ; pld_loc = Fixtures.location 105 | ; pld_attributes = [] 106 | }]) 107 | ~pcd_res: (Some (Factories.ast_type_node "int")) 108 | ) 109 | ~expected:false 110 | ] 111 | 112 | let suite = 113 | "Factory" >::: 114 | [ test_constructor_is_bare 115 | ] 116 | -------------------------------------------------------------------------------- /test/lib/test_utils.mli: -------------------------------------------------------------------------------- 1 | val suite : OUnit2.test 2 | --------------------------------------------------------------------------------