package climate

  1. Overview
  2. Docs

Source file climate_stdlib.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
184
185
186
187
188
189
190
191
module Result = struct
  include Result

  let map t ~f = map f t
  let map_error t ~f = map_error f t
  let bind t ~f = bind t f

  let both a b =
    match a with
    | Error e -> Error e
    | Ok a ->
      (match b with
       | Error e -> Error e
       | Ok b -> Ok (a, b))
  ;;

  module List = struct
    type ('a, 'error) t = ('a, 'error) result list

    let rec all = function
      | [] -> Ok []
      | Ok x :: xs -> map (all xs) ~f:(fun xs -> x :: xs)
      | Error error :: _xs -> Error error
    ;;

    let rec fold_left ~f ~init = function
      | [] -> Ok init
      | x :: xs -> bind (fold_left ~f ~init xs) ~f:(fun acc -> f acc x)
    ;;
  end

  module O = struct
    let ( >>= ) t f = bind t ~f
    let ( >>| ) t f = map t ~f
    let ( let* ) = ( >>= )
    let ( let+ ) = ( >>| )
    let ( and+ ) = both
  end
end

module Option = struct
  include Option

  let map t ~f = map f t
  let bind t ~f = bind t f
  let iter t ~f = iter f t
  let equal a b ~eq = Option.equal eq a b
end

module List = struct
  include StdLabels.List

  let find_duplicate ~eq t =
    let contains xs x = exists ~f:(eq x) xs in
    let rec loop = function
      | [] -> None
      | x :: xs -> if contains xs x then Some x else loop xs
    in
    loop t
  ;;

  let rec split_n t n =
    match t with
    | [] -> [], []
    | x :: xs ->
      if n <= 0
      then [], t
      else (
        let l, r = split_n xs (n - 1) in
        x :: l, r)
  ;;

  let is_empty = function
    | [] -> true
    | _ -> false
  ;;

  let filter_opt t = filter_map t ~f:Fun.id

  let rec last = function
    | [] -> None
    | [ x ] -> Some x
    | _ :: xs -> last xs
  ;;

  let max xs =
    fold_left xs ~init:None ~f:(fun acc x ->
      match acc with
      | None -> Some x
      | Some y -> if x > y then Some x else Some y)
  ;;
end

module Map = struct
  include MoreLabels.Map

  module type S = sig
    include S

    val find : 'a t -> key -> 'a option
    val set : 'a t -> key -> 'a -> 'a t
    val of_list : (key * 'a) list -> ('a t, key * 'a * 'a) Result.t
  end

  module Make (Key : OrderedType) : S with type key = Key.t = struct
    include MoreLabels.Map.Make (struct
        type t = Key.t

        let compare = Key.compare
      end)

    let find key t = find_opt t key
    let set t k v = add ~key:k ~data:v t

    let of_list =
      let rec loop acc = function
        | [] -> Result.Ok acc
        | (k, v) :: l ->
          (match find acc k with
           | None -> loop (set acc k v) l
           | Some v_old -> Error (k, v_old, v))
      in
      fun l -> loop empty l
    ;;
  end
end

module Nonempty_list = struct
  type 'a t = ( :: ) of ('a * 'a list)

  let singleton x = [ x ]

  let of_list = function
    | [] -> None
    | x :: xs -> Some (x :: xs)
  ;;

  let to_list (x :: xs) = List.(x :: xs)
  let map (x :: xs) ~f = f x :: List.map xs ~f
  let hd (x :: _) = x
  let append (x :: xs) (y :: ys) = x :: List.concat [ xs; [ y ]; ys ]
  let concat ((x :: xs) :: xss) = x :: List.append xs (List.concat_map ~f:to_list xss)
  let equal a b ~eq = List.equal (to_list a) (to_list b) ~eq
end

module Nonnegative_int = struct
  type t = int

  let of_int x = if x < 0 then None else Some x
  let to_int x = x
end

module String = struct
  include StdLabels.String

  let lsplit2 s ~on =
    match index_opt s on with
    | None -> None
    | Some i -> Some (sub s ~pos:0 ~len:i, sub s ~pos:(i + 1) ~len:(length s - i - 1))
  ;;

  let is_empty s = String.length s == 0

  let rec check_prefix s ~prefix len i =
    i = len || (s.[i] = prefix.[i] && check_prefix s ~prefix len (i + 1))
  ;;

  let is_prefix s ~prefix =
    let len = length s in
    let prefix_len = length prefix in
    len >= prefix_len && check_prefix s ~prefix prefix_len 0
  ;;

  let drop_prefix s ~prefix =
    if is_prefix s ~prefix
    then
      if length s = length prefix
      then Some ""
      else Some (sub s ~pos:(length prefix) ~len:(length s - length prefix))
    else None
  ;;

  module Set = Set.Make (String)
  module Map = Map.Make (String)
end

module Int = struct
  include Int
  module Set = Set.Make (Int)
  module Map = Map.Make (Int)
end
OCaml

Innovation. Community. Security.