Source file t_container_intf.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
(* This file is part of 'travesty'.

   Copyright (c) 2018 by Matt Windsor

   Permission is hereby granted, free of charge, to any person
   obtaining a copy of this software and associated documentation
   files (the "Software"), to deal in the Software without
   restriction, including without limitation the rights to use, copy,
   modify, merge, publish, distribute, sublicense, and/or sell copies
   of the Software, and to permit persons to whom the Software is
   furnished to do so, subject to the following conditions:

   The above copyright notice and this permission notice shall be
   included in all copies or substantial portions of the Software.

   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
   MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
   NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
   BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
   ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
   CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
   SOFTWARE. *)

(** Extension signatures for containers.

    This module contains various signatures that enumerate extensions
    that apply to Core containers of both {{!Extensions0}arity 0} and
    {{!Extensions1}arity 1}. *)

open Base

(** {2:generic Generic extensions}

    As is often the case in [Travesty], we define an arity-generic
    signature first, then specialise it for arity-0 and arity-1
    containers. *)

module type Generic_extensions = sig
  include Types_intf.Generic
    (** [Generic_extensions] refers to the container type as ['a t],
       and the element type as ['a elt]; substitute [t]/[elt]
       (arity-0) or ['a t]/['a] (arity-1) accordingly below. *)


  (** {3 Testing for a specific number of elements}

      The following functions help in checking whether a container
      has a particular, commonly-required number of elements (zero or
      one, one, two, and so on).
  *)

  val at_most_one : 'a t -> 'a elt option Or_error.t
  (** [at_most_one xs] returns [Ok None] if [xs] is empty;
      [Ok Some(x)] if it contains only [x];
      and an error otherwise.

      Examples:

      {[
        T_list.at_most_one []     (* ok None *)
               at_most_one [1]    (* ok (Some 1) *)
               at_most_one [1; 2] (* error -- too many *)
      ]}
  *)

  val one : 'a t -> 'a elt Or_error.t
  (** [one xs] returns [Ok x] if [xs] contains only [x],
      and an error otherwise.

      Examples:

      {[
        T_list.one []     (* error -- not enough *)
               one [1]    (* ok 1 *)
               one [1; 2] (* error -- too many *)
      ]}
  *)

  val two : 'a t -> ('a elt * 'a elt) Or_error.t
  (** [two xs] returns [Ok (x, y)] if [xs] is a list containing only [x]
      and [y] in that order, and an error otherwise.

      Examples:

      {[
        T_list.two []        (* error -- not enough *)
               two [1]       (* error -- not enough *)
               two [1; 2]    (* ok (1, 2) *)
               two [1; 2; 3] (* error -- too many *)
      ]}
  *)

  (** {3 Miscellaneous extensions} *)

  val max_measure : measure:('a elt -> int) -> ?default:int -> 'a t -> int
  (** [max_measure ~measure ~default xs] measures each item in [xs]
      according to [measure], and returns the highest measure reported.
      If [xs] is empty, return [default] if given, and [0]
      otherwise. *)
end

(** {3 Containers of predicates}

    The following functions concern containers of predicates
    (functions of type ['a -> bool]). *)

module type Generic_predicate_extensions = sig
  type 'a t
  (** The generic type of predicate containers. *)

  type 'a item
  (** The generic type of predicate target elements. *)

  val any : 'a item -> predicates:'a t -> bool
  (** [any x ~predicates] tests [x] against [predicates] until one
      returns [true], in which case it returns [true];
      or all return [false], in which case it returns [false]. *)

  val all : 'a item -> predicates:'a t -> bool
  (** [any x ~predicates] tests [x] against [predicates] until one
      returns [false], in which case it returns [false];
      or all return [true], in which case it returns [true]. *)

  val none : 'a item -> predicates:'a t -> bool
  (** [none x ~predicates] is the same as [any x] with all predicates
     in [predicates] negated.  It tests [x] against [predicates] until
     one returns [true], in which case it returns [false]; or all
     return [false], in which case it returns [true]. *)
end

(** {2:a0 Arity-0 container extensions}

    These extensions target arity-0 containers (implementations of
    [Container.S0]).
*)

(** Extensions for a [Container.S0].

    This signature contains the generic extensions outlined in
    {{!Generic_extensions}Generic_extensions}. *)
module type Extensions0 = sig
  include Types_intf.S0
  include Generic_extensions with type 'a t := t and type 'a elt := elt
end

(** Extensions for a [Container.S0] whose elements are predicates.

    This signature extends and constrains {{!Extensions0}Extensions0}. *)
module type Extensions0_predicate = sig
  type t
  (** Type of predicate containers *)

  type item
  (** Type of items being tested against predicates. *)

  include Extensions0 with type t := t and type elt := (item -> bool)
  include Generic_predicate_extensions with type 'a t := t
                                        and type 'a item := item
end

(** {2:a1 Arity-1 container extensions}

    These extensions target arity-1 containers (implementations of
    [Container.S1]).
*)

(** Extensions for a [Container.S1].

    This signature contains both the generic extensions outlined in
    {{!Generic_extensions}Generic_extensions} as well as extensions
    that require the ability to change the element type mid-flight. *)
module type Extensions1 = sig
  type 'a t
  (** The type of the container to extend. *)

  include Generic_extensions with type 'a t := 'a t and type 'a elt := 'a

  include Generic_predicate_extensions with type 'a t := ('a -> bool) t
                                        and type 'a item := 'a
  (** Predicate extensions are available on all arity-1 containers,
      provided that we fix the element type parameter to ['a -> bool]. *)
end