package oxbow

  1. Overview
  2. Docs
package oxbow
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file pattern.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
let src = Logs.Src.create "oxbow.core" ~doc:"oxbow core library"

module Log = (val Logs.src_log src)

module Case = struct
  type t =
    | Sensitive [@name "sensitive"]
    | Insensitive [@name "insensitive"]
  [@@deriving yojson]
end

let cache : (Case.t * string, (Re.re, string) result) Hashtbl.t = Hashtbl.create 64

let re_compile_uncached ~(case : Case.t) s =
  let flags =
    match case with
    | Sensitive -> []
    | Insensitive -> [ `CASELESS ]
  in
  try Ok Re.(compile (Pcre.re ~flags s)) with
  | Re.Pcre.(Parse_error | Not_supported) -> Error (Printf.sprintf "invalid regex: %s" s)
;;

let re_compile ~case s =
  match Hashtbl.find_opt cache (case, s) with
  | Some r -> r
  | None ->
    let r = re_compile_uncached ~case s in
    if Hashtbl.length cache > 1024 then Hashtbl.reset cache;
    Hashtbl.add cache (case, s) r;
    r
;;

let matches ~case ~pattern str =
  match pattern with
  | None -> true
  | Some s ->
    (match re_compile ~case s with
     | Error msg ->
       Log.err (fun m -> m "%s" msg);
       false
     | Ok re -> Re.execp re str)
;;

let compile_specs ~case specs =
  List.fold_left
    (fun acc (pattern, proj) ->
       Result.bind acc
       @@ fun preds ->
       match pattern with
       | None -> Ok preds
       | Some s ->
         Result.map
           (fun re subj -> List.exists (Re.execp re) (proj subj))
           (re_compile ~case s)
         |> Result.map (fun pred -> pred :: preds))
    (Ok [])
    specs
  |> Result.map (fun preds subj -> List.for_all (fun pred -> pred subj) preds)
;;