package yocaml_syndication

  1. Overview
  2. Docs

Source file rss1.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
(* YOCaml a static blog generator.
   Copyright (C) 2024 The Funkyworkers and The YOCaml's developers

   This program is free software: you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation, either version 3 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program.  If not, see <https://www.gnu.org/licenses/>. *)

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)