Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 113 lines (93 sloc) 3.188 kb
3e9b98aa »
2009-01-09 Added copyright notices and LICENSE.
1 (* Copyright (C) 2009 Mauricio Fernandez <mfp@acm.org> *)
fed8a48e »
2008-12-22 Initial commit.
2 open ExtString
3 open Printf
4
5 module S = Set.Make(String)
6
e5048a97 »
2009-04-13 Let the compiler infer the type of the (X)HTML output for the entries.
7 type 'html entry = {
fed8a48e »
2008-12-22 Initial commit.
8 name : string;
9 title : string;
10 date : float;
11 markup : Simple_markup.paragraph list;
e5048a97 »
2009-04-13 Let the compiler infer the type of the (X)HTML output for the entries.
12 mutable html : 'html XHTML.M.elt list option;
fed8a48e »
2008-12-22 Initial commit.
13 deps : string list Lazy.t;
14 tags : string list;
15 syndicated : bool;
7d4eaa79 »
2008-12-24 Added per-page "allow_comments" field.
16 allow_comments : bool;
fed8a48e »
2008-12-22 Initial commit.
17 }
18
19 type sort_criterion = [`Date | `Title]
20
21 let assoc_default default key l =
22 try List.assoc key l with Not_found -> default ()
23
24 let parse_date s = Netdate.since_epoch (Netdate.parse s)
25
26 let split_headers_body s =
27 let rec loop headers = function
777fec4d »
2008-12-27 Comments, Node: use Simple_markup.parse_lines instead of parse_text.
28 [] -> (headers, [])
fed8a48e »
2008-12-22 Initial commit.
29 | l::ls -> begin match (try Some (String.split l ":") with _ -> None) with
30 Some (k, v) -> loop ((String.strip k, String.strip v) :: headers) ls
777fec4d »
2008-12-27 Comments, Node: use Simple_markup.parse_lines instead of parse_text.
31 | None -> (headers, (l :: ls))
fed8a48e »
2008-12-22 Initial commit.
32 end
777fec4d »
2008-12-27 Comments, Node: use Simple_markup.parse_lines instead of parse_text.
33 in loop [] (Str.split_delim (Str.regexp "\n") s)
fed8a48e »
2008-12-22 Initial commit.
34
35 let inner_link_re = Str.regexp "^[A-Za-z0-9_-]+$"
36 let is_inner_link s = Str.string_match inner_link_re s 0
37
38 let parse_relative_url s = match String.nsplit s "/" with
39 [page; file] -> Some (page, file)
40 | _ -> None
41
42
43 class depfinder =
44 object(self)
45 inherit Simple_markup.fold as super
46 val deps = S.empty
47
48 method href h =
49 let uri = h.Simple_markup.href_target in
125e0b6c »
2008-12-22 Removed trailing spaces.
50 if is_inner_link uri then {< deps = S.add uri deps >}
fed8a48e »
2008-12-22 Initial commit.
51 else match parse_relative_url uri with
52 Some (page, _) -> {< deps = S.add page deps >}
53 | None -> self
54
55 method img i = match parse_relative_url i.Simple_markup.img_src with
56 None -> self
57 | Some (page, _) -> {< deps = S.add page deps >}
58
59 method deps = deps
60 end
61
62 let (@@) f x = f x
63 let set_keys s = S.fold (fun k l -> k :: l) s []
64
65 let find_deps ps =
125e0b6c »
2008-12-22 Removed trailing spaces.
66 let s =
fed8a48e »
2008-12-22 Initial commit.
67 (List.fold_left (fun o par -> o#paragraph par) (new depfinder) ps)#deps
68 in set_keys s
69
70 let make ~name ~file =
71 let text = Std.input_file ~bin:true file in
777fec4d »
2008-12-27 Comments, Node: use Simple_markup.parse_lines instead of parse_text.
72 let headers, body_lines = split_headers_body text in
fed8a48e »
2008-12-22 Initial commit.
73 let lookup k = List.assoc k headers in
7d4eaa79 »
2008-12-24 Added per-page "allow_comments" field.
74 let bool default k = try bool_of_string (lookup k) with _ -> default in
777fec4d »
2008-12-27 Comments, Node: use Simple_markup.parse_lines instead of parse_text.
75 let markup = Simple_markup.parse_lines body_lines in
fed8a48e »
2008-12-22 Initial commit.
76 {
77 name = name;
78 title = assoc_default (fun _ -> Filename.basename file) "title" headers;
79 date = (try parse_date (lookup "date")
80 with _ -> (Unix.stat file).Unix.st_ctime);
81 markup = markup;
82 html = None;
83 deps = lazy (find_deps markup);
84 tags = (try String.nsplit (lookup "tags") " " with _ -> []);
7d4eaa79 »
2008-12-24 Added per-page "allow_comments" field.
85 syndicated = bool false "syndicate";
86 allow_comments = bool false "allow_comments";
fed8a48e »
2008-12-22 Initial commit.
87 }
88
89 let name e = e.name
90 let date e = e.date
91 let markup e = e.markup
92 let syndicated e = e.syndicated
93 let title e = e.title
94 let tags e = e.tags
95 let deps e = Lazy.force e.deps
7d4eaa79 »
2008-12-24 Added per-page "allow_comments" field.
96 let allow_comments e = e.allow_comments
fed8a48e »
2008-12-22 Initial commit.
97
125e0b6c »
2008-12-22 Removed trailing spaces.
98 let signal_deps_changed e =
fed8a48e »
2008-12-22 Initial commit.
99 e.html <- None
100
101 let get_html f e = match e.html with
125e0b6c »
2008-12-22 Removed trailing spaces.
102 None ->
fed8a48e »
2008-12-22 Initial commit.
103 let html = f e.markup in
104 e.html <- Some html;
105 html
106 | Some html -> html
107
108 let compare ?secondary crit =
109 Catalog.compare_by_criteria
125e0b6c »
2008-12-22 Removed trailing spaces.
110 (function
fed8a48e »
2008-12-22 Initial commit.
111 `Date -> (fun x y -> compare x.date y.date)
112 | `Title -> (fun x y -> compare x.title y.title))
113 ?extra:secondary crit
Something went wrong with that request. Please try again.