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
open Base
let parse string =
try
Some (TSL_parser.expression TSL_lexer.token (Lexing.from_string string))
with
| Parsing.Parse_error -> None
| Failure _
| TSL_lexer.Error _ ->
None
type show_context = SC_not | SC_and | SC_or | SC_toplevel
let show_string_var : TSL_AST.string_var -> string = function
| File -> "file"
| Title -> "title"
let char_is_unsafe = function
| 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' | '/' | '.' -> false
| _ -> true
let is_valid_tag = function
| "true" | "false" -> false
| tag ->
let len = String.length tag in
1 <= len && len <= 32
&&
let rec check i =
if i >= len then true
else
match tag.[i] with
| 'a' .. 'z' | '0' .. '9' | '_' -> check (i + 1)
| _ -> false
in
check 0
let string_exists f s =
let exception Yes in
try
for i = 0 to String.length s - 1 do
if f s.[i] then raise Yes
done ;
false
with Yes -> true
let show_string string =
match string with
| "" -> "\"\""
| "not" -> "\"not\""
| "true" -> "\"true\""
| "false" -> "\"false\""
| _ ->
let needs_quotes =
string.[0] = '/' || string_exists char_is_unsafe string
in
if needs_quotes then (
let buffer = Buffer.create (String.length string * 2) in
Buffer.add_char buffer '"' ;
for i = 0 to String.length string - 1 do
let c = string.[i] in
(match c with '"' | '\\' -> Buffer.add_char buffer '\\' | _ -> ()) ;
Buffer.add_char buffer c
done ;
Buffer.add_char buffer '"' ;
Buffer.contents buffer)
else string
let add_parentheses s = "(" ^ s ^ ")"
let show ?(always_parenthesize = false) expression =
let rec show context (expression : TSL_AST.t) =
let parentheses_for_string_predicate =
if always_parenthesize then add_parentheses
else
match context with
| SC_not -> add_parentheses
| SC_and | SC_or | SC_toplevel -> Fun.id
in
match expression with
| True -> "true"
| False -> "false"
| String_predicate (var, Is value) ->
parentheses_for_string_predicate
(show_string_var var ^ " = " ^ show_string value)
| String_predicate (var, Matches value) ->
parentheses_for_string_predicate
(show_string_var var ^ " =~ " ^ show_string (show_rex value))
| Has_tag tag -> show_string tag
| Not (Has_tag tag) ->
if is_valid_tag tag then "/" ^ tag else "not " ^ show_string tag
| Not p -> "not " ^ show SC_not p
| And (a, b) ->
let parentheses =
if always_parenthesize then add_parentheses
else
match context with
| SC_not -> add_parentheses
| SC_and | SC_or | SC_toplevel -> Fun.id
in
parentheses (show SC_and a ^ " && " ^ show SC_and b)
| Or (a, b) ->
let parentheses =
if always_parenthesize then add_parentheses
else
match context with
| SC_not | SC_and -> add_parentheses
| SC_or | SC_toplevel -> Fun.id
in
parentheses (show SC_or a ^ " || " ^ show SC_or b)
in
show SC_toplevel expression
type env = {file : string; title : string; tags : string list}
let get_string : env -> TSL_AST.string_var -> string =
fun env -> function File -> env.file | Title -> env.title
let apply_string_operator : string -> TSL_AST.string_operator -> bool =
fun value -> function
| Is expected -> String.equal value expected
| Matches rex -> value =~ rex
let rec eval : env -> TSL_AST.t -> bool =
fun env -> function
| True -> true
| False -> false
| String_predicate (var, operator) ->
apply_string_operator (get_string env var) operator
| Has_tag tag -> List.mem tag env.tags
| Not p -> not (eval env p)
| And (a, b) -> eval env a && eval env b
| Or (a, b) -> eval env a || eval env b
let conjunction = function
| [] -> TSL_AST.True
| head :: tail -> List.fold_left (fun a b -> TSL_AST.And (a, b)) head tail
let tags expression =
let rec gather acc : TSL_AST.t -> _ = function
| True | False | String_predicate ((File | Title), _) -> acc
| Has_tag tag -> String_set.add tag acc
| Not p -> gather acc p
| And (a, b) | Or (a, b) -> gather (gather acc a) b
in
String_set.elements (gather String_set.empty expression)