-
Notifications
You must be signed in to change notification settings - Fork 2
/
run.ml
241 lines (178 loc) · 6.13 KB
/
run.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
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
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
(* Ohm is © 2012 Victor Nicollet *)
open BatPervasives
let hub = Hub.make (function
| "verb" | "verbatim" -> Some Lex_verbatim.lex
| "html" -> Some Lex_html.lex
| "url" -> Some Lex_url.lex
| "ocaml" -> Some Lex_ocaml.lex
| _ -> None
)
let putfile path contents =
let should =
try Digest.file path <> Digest.string contents
with _ -> true
in
if should then begin
try let channel = Pervasives.open_out_bin path in
Pervasives.output_string channel contents ;
Pervasives.close_out channel
with exn ->
Printf.printf "Could not write file %S : %s\n"
path (Printexc.to_string exn) ;
exit (-1) ;
end ;
should
let extract file lexer =
try
let channel = Pervasives.open_in file in
try
let lexbuf = Lexing.from_channel channel in
let buf = new Buf.t in
lexer hub buf lexbuf ;
Pervasives.close_in channel ;
buf
with exn ->
Pervasives.close_in channel ;
raise exn
with exn ->
Printf.printf "Could not process file %S : %s\n"
file (Printexc.to_string exn) ;
exit (-1)
let process file =
let lexer =
if BatString.ends_with file ".htm" then Some Lex_html.lex else
if BatString.ends_with file ".html" then Some Lex_html.lex else
None
in
match lexer with
| Some lexer -> `PAGE (extract file lexer)
| None -> `FILE file
let rec directory path =
let stat =
try Unix.stat path
with exn ->
Printf.printf "Could not stat %S : %s\n"
path (Printexc.to_string exn) ;
exit (-1)
in
match stat.Unix.st_kind with
| Unix.S_REG -> [ path, process path ]
| Unix.S_DIR ->
let contents =
try Array.to_list (Sys.readdir path)
with exn ->
Printf.printf "Could not list directory %S : %s\n"
path (Printexc.to_string exn) ;
exit (-1)
in
let valid =
List.filter (fun str ->
not (BatString.starts_with str ".")
&& not (BatString.ends_with str "~")
&& not (BatString.starts_with str "#")
) contents
in
List.concat (List.map (Filename.concat path |- directory) valid)
| _ -> []
let generate ?name root =
let root =
if Filename.is_implicit root then Filename.concat (Sys.getcwd ()) root
else root
in
let name = BatOption.default (String.lowercase (Filename.basename root)) name in
let list = directory root in
let clean = List.map (fun (path,contents) ->
let path =
if BatString.starts_with path root
then BatString.tail path (String.length root)
else path
in
let path =
if BatString.starts_with path "/"
then BatString.tail path 1
else path
in
path, contents
) list in
let () =
let init = "ohm publish" in
let buf = Buffer.create 1024 in
Buffer.add_string buf init ;
List.iter begin fun (path,contents) ->
match contents with `PAGE _ -> () | `FILE full ->
Buffer.add_char buf ' ' ;
Buffer.add_string buf (Filename.quote full) ;
Buffer.add_char buf ' ' ;
Buffer.add_string buf (Filename.quote ("/" ^ Filename.concat name path))
end clean ;
let command = Buffer.contents buf in
if command <> init then
ignore (Sys.command command)
in
let mlfile =
let mlbuf = Buffer.create 1024 in
Buffer.add_string mlbuf "(* This file was generated by plugin ohmStatic *)\n" ;
Buffer.add_string mlbuf "let site = BatPMap.of_enum (BatList.enum [\n" ;
List.iter (fun (path,contents) ->
match contents with
| `PAGE page ->
Buffer.add_string mlbuf (Printf.sprintf " %S, `Page (object\n" path) ;
(* METHOD "body" *)
Buffer.add_string mlbuf " method body url html = \n" ;
List.iter (function
| `RAW s -> Buffer.add_string mlbuf
(Printf.sprintf " Ohm.Html.str %S html ;\n" s)
| `URL s -> Buffer.add_string mlbuf
(Printf.sprintf " Ohm.Html.esc (url %S) html ;\n" s)) (page # contents) ;
(* METHOD "css" *)
Buffer.add_string mlbuf " method css url = []\n" ;
(* METHOD "js" *)
Buffer.add_string mlbuf " method js url = []\n" ;
(* METHOD "head" *)
Buffer.add_string mlbuf " method head url = \"\"\n" ;
(* METHOD "bcls" *)
Buffer.add_string mlbuf " method bcls = []\n" ;
(* METHOD "title" *)
Buffer.add_string mlbuf " method title = None\n" ;
(* METHOD "json" *)
Buffer.add_string mlbuf " method json url = [\n" ;
List.iter (fun (key,json) ->
Buffer.add_string mlbuf (Printf.sprintf " %S, " key) ;
begin match json with
| [] -> Buffer.add_string mlbuf "Json.Null"
| [ `RAW s ] -> Buffer.add_string mlbuf (Printf.sprintf "Ohm.Json.deserialize %S" s)
| _ ->
Buffer.add_string mlbuf "Ohm.Json.deserialize (String.concat \"\" [\n" ;
List.iter (function
| `RAW s -> Buffer.add_string mlbuf (Printf.sprintf " %S ;\n" s)
| `URL s -> Buffer.add_string mlbuf (Printf.sprintf " url %S ;\n" s)) json ;
Buffer.add_string mlbuf " ])"
end ;
Buffer.add_string mlbuf " ;\n") (page # json) ;
Buffer.add_string mlbuf " ]\n" ;
Buffer.add_string mlbuf " end) ;\n"
| `FILE full ->
Buffer.add_string mlbuf (Printf.sprintf " %S, `File %S ;\n" path (Filename.concat name path) )
) clean ;
Buffer.add_string mlbuf "])\n\n" ;
Buffer.contents mlbuf
in
let mlifile =
"val site : OhmStatic.site\n"
in
let modname = if name = "static" then "static" else "static_" ^ name in
let mlpath = Filename.(concat (concat (Sys.getcwd ()) "_build") modname ^ ".ml") in
let mlipath = mlpath ^ "i" in
if putfile mlpath mlfile then
Printf.printf "Generated %s\n" mlpath ;
if putfile mlipath mlifile then
Printf.printf "Generated %s\n" mlipath
let () =
if Array.length Sys.argv > 1 && Sys.argv.(1) = "dwim" then
generate ~name:"static" (Filename.concat (Sys.getcwd ()) "static")
else if Array.length Sys.argv = 2 then
generate Sys.argv.(1)
else if Array.length Sys.argv > 2 then
generate ~name:Sys.argv.(2) Sys.argv.(1)
else
Printf.printf "plugin:ohmStatic requires at least one argument"