Import ppx_deriving_qcheck

Author: vch9

ppx_deriving_qcheck.opam

@@ -0,0 +1,27 @@
+opam-version: "2.0"
+name: "ppx_deriving_qcheck"
+version: "0.2.0"
+license: "BSD-2-Clause"
+synopsis: "PPX Deriver for QCheck"
+
+maintainer: "[email protected]"
+author: [ "the qcheck contributors" ]
+
+depends: [
+  "dune" {>= "2.8.0"}
+  "ocaml" {>= "4.10.2"}
+  "qcheck" {>= "0.17"}
+  "ppxlib" {>= "0.22.0"}
+  "odoc" {with-doc}
+  "alcotest" {with-test & >= "1.4.0" }
+]
+
+build: [
+  ["dune" "build" "-p" name "-j" jobs]
+  ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc}
+  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
+]
+
+homepage: "https://github.com/c-cube/qcheck/"
+bug-reports: "https://github.com/c-cube/qcheck/-/issues"
+dev-repo: "git+https://github.com/vch9/ppx_deriving_qcheck.git"

src/ppx_deriving_qcheck/attributes.ml

@@ -0,0 +1,19 @@
+open Ppxlib
+
+(** [find_first_attribute xs name] returns the first attribute found in [xs]
+    named [name] *)
+let find_attribute_opt xs name =
+  List.find_opt (fun attribute -> attribute.attr_name.txt = name) xs
+
+let get_expr_payload x =
+  match x.attr_payload with
+  | PStr [ { pstr_desc = Pstr_eval (e, _); _ } ] -> Some [%expr [%e e]]
+  | _ -> None
+
+let gen ct =
+  Option.fold ~none:None ~some:get_expr_payload
+  @@ find_attribute_opt ct.ptyp_attributes "gen"
+
+let weight xs =
+  Option.fold ~none:None ~some:get_expr_payload
+  @@ find_attribute_opt xs "weight"

src/ppx_deriving_qcheck/attributes.mli

@@ -0,0 +1,28 @@
+open Ppxlib
+(** This file handles every attributes to be found in a core_type definition *)
+
+val gen : core_type -> expression option
+(** [gen loc ct] look for an attribute "gen" in [ct]
+
+    example:
+    {[
+    type t =
+    | A of int
+    | B of (int [@gen QCheck.int32])
+    ]}
+
+    It allows the user to specify which generator he wants for a specific type.
+    Returns the generator as an expression and returns None if no attribute
+    is present *)
+
+val weight : attributes -> expression option
+(** [weight loc ct] look for an attribute "weight" in [ct]
+
+    example:
+    {[
+    type t =
+    | A [@weight 5]
+    | B [@weight 6]
+    | C
+    ]}
+    It allows the user to specify the weight of a type case. *)

src/ppx_deriving_qcheck/dune

@@ -0,0 +1,7 @@
+(library
+ (name ppx_deriving_qcheck)
+ (public_name ppx_deriving_qcheck)
+ (libraries ppxlib)
+ (preprocess (pps ppxlib.metaquot))
+ (ppx_runtime_libraries qcheck-core)
+ (kind ppx_deriver))