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
|
type value =
| Str of string
| Bool of bool
| List of value list
| Obj of (string * value) list
type node =
| Text of string
| Var of string list
| Section of string list * node list
| Inverted of string list * node list
type tag = TVar of string list | TOpen of string list | TInv of string list | TClose of string list | TComment
let trim = String.trim
let path s =
String.split_on_char '.' (trim s) |> List.map trim |> List.filter (fun x -> x <> "")
(* Lex into a flat list of text and tags. Returns Error on an unterminated tag
rather than treating the remainder as text: silently swallowing "{{name" is
how a typo becomes invisible missing output. *)
let lex src =
let n = String.length src in
let out = ref [] in
let buf = Buffer.create 256 in
let flush () =
if Buffer.length buf > 0 then (out := `Text (Buffer.contents buf) :: !out; Buffer.clear buf)
in
let rec go i =
if i >= n then (flush (); Ok (List.rev !out))
else if i + 1 < n && src.[i] = '{' && src.[i + 1] = '{' then
match String.index_from_opt src (i + 2) '}' with
| Some j when j + 1 < n && src.[j + 1] = '}' ->
let body = String.sub src (i + 2) (j - i - 2) in
flush ();
let tag =
let b = trim body in
if b = "" then Error "empty tag {{}}"
else
(* Every sigil form (var, #, ^, /) resolves a dotted path; an
empty path ("{{.}}", "{{#}}", "{{^}}", "{{/}}") names
nothing -- there is no "current context" concept for a bare
dot to mean, so it is a parse error rather than an invented
behaviour Task 3 would have to define. *)
let with_path ctor rest =
match path rest with
| [] -> Error "empty tag path: {{.}} and {{#}} name nothing"
| p -> Ok (ctor p)
in
match b.[0] with
| '#' -> with_path (fun p -> TOpen p) (String.sub b 1 (String.length b - 1))
| '^' -> with_path (fun p -> TInv p) (String.sub b 1 (String.length b - 1))
| '/' -> with_path (fun p -> TClose p) (String.sub b 1 (String.length b - 1))
| '!' -> Ok TComment
| '>' -> Error "partials are not supported: a template may not include another file"
| _ -> with_path (fun p -> TVar p) b
in
(match tag with
| Error e -> Error e
| Ok t -> out := `Tag t :: !out; go (j + 2))
| _ -> Error "unterminated tag: '{{' with no matching '}}'"
else (Buffer.add_char buf src.[i]; go (i + 1))
in
go 0
(* Fold the flat list into a tree, checking that every close matches its open. *)
let build items =
let rec go acc stack items =
match items with
| [] -> (
match stack with
| [] -> Ok (List.rev acc)
| (p, _, _) :: _ -> Error ("unclosed section {{#" ^ String.concat "." p ^ "}}"))
| `Text "" :: rest -> go acc stack rest
| `Text t :: rest -> go (Text t :: acc) stack rest
| `Tag TComment :: rest -> go acc stack rest
| `Tag (TVar p) :: rest -> go (Var p :: acc) stack rest
| `Tag (TOpen p) :: rest -> go [] ((p, `Sec, acc) :: stack) rest
| `Tag (TInv p) :: rest -> go [] ((p, `Inv, acc) :: stack) rest
| `Tag (TClose p) :: rest -> (
match stack with
| [] -> Error ("close tag {{/" ^ String.concat "." p ^ "}} with no open section")
| (op, kind, outer) :: tl ->
if op <> p then
Error
("mismatched close: {{#" ^ String.concat "." op ^ "}} closed by {{/"
^ String.concat "." p ^ "}}")
else
let inner = List.rev acc in
let node = match kind with `Sec -> Section (op, inner) | `Inv -> Inverted (op, inner) in
go (node :: outer) tl rest)
in
go [] [] items
let parse src = match lex src with Error e -> Error e | Ok items -> build items
|
