blog.ml 14.9 KB
Newer Older
1 2 3
type article =
  { date : int * int * int
  ; title : string
4
  ; authors : string list
5 6 7 8 9 10
  ; tags : string list
  ; category : string
  ; content : string
  ; url : string
  }

11 12 13 14 15 16 17 18
let alt_ergo_footer =
  {|
> ### **About Alt-Ergo**
>
> Alt-Ergo is an open-source automatic solver of mathematical formulas designed for program verification. Alt-Ergo is very successful for proving formulas generated in the context of deductive program verification.
> It was originally designed and tuned to be used by the [Why playform](http://why.lri.fr). Its development started in 2006 at the Laboratoire de Recherche en Informatique (LRI) of the Université Paris Sud and is maintained, developed and distributed since 2013 by the company OCamlPro.
>
> Alt-Ergo is part of the formal method team here at OCamlPro. This work is partially funded by the research projects Soprano, BWare, Vocal and LCHIP.
Dario Pinto's avatar
typo  
Dario Pinto committed
19
> If you like Alt-Ergo, consider joining the [Alt-Ergo users Club](https://alt-ergo.ocamlpro.com/#club)
20 21 22 23 24 25 26 27 28 29 30 31 32
|}

let ocaml_pro_footer =
  {|
> **About OCamlPro:**
>
> OCamlPro is a R&D lab founded in 2011, with the mission to help industrial users benefit from state-of-the art programming languages like OCaml and Rust.
>
>We design, create and implement custom ad-hoc software for our clients. We also have a long experience in developing and maintaining open-source tooling for OCaml, such as Opam, [TryOCaml](http://try.ocamlpro.com), ocp-indent, ocp-index and ocp-browser, and we contribute to the core-development of OCaml, notably with our work on the Flambda optimizer branch.
>
> Another area of expertise is that of Formal Methods, with tools such as our SMT Solver Alt-Ergo (check our [Alt-Ergo Users'](https://alt-ergo.ocamlpro.com/#club)). We also provide vocational trainings in OCaml and Rust, and we can build courses on formal methods on-demand. Do not hesitate to reach out by email: [contact@ocamlpro.com](mailto:contact@ocamlpro.com).
|}

Dario Pinto's avatar
Dario Pinto committed
33 34
let compare_articles a1 a2 = compare (a2.date, a2.title) (a1.date, a1.title)

35 36 37 38 39
let error msg =
  Format.eprintf "error: %s@." msg;
  Format.pp_print_flush Format.err_formatter ();
  exit 1

Dario Pinto's avatar
Dario Pinto committed
40
(* The code below is used to extract a small preview from the content field of an article type with the help of Omd *)
41 42
open Omd

Dario Pinto's avatar
Dario Pinto committed
43 44 45 46 47 48 49 50 51 52 53 54 55 56 57
let handle_html html =
  let c = Markup.string html |> Markup.parse_html |> Markup.signals in
  let buff = Buffer.create 512 in
  let fmt = Format.formatter_of_buffer buff in
  Markup.iter
    (fun element ->
      match element with
      | `End_element -> ()
      | `Start_element (_, _) -> ()
      | `Text ls -> List.iter (fun s -> Format.fprintf fmt "%s " s) ls
      | _ -> () )
    c;
  Format.pp_print_flush fmt ();
  Buffer.contents buff

58
let rec handle_inline = function
Dario Pinto's avatar
Dario Pinto committed
59 60 61 62 63 64 65 66
  | Concat (_attr, attr_inline_list) ->
    List.fold_left (fun acc i -> acc ^ handle_inline i) "" attr_inline_list
  | Text (_attr, s) -> s
  | Emph (_attr, attr_inline) -> handle_inline attr_inline
  | Strong (_attr, attr_inline) -> handle_inline attr_inline
  | Code (_attr, s) -> s
  | Hard_break _attr -> " "
  | Soft_break _attr -> " "
67 68
  | Link (_attr, attr_link) -> handle_inline attr_link.label
  | Image (_attr, attr_link) -> handle_inline attr_link.label
Dario Pinto's avatar
Dario Pinto committed
69
  | Html (_attr, str) -> handle_html str
70 71

let rec handle_block = function
Dario Pinto's avatar
Dario Pinto committed
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89
  | Paragraph (_attr, inline) -> handle_inline inline
  | List (_attr, _list_type, _list_spacing, attr_block_list_list) ->
    Format.asprintf "%a"
      (Format.pp_print_list
         ~pp_sep:(fun fmt () -> Format.fprintf fmt "@.")
         (fun fmt block -> Format.fprintf fmt "%s" (handle_block block)) )
      (List.flatten attr_block_list_list)
  | Blockquote (_attr, attr_block_list) ->
    Format.asprintf "%a"
      (Format.pp_print_list
         ~pp_sep:(fun fmt () -> Format.fprintf fmt "@.")
         (fun fmt block -> Format.fprintf fmt "%s" (handle_block block)) )
      attr_block_list
  | Thematic_break _attr -> ""
  | Heading (_attr, _i, attr_inline) -> handle_inline attr_inline
  | Code_block (_attr, _s1, _s2) -> ""
  | Html_block (_attr, str) -> handle_html str
  | Definition_list (_attr, _attr_def_elt_list) -> ""
90

Dario Pinto's avatar
Dario Pinto committed
91
let find_preview n doc =
92 93
  let str =
    String.concat " "
Dario Pinto's avatar
Dario Pinto committed
94 95
    @@ List.filter
         (fun x -> x <> "")
96 97
         (List.map (fun block -> handle_block block) doc)
  in
Dario Pinto's avatar
Dario Pinto committed
98 99
  try String.sub str 0 n with
  | Invalid_argument _s -> str
100 101

let preview article_content =
Dario Pinto's avatar
Dario Pinto committed
102
  let content = Omd.of_string article_content |> find_preview 300 in
Dario Pinto's avatar
Dario Pinto committed
103 104
  Format.sprintf "%s..." content
(* The code above is used to extract a small preview from the content field of an article type with the help of Omd *)
105 106 107

(** [normalize_url target] takes a target URL and rids it of unwanted
    characters, such as utf8, and spaces *)
108 109 110 111 112 113 114
let normalize_url target =
  String.map
    (function
      | ' ' -> '_'
      | c -> c |> Char.lowercase_ascii )
    (Ubase.from_utf8 target)

115 116 117
(** [allowed_categories] is a list of allowed categories for any article posted
    on the blog *)
let allowed_categories =
118 119 120 121 122 123 124
  [ "Tooling"
  ; "Blockchains"
  ; "OCamlPro"
  ; "Formal Methods"
  ; "Trainings"
  ; "OCaml"
  ; "Rust"
125 126 127 128 129 130 131 132 133 134
  ]

(** [raw_articles] List of all raw text in all articles in /content/blog/
    subdirectory *)
let raw_articles =
  List.find_all
    (fun file ->
      (String.length file >= 5 && String.equal (String.sub file 0 5) "blog/")
      && Filename.check_suffix file ".md" )
    Content.file_list
135

136 137
(** [get_meta_value field] extract the second field of meta_data required at the
    beginning of the article *)
138
let get_meta_value field = List.hd (List.rev (String.split_on_char '=' field))
139

140
(** [extract_date date] convert date meta_data into a [(int * int * int)] type *)
141 142 143 144 145 146
let extract_date date =
  match String.split_on_char '-' date with
  | [ year; month; day ] ->
    (int_of_string year, int_of_string month, int_of_string day)
  | _ -> (0, 0, 0)

147 148 149 150 151 152 153 154 155 156 157 158
(** [article_footer category tags] returns a footer according to a specific type
    of article, . While quite generic at the moment, it will be possible to make
    it return more specific footers based on a given article's Category and Tags *)
let article_footer category tags =
  match category with
  | "Formal Methods" ->
    if List.exists (String.equal "alt-ergo") tags then
      alt_ergo_footer
    else
      ocaml_pro_footer
  | _ -> ocaml_pro_footer

159 160
(** [article_of_string post url] convert a given raw_text article into an
    [article] type *)
161 162
let article_of_string post url =
  match String.split_on_char '\n' post with
163
  | title :: author :: date :: category :: tags :: r ->
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197
    let date = extract_date (get_meta_value date) in
    let title = get_meta_value title in
    let authors =
      let auth = get_meta_value author in
      match String.split_on_char ',' auth with
      | [ "" ] -> [ "Unspecified authors!" ]
      | auth -> auth
    in
    let tags =
      let tags = get_meta_value tags in
      match String.split_on_char ',' tags with
      | [ "" ] -> [ "Unspecified tags!" ]
      | tags -> tags
    in
    let category =
      let c = get_meta_value category in
      if not @@ List.mem c allowed_categories then (
        let err_msg =
          Format.asprintf {|Category (%s) invalid, try: %a@.|} c
            (Format.pp_print_list
               ~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
               Format.pp_print_string )
            allowed_categories
        in
        Format.pp_print_flush Format.str_formatter ();
        error err_msg
      );
      c
    in
    let content =
      String.concat "\n" r ^ {|<br /><hr class="featurette-divider"/>|}
      ^ article_footer category tags
    in
    Some { date; title; authors; tags; category; content; url }
198 199
  | _ -> None

200 201 202 203 204
(** [get_article_data raw_articles] Returns a list of [article] types *)
let get_article_data raw_articles =
  List.map
    (fun article ->
      match Content.read article with
Dario Pinto's avatar
Dario Pinto committed
205
      | None -> failwith "Couldn't read article data"
206 207 208 209 210
      | Some data -> (
        match
          article_of_string data
            (Filename.basename (Filename.chop_suffix article ".md"))
        with
Dario Pinto's avatar
Dario Pinto committed
211
        | None -> failwith "Invalid article data"
212 213 214 215 216 217 218 219
        | Some data -> data ) )
    raw_articles

(** [articles_data] A list of [article] types *)
let articles_data = get_article_data raw_articles

(** [authors] The list of authors in the current pool of available articles *)
let authors =
220 221
  List.sort_uniq compare @@ List.flatten
  @@ List.map (fun article -> article.authors) articles_data
222

223 224
(** [authors_count] List of all authors with their corresponding count of
    written articles *)
225
let authors_count =
226 227 228 229 230 231 232 233 234 235 236 237
  let tbl = Hashtbl.create 512 in
  List.iter
    (fun article ->
      List.iter
        (fun author ->
          match Hashtbl.find_opt tbl author with
          | None -> Hashtbl.add tbl author 1
          | Some count -> Hashtbl.replace tbl author (count + 1) )
        article.authors )
    articles_data;
  let l = Hashtbl.fold (fun k v acc -> (k, v) :: acc) tbl [] in
  List.sort (fun (k1, v1) (k2, v2) -> compare (v2, k2) (v1, k1)) l
238

239 240
(** [categories_count] List of all categories with their corresponding count of
    written articles *)
241
let categories_count =
242 243 244 245 246 247 248 249 250
  let tbl = Hashtbl.create 512 in
  List.iter
    (fun article ->
      match Hashtbl.find_opt tbl article.category with
      | None -> Hashtbl.add tbl article.category 1
      | Some count -> Hashtbl.replace tbl article.category (count + 1) )
    articles_data;
  let l = Hashtbl.fold (fun k v acc -> (k, v) :: acc) tbl [] in
  List.sort (fun (k1, v1) (k2, v2) -> compare (v2, k2) (v1, k1)) l
251

Artemiy's avatar
Artemiy committed
252 253 254 255 256 257 258
let pp_list_to_blog_links t =
  Format.pp_print_list
    ~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
    (fun fmt e ->
      Format.fprintf fmt {|<a href="/blog/%s/%s">%s</a>|} t (normalize_url e) e
      )

259 260
let links_to_home_pages =
  Format.sprintf
261 262
    {|
    <div class="row">
263
      <div class="col-lg-4" align="left">
Dario Pinto's avatar
Dario Pinto committed
264
        <p class="toplinks">
265 266
          <img class="" src="/blog/assets/img/icon_home.svg"/>
          <a href="/blog">Home</a>
Dario Pinto's avatar
Dario Pinto committed
267
        </p>
268 269
      </div>
      <div class="col-lg-4" align="center">
Dario Pinto's avatar
Dario Pinto committed
270
      <p class="toplinks">
271 272 273
        <a href="/blog/feed">
          <img class="feed" src="/blog/assets/img/icon_atom_feed.svg"/>
        </a>
Dario Pinto's avatar
Dario Pinto committed
274
      </p>
275 276
      </div>
      <div class="col-lg-4" align="right">
Dario Pinto's avatar
Dario Pinto committed
277
        <p class="toplinks">
278 279
          <img class="" src="/blog/assets/img/icon_categories.svg"/>
          <a href="/blog/category">Categories</a>
Dario Pinto's avatar
Dario Pinto committed
280
        </p>
281
      </div>
282 283
    </div>
    <hr class="featurette-divider"/>|}
284 285 286 287

let pp_article_excerpt fmt article =
  let year, month, day = article.date in
  Format.fprintf fmt
288 289 290 291
    {|
    <div class="row">
      <h3><a href="/blog/%s">%s</a></h3>
    </div>
292 293
    <div class="row">
      <div class="col-lg-3">
294 295
        <img class="icon" src="/blog/assets/img/icon_person.svg"/>
        Authors: %a
296 297
      </div>
      <div class="col-lg-3">
298
        <img class="icon" src="/blog/assets/img/icon_calendar.svg"/>
299
        Date: %4d-%02d-%02d
300 301
      </div>
      <div class="col-lg-3">
302 303
        <img class="icon" src="/blog/assets/img/icon_category.svg"/>
        Category: <a href="/blog/category/%s">%s</a>
304 305
      </div>
      <div class="col-lg-3">
306
        <img class="icon" src="/blog/assets/img/icon_tags.svg"/>
307
        Tags: %a
308 309
      </div>
    </div>
310
    <br />
311
    %s <a href="/blog/%s">(Read more)</a>|}
312
    article.url article.title
Artemiy's avatar
Artemiy committed
313
    (pp_list_to_blog_links "authors")
314 315 316
    article.authors year month day
    (normalize_url article.category)
    article.category
Artemiy's avatar
Artemiy committed
317
    (pp_list_to_blog_links "tag")
318
    article.tags (preview article.content) article.url
319 320

let pp_blog_posts fmt articles_data_list =
321 322 323 324 325 326
  Format.fprintf fmt "%a"
    (Format.pp_print_list
       ~pp_sep:(fun fmt () ->
         Format.fprintf fmt {|<hr class="featurette-divider" /><br />|} )
       pp_article_excerpt )
    articles_data_list
327 328 329

(** [specific_article_header title author (year, month, day) category tags]
    prints the header for a given blog post *)
330
let specific_article_header title authors (year, month, day) category tags =
331 332 333 334 335
  Format.asprintf
    {|<h1 id="page-title">%s</h1>
    <div class="row">
      <div class="col-lg-3">
      <img class="icon" src="/blog/assets/img/icon_person.svg"/>
Artemiy's avatar
Artemiy committed
336
        Authors: %a
337
      </div>
Dario Pinto's avatar
Dario Pinto committed
338
      <div class="col-lg-2">
339 340 341
      <img class="icon" src="/blog/assets/img/icon_calendar.svg"/>
        Date: %4d-%02d-%02d
      </div>
Dario Pinto's avatar
Dario Pinto committed
342
      <div class="col-lg-1" align="center">
343
        <a href="/blog/feed"><img class="icon" src="/blog/assets/img/icon_atom_feed.svg"/></a>
Dario Pinto's avatar
Dario Pinto committed
344
      </div>
345 346
      <div class="col-lg-3">
      <img class="icon" src="/blog/assets/img/icon_category.svg"/>
347
        Category: <a href="/blog/category/%s">%s</a>
348 349 350 351 352 353
      </div>
      <div class="col-lg-3">
      <img class="icon" src="/blog/assets/img/icon_tags.svg"/>
        Tags: %a
      </div>
    </div>
354
    <br />
355
    <hr class="featurette-divider"/>
356
    <br />|}
357
    title
Artemiy's avatar
Artemiy committed
358
    (pp_list_to_blog_links "authors")
359
    authors year month day (normalize_url category) category
Artemiy's avatar
Artemiy committed
360
    (pp_list_to_blog_links "tag")
361 362
    tags

363
(** [given_category category] Displays the list of articles corresponding to the
364
    request category *)
365
let given_category category =
Dario Pinto's avatar
Dario Pinto committed
366
  let articles_by_date = List.sort compare_articles articles_data in
367 368
  let articles_of_category =
    List.filter
369
      (fun article -> String.equal (normalize_url article.category) category)
370
      articles_by_date
371
  in
372 373 374
  let category = (List.hd articles_of_category).category in
  Format.asprintf {|<h1 id="page-title">Articles on %s</h1>%s%a@.|} category
    links_to_home_pages pp_blog_posts articles_of_category
375

376
(** [given_author ocp_author] Displays the list of articles written by a given
377
    [ocp_author] *)
378
let given_author ocp_author =
Dario Pinto's avatar
Dario Pinto committed
379
  let articles_by_date = List.sort compare_articles articles_data in
380 381
  let articles_of_author =
    List.filter
382 383 384 385
      (fun article ->
        List.exists
          (fun author -> String.equal (normalize_url author) ocp_author)
          article.authors )
386 387
      articles_by_date
  in
388 389 390 391
  let authors = (List.hd articles_of_author).authors in
  let author =
    List.find (fun auth -> String.equal (normalize_url auth) ocp_author) authors
  in
Dario Pinto's avatar
Dario Pinto committed
392 393 394
  ( Format.asprintf {|<h1 id="page-title">Articles by %s</h1>%s%a@.|} author
      links_to_home_pages pp_blog_posts articles_of_author
  , author )
395

396 397
(** [category_home] This is the home page for all available categories on the
    Blog, along with number of articles of given category *)
398
let category_home =
399 400
  Format.asprintf {|<h1 id="page-title">Blog Categories</h1>%s%a@.|}
    links_to_home_pages
401 402 403 404
    (Format.pp_print_list
       ~pp_sep:(fun fmt () -> Format.fprintf fmt "<br />")
       (fun fmt (category, count) ->
         Format.fprintf fmt
405 406 407 408 409 410
           {|<h3><a href="/blog/category/%s">%s</a> (%d %s)</h3>|}
           (normalize_url category) category count
           ( if count > 1 then
             "articles"
           else
             "article" ) ) )
411 412 413 414 415
    categories_count

(** [home_page] this is the home page for the blog, articles appear as excerpts
    from most recent to oldest *)
let home_page =
Dario Pinto's avatar
Dario Pinto committed
416
  let articles_by_date = List.sort compare_articles articles_data in
417
  Format.asprintf {|<h1 id="page-title">Blog</h1>%s%a@.|} links_to_home_pages
418
    pp_blog_posts articles_by_date