Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 102 lines (86 sloc) 2.813 kb
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (* CF mli *)
19 type t = Buffer.t
20 type input = Directive of string | Code of string
21
22 let create () = Buffer.create 10000
23 let reset accu = Buffer.clear accu
24
25 let add accu b =
26 Buffer.add_string accu b;
27 Buffer.add_char accu '\n'
28
29 let accumulate accu str =
30 let s = Base.String.rtrim str in
31 let len = String.length s in
32 let predlen = pred len in
33 let rec aux i =
34 if i >= predlen then (add accu s; None)
35 else
36 if (String.unsafe_get s i) = ';'
37 then
38 if String.unsafe_get s (succ i) = ';'
39 then
40 begin
41 let input = Base.String.rtrim (Base.String.unsafe_sub s 0 i) in
42 Buffer.add_string accu input;
43 let input = Buffer.contents accu in
44 reset accu;
45 if String.length input > 0
46 then
47 if input.[0] = '#'
48 then Some (Directive input)
49 else Some (Code input)
50 else None
51 end
52 else aux (i + 2)
53 else aux (succ i)
54 in aux 0
55
56 let flush accu = accumulate accu ";;"
57
58 module Directive =
59 struct
60 type arguments = string list
61 type 'env action = 'env -> arguments -> 'env
62
63 type regexp = string
64 type argument_number = int
65
66 type 'env directive = regexp * argument_number * 'env action
67
68 type 'env handler = ('env -> string -> 'env option) list
69
70 let empty () = []
71 let add handler directive =
72 match directive with
73 | regexp, argument_number, action ->
74 let reg = Str.regexp regexp in
75 let filter env dir =
76 if Str.string_match reg dir 0
77 then
78 try
79 let args =
80 let rec aux accu i =
81 if i < 1 then accu else aux ((Str.matched_group i dir)::accu) (pred i)
82 in aux [] argument_number
83 in
84 Some (action env args)
85 with
86 | Not_found -> None
87 else None
88 in
89 filter :: handler
90
91 let parse handler env input =
92 let rec aux = function
93 | [] -> None
94 | hd::tl -> (
95 match hd env input with
96 | ( Some _ ) as result -> result
97 | None -> aux tl
98 )
99 in aux handler
100
101 end
Something went wrong with that request. Please try again.