package testo-util

  1. Overview
  2. Docs

Source file Tag_query.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
(*
   Query language for selecting tests based on their tags

   Sample input: (foo or bar) and not e2e
*)

open Printf

type t = Tag.query =
  | Has_tag of Tag.t
  | All
  | None
  | Not of t
  | And of t * t
  | Or of t * t

let parse str =
  try
    let lexbuf = Lexing.from_string str in
    let query = Tag_query_parser.main Tag_query_lexer.token lexbuf in
    Ok query
  with
  | e ->
      Error
        (sprintf "Syntax error in tag query '%s': %s" str (Printexc.to_string e))

let rec match_ tags q =
  match q with
  | Has_tag t -> List.exists (Tag.equal t) tags
  | All -> true
  | None -> false
  | Not q -> not (match_ tags q)
  | And (a, b) -> match_ tags a && match_ tags b
  | Or (a, b) -> match_ tags a || match_ tags b

let needs_parens = function
  | Has_tag _
  | All
  | None
  | Not _ ->
      false
  | And _
  | Or _ ->
      true

let show q =
  let rec show buf = function
    | Has_tag x -> Buffer.add_string buf (Tag.show x)
    | All -> Buffer.add_string buf "all"
    | None -> Buffer.add_string buf "none"
    | Not x -> bprintf buf "not %a" show_inner x
    | And (a, b) -> bprintf buf "%a and %a" show_inner a show_inner b
    | Or (a, b) -> bprintf buf "%a or %a" show_inner a show_inner b
  and show_inner buf x =
    if needs_parens x then bprintf buf "(%a)" show x else show buf x
  in
  let buf = Buffer.create 100 in
  show buf q;
  Buffer.contents buf

let pp ppf q = Format.pp_print_string ppf (show q)