package incr_dom_sexp_form

  1. Overview
  2. Docs
val string : ?placeholder:string -> ?width:int -> unit -> string t
val nonempty_string : ?placeholder:string -> ?width:int -> unit -> string t
val int : int t
val positive_int : int t
val non_negative_int : int t
val option : 'a t -> 'a option t
val bool_true_false : bool t
val bool_yes_no : bool t
val list : ?element_name:string -> ?gated_deletion:unit -> ?max_size:int -> ?add_and_remove_button_attrs:Incr_dom.Vdom.Attr.t list -> ?editor_message_attr:Incr_dom.Vdom.Attr.t -> order:[ `Ordered | `Unordered ] -> 'a t -> 'a list t

element_name is used for buttons. If you provide ~element_name:"foo", then the button will say "Add foo" instead of "Add".

gated_deletion means that the user must check a checkbox to enable the delete buttons. This is not strictly necessary, since the list maintains a "deleted stack" internally so that if you delete an element, the next time you press "add" it will add back the deleted element. However, users might not be aware of this functionality.

order indicates whether the order of the list elements is important. If it's not important, we only need one add button; if it's important, we need an add button between every pair of elements.

val assoc_map : ?element_name:string -> ?gated_deletion:unit -> ?max_size:int -> key:'a t -> data:'b t -> of_alist_exn:(('a * 'b) list -> 'c) -> unit -> 'c t
val set : ?element_name:string -> ?gated_deletion:unit -> ?max_size:int -> of_list:('a list -> 'c) -> 'a t -> 'c t
val record : create:('a -> 'b) -> ('record, 'a -> 'b) Record_builder.t

Building a record works like this: let's say you have a record 'r which has n fields of types 'f1, ..., 'fn.

First you call record ~create, supplying a create function of type 'f1 -> ... -> 'fn -> 'r. In most cases, your create function can delegate to Fields.create as in the usage example below.

This gives you a ('r, 'f1 -> ... -> 'fn -> 'r) Record_builder.t. The first type parameter 'r is a phantom type which exists only for additional type safety.

You turn this into a ('r, 'r) Record_builder.t by applying the <.*> operator once for each field, in order. First, you call it with a ('r, 'f1) Record_field.t to get a ('r, 'f2 -> .. -> 'fn -> 'r) Record_builder.t, then with a ('r, 'f2) Record_field.t to get a ('r, 'f3 -> ... -> 'fn -> 'r) Record_builder.t, and so on until you end up with a ('r, 'r) Record_builder.t. You can obtain a Record_field.t using the field function.

Finally you convert your ('r, 'r) Record_field.t into a 'r Sexp_form.t using finish_record.

Usage example:

module Foo = struct
  type t =
    { a : string
    ; b : int
    }
  [@@deriving fields, sexp_of]
end

let foo : Foo.t Sexp_form.t =
  let open Sexp_form.Primitives in
  let module Fields = Foo.Fields in
  record ~create:(fun a b -> Fields.create ~a ~b)
  <.*> field (string ()) Fields.a
  <.*> field int         Fields.b
  |> finish_record
val field : 'a t -> ('record, 'a) Core.Field.t -> ('record, 'a) Record_field.t

See documentation for record.

val sexp_option_field : 'a t -> ('record, 'a option) Core.Field.t -> ('record, 'a option) Record_field.t

See documentation for record.

val (<.*>) : ('record, 'a -> 'b) Record_builder.t -> ('record, 'a) Record_field.t -> ('record, 'b) Record_builder.t

See documentation for record.

val finish_record : ('record, 'record) Record_builder.t -> 'record t

See documentation for record.

val from_ppx_sexp : t_of_sexp:(Core.Sexp.t -> 'a) -> ?on_error:(Core.Error.t -> Core.Error.t) -> unit -> 'a t

This has some special behaviour, namely that if the input string contains no parentheses or quotes then we will treat it as an atom -- so the user can enter foo bar when a direct conversion using Sexp.of_string followed by t_of_sexp would only accept "foo bar". It can also override any error produced by ppx_sexp using on_error, since the errors produced by ppx_sexp are not always easy for the user to understand.

val variant : ?don't_state_options_in_error:unit -> 'a Case.t list -> 'a t

variant takes a list of Case.ts. Case.ts are created by case and case_raw. When you create a case from a variant constructor for variant 'v, say a case with arguments of types 'a1, ..., 'an, you get a ('a1 -> ... -> 'an -> 'v) Case.t. You turn this into a 'v Case.t by applying the <|*> operator once per argument. Then you turn a 'v Case.t list into a 'v Sexp_form.t using variant.

Usage example:

module Foo = struct
  type t =
    | A
    | B of int
    | C of int * string
  [@@deriving variants, sexp_of, compare]
end

let foo : Foo.t Sexp_form.t =
  let open Sexp_form.Primitives in
  variant
    (Variants.fold
       ~init:[]
       ~a:(fun acc a ->  case a                          :: acc)
       ~b:(fun acc b -> (case b <|*> int)                :: acc)
       ~c:(fun acc c -> (case c <|*> int <|*> string ()) :: acc))

By default, the error message lists all the possible variants, as in "Please select an option: Foo | Bar". If there are a lot of variants and you don't want this, you can use don't_state_options_in_error.

val case_raw : name:string -> constructor:'a -> 'a Case.t

Mainly useful for polymorphic variants. For example, the following produces a `Foo of int Case.t:

case_raw ~name:"Foo" ~constructor:(fun x -> `Foo x) <|*> positive_int
val case : 'a Variantslib.Variant.t -> 'a Case.t

See documentation for variant.

val (<|*>) : ('a -> 'b) Case.t -> 'a t -> 'b Case.t

See documentation for variant.

val dropdown_with_other : other:'a t -> sexp_of_t:('a -> Core.Sexp.t) -> (string * 'a) list -> 'a t

Allows the user to choose from a list of 'as, which are displayed using the provided names in the dropdown, or enter their own choice by selecting "Other" in the dropdown.

val enumeration : ?don't_state_options_in_error:unit -> 'a list -> to_string:('a -> string) -> 'a t

This function is a wrapper around variant and case_raw. It's useful with ppx_enumerate:

module Foo = struct
  type t =
    | A
    | B
    | C
    | D
  [@@deriving enumerate, variants]
end

let foo : Foo.t Sexp_form.t =
  Sexp_form.Primitives.enumeration Foo.all ~to_string:Foo.Variants.to_name

This is displayed as a dropdown with options A, B, C, and D.

By default, the error message lists all the possible variants, as in "Please select an option: Foo | Bar". If there are a lot of variants and you don't want this, you can use don't_state_options_in_error.

val recursive : ('a t -> 'a t) -> 'a t

For recursive data types. Note: recursive Fn.id will go into an infinite loop when you call to_interactive on it.

Here's an example of proper usage:

module MyList = struct
  type t =
    | Nil
    | Cons of int * t
  [@@deriving variants]
end
let my_list_editor : MyList.t Sexp_form.t =
  let open Sexp_form.Primitives in
  recursive (fun my_list_editor ->
    variant
      (MyList.Variants.fold
         ~init:[]
         ~nil: (fun acc nil   ->  case nil                                :: acc)
         ~cons:(fun acc const -> (case cons <|*> int <|*> my_list_editor) :: acc)))
val defaulting_to : default:'a -> sexp_of_t:('a -> Core.Sexp.t) -> 'a t -> 'a t

This is useful for e.g. specifying default values when the user creates a new element in a list. If you want a default value for the whole form, consider using Init.with_default, which also shows the user a diff summarizing their edits.

val on_new_line : 'a t -> 'a t

These only affect formatting, not functionality.

val case_on_new_line : 'a Case.t -> 'a Case.t
val collapse : ?editor_message_attr:Incr_dom.Vdom.Attr.t -> 'a t -> 'a t

Hides the form by default, giving the user a checkbox to un-collapse the form if they wish.

val unit : unit t
val tuple2 : 'a t -> 'b t -> ('a * 'b) t
val tuple3 : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
val tuple4 : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t
val tuple5 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> ('a * 'b * 'c * 'd * 'e) t