Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
159 lines (146 sloc) 5.2 KB
(* Copyright (C) 2009 Mauricio Fernandez <mfp@acm.org> *)
open XML
open ExtList
type image = {
img_url : string;
img_title : string;
img_link : string;
}
type item = {
it_title : string;
it_link : string;
it_description : string;
it_author : string option;
it_category : string option;
it_comments : string option;
(* it_enclosure : *)
it_pubDate : float option;
it_guid : (string * bool) option;
(* it_source: *)
}
let item_date it = it.it_pubDate
let elm kind ?(attrs = []) v = Node(kind, attrs, [PCDATA v])
let opt_elm kind ?attrs = Option.map (elm kind ?attrs)
let some_elm kind ?attrs v = Some (elm kind ?attrs v)
let format_date t = Netdate.mk_mail_date t
let format_date_rdf t = Netdate.format "%Y-%m-%dT%H:%M:%SZ" (Netdate.create ~zone:0 t)
let filter_concat ls = List.filter_map (fun x -> x) (List.concat ls)
let filter_some = List.filter_map (fun x -> x)
let encode_pcdata s = [PCDATA s] (* TODO: use CDATA instead? *)
let xml_of_item item =
Node
("item", [],
filter_concat
[[some_elm "title" item.it_title;
some_elm "link" item.it_link;
some_elm "description" item.it_description;
opt_elm "author" item.it_author;
opt_elm "category" item.it_category;
opt_elm "comments" item.it_comments;
opt_elm "pubDate" (Option.map format_date item.it_pubDate);
Option.map
(fun (guid, is_perm) ->
let perm = string_attrib "isPermaLink" (string_of_bool is_perm) in
Node("guid", [perm], [PCDATA guid]))
item.it_guid
]])
let make
~title ~link ~description ?self_link
?language ?copyright ?managingEditor ?webMaster ?pubDate
?lastBuildDate ?category ?generator ?ttl ?image
items =
let channel =
filter_concat
[[some_elm "title" title;
some_elm "link" link;
Option.map
(fun link ->
Leaf ("atom:link", [string_attrib "href" link;
string_attrib "rel" "self";
string_attrib "type" "application/rss+xml"]))
self_link;
some_elm "description" description;
opt_elm "language" language;
opt_elm "copyright" copyright;
opt_elm "managingEditor" managingEditor;
opt_elm "webMaster" webMaster;
opt_elm "pubDate" (Option.map format_date pubDate);
opt_elm "lastBuildDate" (Option.map format_date lastBuildDate);
opt_elm "category" category;
opt_elm "generator" generator;
opt_elm "ttl" (Option.map string_of_int ttl);
Option.map
(fun img ->
Node("image", [],
[elm "url" img.img_url;
elm "title" img.img_title;
elm "link" img.img_link]))
image;
];
List.map (fun it -> Some (xml_of_item it)) items
]
in
Node("rss", [string_attrib "version" "2.0";
string_attrib "xmlns:atom" "http://www.w3.org/2005/Atom"],
[Node("channel", [], channel)])
let make_rdf
~title ~link ~description ~date ?language ?copyright ?image items =
let it_list_elm =
Node
("items", [],
[Node ("rdf:Seq", [],
List.map
(fun it -> Leaf ("rdf:li", [string_attrib "resource" it.it_link]))
items)]) in
let channel_elm =
Node("channel", [string_attrib "rdf:about" link],
filter_some
[some_elm "title" title;
some_elm "link" link;
some_elm "description" description;
Option.map
(fun img -> Leaf("image", [string_attrib "rdf:resource" img.img_url]))
image;
opt_elm "dc:language" language;
opt_elm "dc:rights" copyright;
some_elm "dc:date" (format_date_rdf date);
Some it_list_elm]) in
let image_elm =
Option.map
(fun img ->
[Node ("image", [string_attrib "rdf:about" img.img_url],
[elm "title" img.img_title;
elm "link" img.img_link;
elm "url" img.img_url])])
image in
let elm_of_item it =
let c = Node("content:encoded", [], encode_pcdata it.it_description) in
Node ("item", [string_attrib "rdf:about" it.it_link],
(elm "title" it.it_title ::
elm "link" it.it_link ::
c ::
Option.map_default
(fun date -> [elm "dc:date" (format_date_rdf date)])
[]
it.it_pubDate));
in Node
("rdf:RDF",
[string_attrib "xmlns" "http://purl.org/rss/1.0/";
string_attrib "xmlns:dc" "http://purl.org/dc/elements/1.1/";
string_attrib "xmlns:rdf" "http://www.w3.org/1999/02/22-rdf-syntax-ns#";
string_attrib "xmlns:content" "http://purl.org/rss/1.0/modules/content/";
string_attrib "xml:lang" "en"],
List.concat
[[channel_elm]; Option.default [] image_elm; List.map elm_of_item items])
let make_item
~title ~link ~description ?author ?category ?comments ?pubDate ?guid () =
{
it_title = title;
it_link = link;
it_description = description;
it_author = author;
it_category = category;
it_comments = comments;
it_pubDate = pubDate;
it_guid = guid
}