Source file compile.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
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
open Core
open Template
open File_handling
let compile_to_expr (args, elements) =
let codes = ref [] in
let append e = codes := e :: !codes in
if not (String.is_empty args) then
append
(sprintf
{|
Core.(fun %s ->
let ___elements = ref [] in
let ___append e =
___elements := e :: !___elements
in
|}
args)
else
append
{| Core.(let ___elements = ref [] in
let ___append e =
___elements := e :: !___elements
in |};
List.iter elements ~f:(fun ele ->
match ele with
| Text s -> append (sprintf {| ___append {___|%s|___} ;|} s)
| Code s -> append s
| Output_code s -> append (sprintf {| ___append (%s) ;|} s));
append {|
String.concat (List.rev !___elements) )
|};
String.concat (List.rev !codes)
let compile_to_expr_continuation (args, elements) =
let codes = ref [] in
let append e = codes := e :: !codes in
append (sprintf {|Core.(fun %s ___continuation ->|} args);
List.iter elements ~f:(fun ele ->
match ele with
| Text s -> append (sprintf {| ___continuation {___|%s|___} ; |} s)
| Code s -> append s
| Output_code s -> append (sprintf {| ___continuation (%s) ; |} s));
append {| ) |};
String.concat (List.rev !codes)
let compile ?(continuation_mode = false) ?(and_instead_of_let = false) name
header (args, elements) =
sprintf {|%s
%s %s = |} header
(if and_instead_of_let then "and" else {|let [@warning "-39"] rec|})
name
^ (if continuation_mode then compile_to_expr_continuation else compile_to_expr)
(args, elements)
let compile_to_module ?(continuation_mode = false) template =
compile ~continuation_mode "render" "" template
let compile_to_function ?(continuation_mode = false)
?(and_instead_of_let = false) name template =
compile ~continuation_mode ~and_instead_of_let name "" template
let compile_folder ?(continuation_mode = false) folder_name =
let directory =
read_file_or_directory
~filter:(fun filename -> Filename.check_suffix filename ".eml")
~sorted:true folder_name
in
let rec aux first_file_seen_ref current_file =
match current_file with
| File filename -> (
let name = Filename.chop_extension filename in
let function_name = List.last_exn (Filename.parts name) in
match Template_builder.of_filename filename with
| Some template ->
compile_to_function ~continuation_mode
~and_instead_of_let:
( if not !first_file_seen_ref then (
first_file_seen_ref := true;
false )
else true )
function_name template
| None -> failwith "Syntax error" )
| Directory (name, files) ->
let module_name =
String.capitalize (List.last_exn (Filename.parts name))
in
sprintf " module %s = struct\n" module_name
^ (let first_file_seen = ref false in
String.concat_array (Array.map ~f:(aux first_file_seen) files))
^ "\nend\n"
in
match directory with
| File _ ->
if Filename.check_suffix folder_name ".eml" then
let name = Filename.chop_extension folder_name ^ ".ml" in
match Template_builder.of_filename folder_name with
| Some template ->
Out_channel.write_all name
~data:(compile_to_module ~continuation_mode template)
| None -> ()
else ()
| Directory (_, files) ->
let first_file_seen = ref false in
let content =
String.concat_array (Array.map ~f:(aux first_file_seen) files)
in
Out_channel.write_all (folder_name ^ ".ml") ~data:content