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
(** {1 Command Type} *)
open Lwt.Infix
type res =
| Cmd_match of unit Lwt.t
| Cmd_skip
| Cmd_fail of string
type t = {
prio: int;
match_: prefix:string -> Core.t -> Core.privmsg -> res; (** How to react to incoming messages *)
name: string;
descr: string;
}
let make ?(descr="") ?(prio=99) ~name f =
{ descr; prio; name; match_=f; }
let s =
try
let i = String.rindex s '>' in
if i < String.length s-1 then (
let hl =
String.sub s (i+1) (String.length s-i-1) |> String.trim
in
let s = String.sub s 0 i |> String.trim in
Some (s, hl)
) else None
with Not_found -> None
let match_prefix1_full ~prefix ~cmd msg : (string * string option) option =
let re = Re.Perl.compile_pat
(Printf.sprintf "^%s\\b[ ]*%s\\b[ ]*(.*)$" prefix cmd)
in
begin match Prelude.re_match1 Prelude.id re msg.Core.message with
| None -> None
| Some matched ->
let matched = String.trim matched in
match extract_hl matched with
| None -> Some (matched, None)
| Some (a,b) -> Some (a, Some b)
end
let match_prefix1 ~prefix ~cmd msg =
Prelude.map_opt fst (match_prefix1_full ~prefix ~cmd msg)
exception Fail of string
let make_simple_inner_ ~query ?descr ?prio ~cmd f : t =
let match_ ~prefix (module C:Core.S) msg =
match match_prefix1_full ~prefix ~cmd msg with
| None -> Cmd_skip
| Some (sub, hl) ->
try
let fut =
f msg sub >>= fun lines ->
let lines = match hl with
| None -> lines
| Some hl -> List.map (fun line -> hl ^ ": " ^ line) lines
in
let target = if query then Core.nick msg else Core.reply_to msg in
let delay = if query then Some 0.5 else None in
C.send_privmsg_l_nolimit ?delay ~target ~messages:lines ()
in
Cmd_match fut
with Fail msg ->
Cmd_fail msg
in
make ?descr ?prio ~name:cmd match_
let make_simple_l ?descr ?prio ~cmd f : t =
let descr = match descr with
| None -> cmd
| Some s -> s
in
make_simple_inner_ ~query:false ~descr ?prio ~cmd f
let make_simple_query_l ?descr ?prio ~cmd f : t =
let descr = match descr with Some s -> s | None -> cmd in
make_simple_inner_ ~query:true ~descr ?prio ~cmd f
let make_simple ?descr ?prio ~cmd f : t =
make_simple_l ?descr ?prio ~cmd
(fun msg s -> f msg s >|= function
| None -> []
| Some x -> [x])
let compare_prio c1 c2 = compare c1.prio c2.prio
(** Help command *)
let cmd_help (l:t list): t =
make_simple ~descr:"help message" ~cmd:"help" ~prio:5
(fun _ s ->
let s = String.trim s in
let res =
match s with
| "" ->
let l = "help" :: List.map (fun c -> c.name) l in
let message = "help: commands are " ^ Prelude.string_list_to_string l in
Some message
| "help" -> Some "displays help for commands"
| _ ->
try
let c = List.find (fun c -> c.name = s) l in
Some (Printf.sprintf "%s: %s (prio %d)" c.name c.descr c.prio)
with Not_found ->
Some ("error: unknown command " ^ s)
in
Lwt.return res
)
let run ~prefix core l msg : unit Lwt.t =
let rec aux = function
| [] ->
Log.logf "no command found for %s" (Core.string_of_privmsg msg);
Lwt.return_unit
| c :: tail ->
begin match c.match_ ~prefix core msg with
| Cmd_skip -> aux tail
| Cmd_match f ->
Log.logf "command %s succeeded for %s"
c.name (Core.string_of_privmsg msg);
f
| Cmd_fail e ->
Log.logf "command %s failed on %s with %s"
c.name (Core.string_of_privmsg msg) e;
aux tail
end
in
aux l