blog.ml 16.3 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)

Artemiy's avatar
doc  
Artemiy committed
115 116
(** [normalize_tag tag] takes a tag and rids it of unwanted characters, such as
    utf8, speces, dashes and underscores *)
Artemiy's avatar
Artemiy committed
117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136
let normalize_tag tag =
  let string_map_partial f s =
    let b = Buffer.create (String.length s) in
    let maybeadd c =
      match f c with
      | None -> ()
      | Some c' -> Buffer.add_char b c'
    in
    String.iter maybeadd s;
    Buffer.contents b
  in
  string_map_partial
    (function
      | '-'
      | ' '
      | '_' ->
        None
      | c -> Some (Char.lowercase_ascii c) )
    (Ubase.from_utf8 tag)

137 138 139
(** [allowed_categories] is a list of allowed categories for any article posted
    on the blog *)
let allowed_categories =
140 141 142 143 144 145 146
  [ "Tooling"
  ; "Blockchains"
  ; "OCamlPro"
  ; "Formal Methods"
  ; "Trainings"
  ; "OCaml"
  ; "Rust"
147 148 149 150 151 152 153 154 155 156
  ]

(** [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
157

158 159
(** [get_meta_value field] extract the second field of meta_data required at the
    beginning of the article *)
160
let get_meta_value field = List.hd (List.rev (String.split_on_char '=' field))
161

162
(** [extract_date date] convert date meta_data into a [(int * int * int)] type *)
163 164 165 166 167 168
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)

169 170 171 172 173 174 175 176 177 178 179 180
(** [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

181 182
(** [article_of_string post url] convert a given raw_text article into an
    [article] type *)
183 184
let article_of_string post url =
  match String.split_on_char '\n' post with
185
  | title :: author :: date :: category :: tags :: r ->
186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219
    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 }
220 221
  | _ -> None

222 223 224 225 226
(** [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
227
      | None -> failwith "Couldn't read article data"
228 229 230 231 232
      | Some data -> (
        match
          article_of_string data
            (Filename.basename (Filename.chop_suffix article ".md"))
        with
Dario Pinto's avatar
Dario Pinto committed
233
        | None -> failwith "Invalid article data"
234 235 236 237 238 239 240 241
        | 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 =
242 243
  List.sort_uniq compare @@ List.flatten
  @@ List.map (fun article -> article.authors) articles_data
244

245 246
(** [authors_count] List of all authors with their corresponding count of
    written articles *)
247
let authors_count =
248 249 250 251 252 253 254 255 256 257 258 259
  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
260

261 262
(** [categories_count] List of all categories with their corresponding count of
    written articles *)
263
let categories_count =
264 265 266 267 268 269 270 271 272
  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
273

Artemiy's avatar
Artemiy committed
274
let pp_list_to_blog_links t normalize =
Artemiy's avatar
Artemiy committed
275 276 277
  Format.pp_print_list
    ~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
    (fun fmt e ->
Artemiy's avatar
Artemiy committed
278
      Format.fprintf fmt {|<a href="/blog/%s/%s">%s</a>|} t (normalize e) e )
Artemiy's avatar
Artemiy committed
279

280 281
let links_to_home_pages =
  Format.sprintf
282 283
    {|
    <div class="row">
284
      <div class="col-6 col-lg-4" align="left">
285 286 287 288 289
        <p class="toplinks2">
          <a href="/blog">
            Home
          </a>
        </p>
Dario Pinto's avatar
Dario Pinto committed
290
        <p class="toplinks">
291
          <img class="blogimg" src="/blog/assets/img/icon_home.svg"/>
Dario Pinto's avatar
Dario Pinto committed
292
        </p>
293
      </div>
294
      <div class="col-6 col-lg-4" align="center">
Dario Pinto's avatar
Dario Pinto committed
295
      <p class="toplinks">
296
        <a href="/blog/feed">
297
          <img class="blogimg" src="/blog/assets/img/icon_atom_feed.svg"/>
298
        </a>
Dario Pinto's avatar
Dario Pinto committed
299
      </p>
300
      </div>
301
      <div class="col-6 col-lg-4" align="right">
302 303 304
        <p class="toplinks3">
          <img class="blogimg" src="/blog/assets/img/icon_categories.svg"/>
        </p>
Dario Pinto's avatar
Dario Pinto committed
305
        <p class="toplinks">
306 307 308 309
          <a href="/blog/category">
            Categories
        </p>      
          </a>
Dario Pinto's avatar
Dario Pinto committed
310
        </p>
311
      </div>
312 313
    </div>
    <hr class="featurette-divider"/>|}
314 315 316 317

let pp_article_excerpt fmt article =
  let year, month, day = article.date in
  Format.fprintf fmt
318 319 320 321
    {|
    <div class="row">
      <h3><a href="/blog/%s">%s</a></h3>
    </div>
322
    <div class="row">
323
      <div class="col-6 col-lg-3">
324 325
        <img class="icon" src="/blog/assets/img/icon_person.svg"/>
        Authors: %a
326
      </div>
327
      <div class="col-6 col-lg-3">
328
        <img class="icon" src="/blog/assets/img/icon_calendar.svg"/>
329
        Date: %4d-%02d-%02d
330
      </div>
331
      <div class="col-6 col-lg-3">
332 333
        <img class="icon" src="/blog/assets/img/icon_category.svg"/>
        Category: <a href="/blog/category/%s">%s</a>
334
      </div>
335
      <div class="col-6 col-lg-3">
336
        <img class="icon" src="/blog/assets/img/icon_tags.svg"/>
337
        Tags: %a
338 339
      </div>
    </div>
340
    <br />
341
    %s <a href="/blog/%s">(Read more)</a>|}
342
    article.url article.title
Artemiy's avatar
Artemiy committed
343
    (pp_list_to_blog_links "authors" normalize_url)
344 345 346
    article.authors year month day
    (normalize_url article.category)
    article.category
Artemiy's avatar
Artemiy committed
347
    (pp_list_to_blog_links "tag" normalize_tag)
348
    article.tags (preview article.content) article.url
349 350

let pp_blog_posts fmt articles_data_list =
351 352 353 354 355 356
  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
357 358 359

(** [specific_article_header title author (year, month, day) category tags]
    prints the header for a given blog post *)
360
let specific_article_header title authors (year, month, day) category tags =
361 362 363
  Format.asprintf
    {|<h1 id="page-title">%s</h1>
    <div class="row">
364
      <div class="col-6 col-lg-3">
365
      <img class="icon" src="/blog/assets/img/icon_person.svg"/>
Artemiy's avatar
Artemiy committed
366
        Authors: %a
367
      </div>
368
      <div class="col-6 col-lg-2">
369 370 371
      <img class="icon" src="/blog/assets/img/icon_calendar.svg"/>
        Date: %4d-%02d-%02d
      </div>
372
      <div class="col-6 col-lg-1" align="center">
373
        <a href="/blog/feed"><img class="icon" src="/blog/assets/img/icon_atom_feed.svg"/></a>
Dario Pinto's avatar
Dario Pinto committed
374
      </div>
375
      <div class="col-6 col-lg-3">
376
      <img class="icon" src="/blog/assets/img/icon_category.svg"/>
377
        Category: <a href="/blog/category/%s">%s</a>
378
      </div>
379
      <div class="col-6 col-lg-3">
380 381 382 383
      <img class="icon" src="/blog/assets/img/icon_tags.svg"/>
        Tags: %a
      </div>
    </div>
384
    <br />
385
    <hr class="featurette-divider"/>
386
    <br />|}
387
    title
Artemiy's avatar
Artemiy committed
388
    (pp_list_to_blog_links "authors" normalize_url)
389
    authors year month day (normalize_url category) category
Artemiy's avatar
Artemiy committed
390
    (pp_list_to_blog_links "tag" normalize_tag)
391 392
    tags

393
(** [given_category category] Displays the list of articles corresponding to the
394
    request category *)
395
let given_category category =
Dario Pinto's avatar
Dario Pinto committed
396
  let articles_by_date = List.sort compare_articles articles_data in
397 398
  let articles_of_category =
    List.filter
399
      (fun article -> String.equal (normalize_url article.category) category)
400
      articles_by_date
401
  in
402 403 404
  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
405

406
(** [given_author ocp_author] Displays the list of articles written by a given
407
    [ocp_author] *)
408
let given_author ocp_author =
Dario Pinto's avatar
Dario Pinto committed
409
  let articles_by_date = List.sort compare_articles articles_data in
410 411
  let articles_of_author =
    List.filter
412 413 414 415
      (fun article ->
        List.exists
          (fun author -> String.equal (normalize_url author) ocp_author)
          article.authors )
416 417
      articles_by_date
  in
418 419 420 421
  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
422 423 424
  ( Format.asprintf {|<h1 id="page-title">Articles by %s</h1>%s%a@.|} author
      links_to_home_pages pp_blog_posts articles_of_author
  , author )
425

Artemiy's avatar
Artemiy committed
426 427 428 429 430 431 432
(** [given_tag tag] Displays the list of articles tagged with given [tag] *)
let given_tag tag =
  let articles_by_date = List.sort compare_articles articles_data in
  let articles_with_tag =
    List.filter
      (fun article ->
        List.exists
Artemiy's avatar
Artemiy committed
433
          (fun tag0 -> String.equal (normalize_tag tag0) tag)
Artemiy's avatar
Artemiy committed
434 435 436
          article.tags )
      articles_by_date
  in
Artemiy's avatar
Artemiy committed
437 438 439 440 441
  let tag =
    List.find
      (fun t -> String.equal (normalize_tag t) tag)
      (List.hd articles_with_tag).tags
  in
Artemiy's avatar
Artemiy committed
442 443 444
  Format.asprintf {|<h1 id="page-title">Articles tagged with %s</h1>%s%a@.|} tag
    links_to_home_pages pp_blog_posts articles_with_tag

445 446
(** [category_home] This is the home page for all available categories on the
    Blog, along with number of articles of given category *)
447
let category_home =
448 449
  Format.asprintf {|<h1 id="page-title">Blog Categories</h1>%s%a@.|}
    links_to_home_pages
450 451 452 453
    (Format.pp_print_list
       ~pp_sep:(fun fmt () -> Format.fprintf fmt "<br />")
       (fun fmt (category, count) ->
         Format.fprintf fmt
454 455 456 457 458 459
           {|<h3><a href="/blog/category/%s">%s</a> (%d %s)</h3>|}
           (normalize_url category) category count
           ( if count > 1 then
             "articles"
           else
             "article" ) ) )
460 461 462 463 464
    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
465
  let articles_by_date = List.sort compare_articles articles_data in
466
  Format.asprintf {|<h1 id="page-title">Blog</h1>%s%a@.|} links_to_home_pages
467
    pp_blog_posts articles_by_date