Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: more-markdown-…
Fetching contributors…

Cannot retrieve contributors at this time

114 lines (93 sloc) 3.188 kb
(* Copyright (C) 2009 Mauricio Fernandez <mfp@acm.org> *)
open ExtString
open Printf
module S = Set.Make(String)
type 'html entry = {
name : string;
title : string;
date : float;
markup : Simple_markup.paragraph list;
mutable html : 'html XHTML.M.elt list option;
deps : string list Lazy.t;
tags : string list;
syndicated : bool;
allow_comments : bool;
}
type sort_criterion = [`Date | `Title]
let assoc_default default key l =
try List.assoc key l with Not_found -> default ()
let parse_date s = Netdate.since_epoch (Netdate.parse s)
let split_headers_body s =
let rec loop headers = function
[] -> (headers, [])
| l::ls -> begin match (try Some (String.split l ":") with _ -> None) with
Some (k, v) -> loop ((String.strip k, String.strip v) :: headers) ls
| None -> (headers, (l :: ls))
end
in loop [] (Str.split_delim (Str.regexp "\n") s)
let inner_link_re = Str.regexp "^[A-Za-z0-9_-]+$"
let is_inner_link s = Str.string_match inner_link_re s 0
let parse_relative_url s = match String.nsplit s "/" with
[page; file] -> Some (page, file)
| _ -> None
class depfinder =
object(self)
inherit Simple_markup.fold as super
val deps = S.empty
method href h =
let uri = h.Simple_markup.href_target in
if is_inner_link uri then {< deps = S.add uri deps >}
else match parse_relative_url uri with
Some (page, _) -> {< deps = S.add page deps >}
| None -> self
method img i = match parse_relative_url i.Simple_markup.img_src with
None -> self
| Some (page, _) -> {< deps = S.add page deps >}
method deps = deps
end
let (@@) f x = f x
let set_keys s = S.fold (fun k l -> k :: l) s []
let find_deps ps =
let s =
(List.fold_left (fun o par -> o#paragraph par) (new depfinder) ps)#deps
in set_keys s
let make ~name ~file =
let text = Std.input_file ~bin:true file in
let headers, body_lines = split_headers_body text in
let lookup k = List.assoc k headers in
let bool default k = try bool_of_string (lookup k) with _ -> default in
let markup = Simple_markup.parse_lines body_lines in
{
name = name;
title = assoc_default (fun _ -> Filename.basename file) "title" headers;
date = (try parse_date (lookup "date")
with _ -> (Unix.stat file).Unix.st_ctime);
markup = markup;
html = None;
deps = lazy (find_deps markup);
tags = (try String.nsplit (lookup "tags") " " with _ -> []);
syndicated = bool false "syndicate";
allow_comments = bool false "allow_comments";
}
let name e = e.name
let date e = e.date
let markup e = e.markup
let syndicated e = e.syndicated
let title e = e.title
let tags e = e.tags
let deps e = Lazy.force e.deps
let allow_comments e = e.allow_comments
let signal_deps_changed e =
e.html <- None
let get_html f e = match e.html with
None ->
let html = f e.markup in
e.html <- Some html;
html
| Some html -> html
let compare ?secondary crit =
Catalog.compare_by_criteria
(function
`Date -> (fun x y -> compare x.date y.date)
| `Title -> (fun x y -> compare x.title y.title))
?extra:secondary crit
Jump to Line
Something went wrong with that request. Please try again.