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
module X = struct
open Xml
let title x = leaf ~name:"title" (escape x)
let link x = leaf ~name:"link" (Some x)
let url x = leaf ~name:"url" (Some x)
let description x = leaf ~name:"description" (cdata x)
let about x = Attr.string ~ns:"rdf" ~key:"about" x
let resource x = Attr.string ~ns:"rdf" ~key:"resource" x
end
module Image = struct
type t = { title : string; link : string; url : string }
let to_xml { title; link; url } =
Xml.node ~name:"image"
~attr:[ X.about url ]
[ X.title title; X.link link; X.url url ]
let make ~title ~link ~url = { title; link; url }
end
module Item = struct
type t = { title : string; link : string; description : string }
let to_xml { title; link; description } =
Xml.node ~name:"item"
~attr:[ X.about link ]
[ X.title title; X.link link; X.description description ]
let make ~title ~link ~description = { title; link; description }
end
module Channel = struct
type t = {
title : string
; url : string
; link : string
; description : string
; image : Image.t option
; textinput : Text_input.t option
; items : Item.t list
}
let make ~title ~url ~link ~description ~image ~textinput ~items =
{ title; url; link; description; image; textinput; items }
let make_image image =
let open Xml in
may
(fun image ->
leaf ~name:"image" ~attr:[ X.resource image.Image.url ] None)
image
let make_textinput textinput = Xml.may Text_input.to_rss1_channel textinput
let make_items = function
| [] -> None
| xs ->
let open Xml in
let items =
node ~name:"items"
[
node ~ns:"rdf" ~name:"Seq"
@@ List.map
(fun item ->
leaf ~ns:"rdf" ~name:"li"
~attr:Attr.[ string ~key:"resource" item.Item.link ]
None)
xs
]
in
Some items
let to_xml { title; url; link; description; image; textinput; items } =
Xml.node ~name:"channel"
~attr:[ X.about url ]
[
X.title title
; X.link link
; X.description description
; make_image image
; make_textinput textinput
; Xml.opt @@ make_items items
]
end
type image = Image.t
type item = Item.t
let image = Image.make
let item = Item.make
let feed ?encoding ?standalone ?image ?textinput ~title ~url ~link ~description
f items =
let items = List.map f items in
let channel =
Channel.make ~title ~url ~link ~description ~image ~textinput ~items
in
let nodes =
[
Channel.to_xml channel
; Xml.may Image.to_xml image
; Xml.may Text_input.to_rss1 textinput
]
@ List.map (fun x -> Item.to_xml x) items
in
Xml.document ?encoding ?standalone ~version:"1.0"
(Xml.node ~ns:"rdf" ~name:"RDF"
~attr:
Xml.Attr.
[
string ~ns:"xmlns" ~key:"rdf"
"http://www.w3.org/1999/02/22-rdf-syntax-ns#"
; string ~key:"xmlns" "http://purl.org/rss/1.0/"
]
nodes)
let from ?encoding ?standalone ?image ?textinput ~title ~url ~link ~description
f =
Yocaml.Task.lift (fun articles ->
let feed =
feed ?encoding ?standalone ?image ?textinput ~title ~url ~link
~description f articles
in
Xml.to_string feed)
let from_articles ?encoding ?standalone ?image ?textinput ~title ~feed_url
~site_url ~description () =
from ?encoding ?standalone ?image ?textinput ~title ~url:feed_url
~link:site_url ~description (fun (path, article) ->
let open Yocaml.Archetype in
let title = Article.title article in
let link = site_url ^ Yocaml.Path.to_string path in
let description =
Option.value ~default:"no description" (Article.synopsis article)
in
item ~title ~link ~description)