Compare commits
No commits in common. "82ccf565fca6ee96ce207f8a65e3de99eed84bb7" and "c363e84b9632c49b66eb83e1a2cf8c7ede690f33" have entirely different histories.
82ccf565fc
...
c363e84b96
|
|
@ -1,6 +1,3 @@
|
|||
---
|
||||
title: About me
|
||||
---
|
||||
## About
|
||||
|
||||
I have an interest in programming languages, and in particular *functional* ones with a *good* type system.
|
||||
|
|
|
|||
|
|
@ -1,6 +1,3 @@
|
|||
---
|
||||
title: Contact
|
||||
---
|
||||
## Email
|
||||
|
||||
I have written my email in [BNF](http://en.wikipedia.org/wiki/Backus%E2%80%93Naur_Form):
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
---
|
||||
title: Hakyll
|
||||
date: 2013-10-19
|
||||
description: First post
|
||||
---
|
||||
|
||||
I decided to check out [Hakyll](http://jaspervdj.be/hakyll). It is a static
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
---
|
||||
title: Intertubes
|
||||
date: 2013-10-19
|
||||
description: A short description of what happens when you click on Mario
|
||||
---
|
||||
|
||||
\
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
---
|
||||
title: AngularJS training
|
||||
date: 2014-10-02
|
||||
description: I went to a AngularJS training
|
||||
---
|
||||
|
||||
Yesterday I attended a great [AngularJS](https://angularjs.org/) training session by [Matias Niemelä](http://www.yearofmoo.com/) after having volunteered for the [goto Aarhus](http://gotocon.com/aarhus-2014/) conference.
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
---
|
||||
date: 2014-10-05
|
||||
title: DigitalOcean tcpdump?
|
||||
description: I noticed an odd "tcpdump" event in DigitalOcean API output
|
||||
---
|
||||
Lately I have been working on implementing v2 of DigitalOcean's API.
|
||||
While doing that I ran a query to get all actions on my account.
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
---
|
||||
title: SSH Certificates with Gitolite
|
||||
date: 2015-11-08
|
||||
description: How to use SSH certificates with Gitolite
|
||||
---
|
||||
|
||||
[Gitolite] is a "an access control layer on top of Git, providing fine access control to Git repositories."
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
---
|
||||
title: Mirage hack retreat 2017
|
||||
date: 2017-03-20
|
||||
description: I went to a MirageOS hack retreat and wrote a trip report
|
||||
---
|
||||
|
||||
Two weeks ago I was in Marrakech to attend the third [Mirage](https://mirage.io/) [hack retreat](http://marrakech2017.mirage.io/).
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
---
|
||||
title: Python's `str.__repr__()`
|
||||
date: 2024-02-03
|
||||
description: Reimplementing Python string escaping in OCaml
|
||||
---
|
||||
Sometimes software is written using whatever built-ins you find in your programming language of choice.
|
||||
This is usually great!
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
---
|
||||
title: Discoveries made implementing MirageVPN, a OpenVPN-compatible VPN library
|
||||
date: 2024-08-21
|
||||
description: Discoveries made implementing MirageVPN, a OpenVPN-compatible VPN library
|
||||
---
|
||||
At [Robur][robur] we have been busy at work implementing our OpenVPN™-compatible MirageVPN software.
|
||||
Recently we have implemented the [server side][miragevpn-server].
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
---
|
||||
title: MirageOS retreat & Banawá chat
|
||||
date: 2023-05-07
|
||||
description: Notes about a trust on first use application written at the 12th MirageOS hack retreat
|
||||
---
|
||||
In beginning of May 2023 I had the joy to participate in the 12th [MirageOS hack retreat][retreat] in Marrakech, Morocco.
|
||||
There I met faces I know from previous retreats as well as many new faces.
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
---
|
||||
title: Migrating to YOCaml
|
||||
date: 2023-11-17
|
||||
description: Notes about migrating off Hakyll to Yocaml
|
||||
---
|
||||
|
||||
About a decade ago I created a blog on this website.
|
||||
|
|
|
|||
|
|
@ -1,11 +1,8 @@
|
|||
---
|
||||
author:
|
||||
name: Reynir Björnsson
|
||||
link: https://reyn.ir/
|
||||
email: reynir@reynir.dk
|
||||
title: Miragevpn & tls-crypt-v2
|
||||
date: 2023-11-14
|
||||
description: How we implemented tls-crypt-v2 for MirageVPN
|
||||
---
|
||||
|
||||
In 2019 [Robur][robur.coop] started working on a [OpenVPN™-compatible implementation in OCaml][miragevpn].
|
||||
|
|
|
|||
|
|
@ -22,12 +22,13 @@ depends: [
|
|||
"preface" { >= "0.1.0" }
|
||||
"logs" {>= "0.7.0" }
|
||||
"cmdliner" { >= "1.0.0"}
|
||||
"yocaml" {>= "2.0.0"}
|
||||
"yocaml_unix" {>= "2.0.0"}
|
||||
"yocaml_yaml" {>= "2.0.0"}
|
||||
"yocaml_git" {>= "2.0.0"}
|
||||
"yocaml_jingoo" {>= "2.0.0"}
|
||||
"yocaml_cmarkit" {>= "2.0.0"}
|
||||
"yocaml_syndication" {>= "2.0.0"}
|
||||
"http-lwt-client"
|
||||
"yocaml"
|
||||
"yocaml_unix"
|
||||
"yocaml_yaml"
|
||||
#"yocaml_markdown"
|
||||
"yocaml_git"
|
||||
"yocaml_jingoo"
|
||||
"yocaml_cmark"
|
||||
"jingoo" {>= "1.5.0"}
|
||||
]
|
||||
|
|
|
|||
749
src/blog.ml
749
src/blog.ml
|
|
@ -1,749 +0,0 @@
|
|||
open Yocaml
|
||||
|
||||
module Date = struct
|
||||
type month =
|
||||
| Jan
|
||||
| Feb
|
||||
| Mar
|
||||
| Apr
|
||||
| May
|
||||
| Jun
|
||||
| Jul
|
||||
| Aug
|
||||
| Sep
|
||||
| Oct
|
||||
| Nov
|
||||
| Dec
|
||||
|
||||
type day_of_week = Mon | Tue | Wed | Thu | Fri | Sat | Sun
|
||||
type year = int
|
||||
type day = int
|
||||
type hour = int
|
||||
type min = int
|
||||
type sec = int
|
||||
|
||||
type t = {
|
||||
year : year
|
||||
; month : month
|
||||
; day : day
|
||||
; hour : hour
|
||||
; min : min
|
||||
; sec : sec
|
||||
}
|
||||
|
||||
let invalid_int x message =
|
||||
Data.Validation.fail_with ~given:(string_of_int x) message
|
||||
|
||||
let month_from_int x =
|
||||
if x > 0 && x <= 12 then
|
||||
Result.ok
|
||||
[| Jan; Feb; Mar; Apr; May; Jun; Jul; Aug; Sep; Oct; Nov; Dec |].(x - 1)
|
||||
else invalid_int x "Invalid month value"
|
||||
|
||||
let year_from_int x =
|
||||
if x >= 0 then Result.ok x else invalid_int x "Invalid year value"
|
||||
|
||||
let is_leap year =
|
||||
if year mod 100 = 0 then year mod 400 = 0 else year mod 4 = 0
|
||||
|
||||
let days_in_month year month =
|
||||
match month with
|
||||
| Jan | Mar | May | Jul | Aug | Oct | Dec -> 31
|
||||
| Feb -> if is_leap year then 29 else 28
|
||||
| _ -> 30
|
||||
|
||||
let day_from_int year month x =
|
||||
let dim = days_in_month year month in
|
||||
if x >= 1 && x <= dim then Result.ok x
|
||||
else invalid_int x "Invalid day value"
|
||||
|
||||
let hour_from_int x =
|
||||
if x >= 0 && x < 24 then Result.ok x else invalid_int x "Invalid hour value"
|
||||
|
||||
let min_from_int x =
|
||||
if x >= 0 && x < 60 then Result.ok x else invalid_int x "Invalid min value"
|
||||
|
||||
let sec_from_int x =
|
||||
if x >= 0 && x < 60 then Result.ok x else invalid_int x "Invalid sec value"
|
||||
|
||||
let ( let* ) = Result.bind
|
||||
|
||||
let make ?(time = (0, 0, 0)) ~year ~month ~day () =
|
||||
let hour, min, sec = time in
|
||||
let* year = year_from_int year in
|
||||
let* month = month_from_int month in
|
||||
let* day = day_from_int year month day in
|
||||
let* hour = hour_from_int hour in
|
||||
let* min = min_from_int min in
|
||||
let* sec = sec_from_int sec in
|
||||
Result.ok { year; month; day; hour; min; sec }
|
||||
|
||||
let validate_from_datetime_str str =
|
||||
let str = String.trim str in
|
||||
match
|
||||
Scanf.sscanf_opt str "%04d%c%02d%c%02d%c%02d%c%02d%c%02d"
|
||||
(fun year _ month _ day _ hour _ min _ sec ->
|
||||
((hour, min, sec), year, month, day))
|
||||
with
|
||||
| None -> Data.Validation.fail_with ~given:str "Invalid date format"
|
||||
| Some (time, year, month, day) -> make ~time ~year ~month ~day ()
|
||||
|
||||
let validate_from_date_str str =
|
||||
let str = String.trim str in
|
||||
match
|
||||
Scanf.sscanf_opt str "%04d%c%02d%c%02d" (fun year _ month _ day ->
|
||||
(year, month, day))
|
||||
with
|
||||
| None -> Data.Validation.fail_with ~given:str "Invalid date format"
|
||||
| Some (year, month, day) -> make ~year ~month ~day ()
|
||||
|
||||
let validate =
|
||||
let open Data.Validation in
|
||||
string & (validate_from_datetime_str / validate_from_date_str)
|
||||
|
||||
let month_to_int = function
|
||||
| Jan -> 1
|
||||
| Feb -> 2
|
||||
| Mar -> 3
|
||||
| Apr -> 4
|
||||
| May -> 5
|
||||
| Jun -> 6
|
||||
| Jul -> 7
|
||||
| Aug -> 8
|
||||
| Sep -> 9
|
||||
| Oct -> 10
|
||||
| Nov -> 11
|
||||
| Dec -> 12
|
||||
|
||||
let dow_to_int = function
|
||||
| Mon -> 0
|
||||
| Tue -> 1
|
||||
| Wed -> 2
|
||||
| Thu -> 3
|
||||
| Fri -> 4
|
||||
| Sat -> 5
|
||||
| Sun -> 6
|
||||
|
||||
let compare_date a b =
|
||||
let cmp = Int.compare a.year b.year in
|
||||
if Int.equal cmp 0 then
|
||||
let cmp = Int.compare (month_to_int a.month) (month_to_int b.month) in
|
||||
if Int.equal cmp 0 then Int.compare a.day b.day else cmp
|
||||
else cmp
|
||||
|
||||
let compare_time a b =
|
||||
let cmp = Int.compare a.hour b.hour in
|
||||
if Int.equal cmp 0 then
|
||||
let cmp = Int.compare a.min b.min in
|
||||
if Int.equal cmp 0 then Int.compare a.sec b.sec else cmp
|
||||
else cmp
|
||||
|
||||
let compare a b =
|
||||
let cmp = compare_date a b in
|
||||
if Int.equal cmp 0 then compare_time a b else cmp
|
||||
|
||||
let pp_date ppf { year; month; day; _ } =
|
||||
Format.fprintf ppf "%04d-%02d-%02d" year (month_to_int month) day
|
||||
|
||||
let month_value = function
|
||||
| Jan -> 0
|
||||
| Feb -> 3
|
||||
| Mar -> 3
|
||||
| Apr -> 6
|
||||
| May -> 1
|
||||
| Jun -> 4
|
||||
| Jul -> 6
|
||||
| Aug -> 2
|
||||
| Sep -> 5
|
||||
| Oct -> 0
|
||||
| Nov -> 3
|
||||
| Dec -> 5
|
||||
|
||||
let string_of_month = function
|
||||
| Jan -> "Jan"
|
||||
| Feb -> "Feb"
|
||||
| Mar -> "Mar"
|
||||
| Apr -> "Apr"
|
||||
| May -> "May"
|
||||
| Jun -> "Jun"
|
||||
| Jul -> "Jul"
|
||||
| Aug -> "Aug"
|
||||
| Sep -> "Sep"
|
||||
| Oct -> "Oct"
|
||||
| Nov -> "Nov"
|
||||
| Dec -> "Dec"
|
||||
|
||||
let day_of_week { year; month; day; _ } =
|
||||
let yy = year mod 100 in
|
||||
let cc = (year - yy) / 100 in
|
||||
let c_code = [| 6; 4; 2; 0 |].(cc mod 4) in
|
||||
let y_code = (yy + (yy / 4)) mod 7 in
|
||||
let m_code =
|
||||
let v = month_value month in
|
||||
if is_leap year && (month = Jan || month = Feb) then v - 1 else v
|
||||
in
|
||||
let index = (c_code + y_code + m_code + day) mod 7 in
|
||||
[| Sun; Mon; Tue; Wed; Thu; Fri; Sat |].(index)
|
||||
|
||||
let normalize ({ year; month; day; hour; min; sec } as dt) =
|
||||
let day_of_week = day_of_week dt in
|
||||
let open Data in
|
||||
record
|
||||
[
|
||||
("year", int year); ("month", int (month_to_int month)); ("day", int day)
|
||||
; ("hour", int hour); ("min", int min); ("sec", int sec)
|
||||
; ("day_of_week", int (dow_to_int day_of_week))
|
||||
; ("month_repr", string (string_of_month month))
|
||||
; ("human", string (Format.asprintf "%a" pp_date dt))
|
||||
]
|
||||
|
||||
let to_archetype_date_time { year; month; day; hour; min; sec } =
|
||||
let time = (hour, min, sec) in
|
||||
let month = month_to_int month in
|
||||
Result.get_ok (Archetype.Datetime.make ~time ~year ~month ~day ())
|
||||
end
|
||||
|
||||
module Page = struct
|
||||
let entity_name = "Page"
|
||||
|
||||
class type t = object ('self)
|
||||
method title : string option
|
||||
method charset : string option
|
||||
method description : string option
|
||||
method tags : string list
|
||||
method with_host : string -> 'self
|
||||
method get_host : string option
|
||||
end
|
||||
|
||||
class page ?title ?description ?charset ?(tags = []) () =
|
||||
object (_ : #t)
|
||||
method title = title
|
||||
method charset = charset
|
||||
method description = description
|
||||
method tags = tags
|
||||
val host = None
|
||||
method with_host v = {< host = Some v >}
|
||||
method get_host = host
|
||||
end
|
||||
|
||||
let neutral = Result.ok @@ new page ()
|
||||
|
||||
let validate fields =
|
||||
let open Data.Validation in
|
||||
let+ title = optional fields "title" string
|
||||
and+ description = optional fields "description" string
|
||||
and+ charset = optional fields "charset" string
|
||||
and+ tags = optional_or fields ~default:[] "tags" (list_of string) in
|
||||
new page ?title ?description ?charset ~tags ()
|
||||
|
||||
let validate =
|
||||
let open Data.Validation in
|
||||
record validate
|
||||
|
||||
let normalize (p : t) =
|
||||
let open Data in
|
||||
[
|
||||
("title", (option string) p#title);
|
||||
("charset", (option string) p#charset);
|
||||
("description", (option string) p#description);
|
||||
]
|
||||
end
|
||||
|
||||
module Author = struct
|
||||
class type t = object
|
||||
method name : string
|
||||
method link : string
|
||||
method email : string
|
||||
method avatar : string option
|
||||
end
|
||||
|
||||
let gravatar email =
|
||||
let tk = String.(lowercase_ascii (trim email)) in
|
||||
let hs = Digest.(to_hex (string tk)) in
|
||||
"https://www.gravatar.com/avatar/" ^ hs
|
||||
|
||||
class author ~name ~link ~email ?(avatar = gravatar email) () =
|
||||
object (_ : #t)
|
||||
method name = name
|
||||
method link = link
|
||||
method email = email
|
||||
method avatar = Some avatar
|
||||
end
|
||||
|
||||
let validate fields =
|
||||
let open Data.Validation in
|
||||
let+ name = required fields "name" string
|
||||
and+ link = required fields "link" string
|
||||
and+ email = required fields "email" string
|
||||
and+ avatar = optional fields "avatar" string in
|
||||
match avatar with
|
||||
| None -> new author ~name ~link ~email ()
|
||||
| Some avatar -> new author ~name ~link ~email ~avatar ()
|
||||
|
||||
let validate =
|
||||
let open Data.Validation in
|
||||
record validate
|
||||
|
||||
let normalize obj =
|
||||
let open Data in
|
||||
record
|
||||
[
|
||||
("name", string obj#name); ("link", string obj#link)
|
||||
; ("email", string obj#email); ("avatar", option string obj#avatar)
|
||||
]
|
||||
end
|
||||
|
||||
let reynir =
|
||||
new Author.author
|
||||
~name:"Reynir Björnsson" ~link:"https://reyn.ir/"
|
||||
~email:"reynir@reynir.dk" ()
|
||||
|
||||
module Article = struct
|
||||
let entity_name = "Article"
|
||||
|
||||
class type t = object ('self)
|
||||
method title : string
|
||||
method description : string
|
||||
method charset : string option
|
||||
method tags : string list
|
||||
method date : Date.t
|
||||
method author : Author.t
|
||||
method co_authors : Author.t list
|
||||
method with_host : string -> 'self
|
||||
method get_host : string option
|
||||
end
|
||||
|
||||
class article ~title ~description ?charset ?(tags = []) ~date ~author
|
||||
?(co_authors = []) () =
|
||||
object (_ : #t)
|
||||
method title = title
|
||||
method description = description
|
||||
method charset = charset
|
||||
method tags = tags
|
||||
method date = date
|
||||
method author = author
|
||||
method co_authors = co_authors
|
||||
val host = None
|
||||
method with_host v = {< host = Some v >}
|
||||
method get_host = host
|
||||
end
|
||||
|
||||
let title p = p#title
|
||||
let description p = p#description
|
||||
let tags p = p#tags
|
||||
let date p = p#date
|
||||
|
||||
let neutral =
|
||||
Data.Validation.fail_with ~given:"null" "Cannot be null"
|
||||
|> Result.map_error (fun error ->
|
||||
Required.Validation_error { entity = entity_name; error })
|
||||
|
||||
let validate fields =
|
||||
let open Data.Validation in
|
||||
let+ title = required fields "title" string
|
||||
and+ description = required fields "description" string
|
||||
and+ charset = optional fields "charset" string
|
||||
and+ tags = optional_or fields ~default:[] "tags" (list_of string)
|
||||
and+ date = required fields "date" Date.validate
|
||||
and+ author =
|
||||
optional_or fields ~default:reynir "author" Author.validate
|
||||
and+ co_authors =
|
||||
optional_or fields ~default:[] "co-authors" (list_of Author.validate)
|
||||
in
|
||||
new article ~title ~description ?charset ~tags ~date ~author ~co_authors ()
|
||||
|
||||
let validate =
|
||||
let open Data.Validation in
|
||||
record validate
|
||||
|
||||
let normalize obj =
|
||||
Data.
|
||||
[
|
||||
("title", string obj#title); ("description", string obj#description)
|
||||
; ("date", Date.normalize obj#date); ("charset", option string obj#charset)
|
||||
; ("tags", list_of string obj#tags)
|
||||
; ("author", Author.normalize obj#author)
|
||||
; ("co-authors", list_of Author.normalize obj#co_authors)
|
||||
; ("host", option string obj#get_host)
|
||||
]
|
||||
end
|
||||
|
||||
module Articles = struct
|
||||
class type t = object ('self)
|
||||
method title : string option
|
||||
method description : string option
|
||||
method articles : (Path.t * Article.t) list
|
||||
method with_host : string -> 'self
|
||||
method get_host : string option
|
||||
end
|
||||
|
||||
class articles ?title ?description articles =
|
||||
object (_ : #t)
|
||||
method title = title
|
||||
method description = description
|
||||
method articles = articles
|
||||
val host = None
|
||||
method with_host v = {< host = Some v >}
|
||||
method get_host = host
|
||||
end
|
||||
|
||||
let sort_by_date ?(increasing = false) articles =
|
||||
List.sort
|
||||
(fun (_, articleA) (_, articleB) ->
|
||||
let r = Date.compare articleA#date articleB#date in
|
||||
if increasing then r else ~-r)
|
||||
articles
|
||||
|
||||
let fetch (module P : Required.DATA_PROVIDER) ?increasing
|
||||
?(filter = fun x -> x) ?(on = `Source) ~where ~compute_link path =
|
||||
Task.from_effect begin fun () ->
|
||||
let open Eff in
|
||||
let* files = read_directory ~on ~only:`Files ~where path in
|
||||
let+ articles =
|
||||
List.traverse
|
||||
(fun file ->
|
||||
let url = compute_link file in
|
||||
let+ metadata, _content =
|
||||
Eff.read_file_with_metadata (module P) (module Article) ~on file
|
||||
in
|
||||
(url, metadata))
|
||||
files
|
||||
in
|
||||
articles |> sort_by_date ?increasing |> filter end
|
||||
|
||||
let compute_index (module P : Required.DATA_PROVIDER) ?increasing
|
||||
?(filter = fun x -> x) ?(on = `Source) ~where ~compute_link path =
|
||||
let open Task in
|
||||
(fun x -> (x, ()))
|
||||
|>> second
|
||||
(fetch (module P) ?increasing ~filter ~on ~where ~compute_link path)
|
||||
>>> lift (fun (v, articles) ->
|
||||
new articles ?title:v#title ?description:v#description articles)
|
||||
|
||||
let normalize (ident, article) =
|
||||
let open Data in
|
||||
record (("url", string @@ Path.to_string ident) :: Article.normalize article)
|
||||
|
||||
let normalize obj =
|
||||
let open Data in
|
||||
[
|
||||
("articles", list_of normalize obj#articles)
|
||||
; ("has_articles", bool @@ ((=) []) obj#articles)
|
||||
; ("title", option string obj#title)
|
||||
; ("description", option string obj#description)
|
||||
; ("host", option string obj#get_host)
|
||||
]
|
||||
end
|
||||
|
||||
module Page_with_article = struct
|
||||
class type t = object ('self)
|
||||
inherit Page.t
|
||||
method articles : (Path.t * Article.t) list
|
||||
end
|
||||
|
||||
let normalize_article (ident, article) =
|
||||
let open Data in
|
||||
record (("url", string @@ Path.to_string ident) :: Article.normalize article)
|
||||
|
||||
let normalize (p : t) =
|
||||
let open Data in
|
||||
[
|
||||
("title", (option string) p#title);
|
||||
("charset", (option string) p#charset);
|
||||
("description", (option string) p#description);
|
||||
("tags", (list_of string) p#tags);
|
||||
("articles", list_of normalize_article p#articles);
|
||||
]
|
||||
end
|
||||
|
||||
|
||||
let is_markdown_file path =
|
||||
Path.has_extension "md" path ||
|
||||
Path.has_extension "markdown" path
|
||||
|
||||
module Make_with_target (S : sig
|
||||
val source : Path.t
|
||||
val target : Path.t
|
||||
end) =
|
||||
struct
|
||||
let source_root = S.source
|
||||
|
||||
module Source = struct
|
||||
let css = Path.(source_root / "css")
|
||||
let js = Path.(source_root / "js")
|
||||
let images = Path.(source_root / "images")
|
||||
let audio = Path.(source_root / "audio")
|
||||
let articles = Path.(source_root / "posts")
|
||||
let index = Path.(source_root / "pages" / "index.md")
|
||||
let about = Path.(source_root / "pages" / "about.md")
|
||||
let contact = Path.(source_root / "pages" / "contact.md")
|
||||
let archive = Path.(source_root / "pages" / "archive.md")
|
||||
let templates = Path.(source_root / "templates")
|
||||
let template file = Path.(templates / file)
|
||||
let binary = Path.rel [ Sys.argv.(0) ]
|
||||
let cache = Path.(source_root / "_cache")
|
||||
end
|
||||
|
||||
module Target = struct
|
||||
let target_root = S.target
|
||||
let pages = target_root
|
||||
let articles = Path.(target_root / "posts")
|
||||
let rss1 = Path.(target_root / "rss1.xml")
|
||||
let rss2 = Path.(target_root / "feed.xml")
|
||||
let atom = Path.(target_root / "atom.xml")
|
||||
|
||||
let as_html into file =
|
||||
file |> Path.move ~into |> Path.change_extension "html"
|
||||
end
|
||||
|
||||
let target = Target.target_root
|
||||
|
||||
let process_css_files =
|
||||
Action.copy_directory ~into:Target.target_root Source.css
|
||||
|
||||
let process_js_files =
|
||||
Action.copy_directory ~into:Target.target_root Source.js
|
||||
|
||||
let process_images_files =
|
||||
Action.copy_directory ~into:Target.target_root Source.images
|
||||
|
||||
let process_audio_files =
|
||||
Action.copy_directory ~into:Target.target_root Source.audio
|
||||
|
||||
let process_article ~host file =
|
||||
let file_target = Target.(as_html articles file) in
|
||||
let open Task in
|
||||
Action.write_static_file file_target
|
||||
begin
|
||||
Pipeline.track_file Source.binary
|
||||
>>> Yocaml_yaml.Pipeline.read_file_with_metadata (module Article) file
|
||||
>>* (fun (obj, str) -> Eff.return (obj#with_host host, str))
|
||||
>>> Yocaml_cmarkit.content_to_html ()
|
||||
>>> Yocaml_jingoo.Pipeline.as_template
|
||||
(module Article)
|
||||
(Source.template "article.html")
|
||||
>>> Yocaml_jingoo.Pipeline.as_template
|
||||
(module Article)
|
||||
(Source.template "layout.html")
|
||||
>>> drop_first ()
|
||||
end
|
||||
|
||||
let process_articles ~host =
|
||||
Action.batch ~only:`Files ~where:is_markdown_file Source.articles
|
||||
(process_article ~host)
|
||||
|
||||
let process_archive ~host =
|
||||
let file = Source.archive in
|
||||
let file_target = Target.(as_html target_root file) in
|
||||
|
||||
let open Task in
|
||||
let compute_index =
|
||||
Articles.compute_index
|
||||
(module Yocaml_yaml)
|
||||
~where:is_markdown_file
|
||||
~compute_link:(Target.as_html @@ Path.abs [ "articles" ])
|
||||
Source.articles
|
||||
in
|
||||
|
||||
Action.write_static_file file_target
|
||||
begin
|
||||
Pipeline.track_files [ Source.binary; Source.articles ]
|
||||
>>> Yocaml_yaml.Pipeline.read_file_with_metadata (module Page) file
|
||||
>>> first compute_index
|
||||
>>* (fun (obj, str) -> Eff.return (obj#with_host host, str))
|
||||
>>> (lift (fun (articles, tpl) ->
|
||||
articles,
|
||||
Yocaml_jingoo.render ~strict:true
|
||||
(List.map (fun (k, v) -> k, Yocaml_jingoo.from v) (Articles.normalize articles))
|
||||
tpl))
|
||||
>>> Yocaml_jingoo.Pipeline.as_template ~strict:true
|
||||
(module Articles)
|
||||
(Source.template "layout.html")
|
||||
>>> Yocaml_cmarkit.content_to_html ()
|
||||
>>> drop_first ()
|
||||
end
|
||||
|
||||
let process_page file =
|
||||
let file_target = Target.(as_html target_root file) in
|
||||
let open Task in
|
||||
Action.write_static_file file_target
|
||||
begin
|
||||
Pipeline.track_files [ Source.binary; file ]
|
||||
>>> Yocaml_yaml.Pipeline.read_file_with_metadata (module Page) file
|
||||
>>> Yocaml_cmarkit.content_to_html ()
|
||||
>>> Yocaml_jingoo.Pipeline.as_template ~strict:true
|
||||
(module Page)
|
||||
(Source.template "layout.html")
|
||||
>>> drop_first ()
|
||||
end
|
||||
|
||||
let process_contact = process_page Source.contact
|
||||
let process_about = process_page Source.about
|
||||
|
||||
let process_index ~host =
|
||||
let file = Source.index in
|
||||
let file_target = Target.(as_html pages file) in
|
||||
|
||||
let open Task in
|
||||
let compute_index =
|
||||
let rec filter = function
|
||||
| [] | [_] | [_; _] | [_; _; _] as latest_three -> latest_three
|
||||
| _too_old :: more_recent -> filter more_recent
|
||||
in
|
||||
Articles.compute_index
|
||||
~filter
|
||||
(module Yocaml_yaml)
|
||||
~where:is_markdown_file
|
||||
~compute_link:(Target.as_html @@ Path.abs [ "articles" ])
|
||||
Source.articles
|
||||
in
|
||||
|
||||
Action.write_static_file file_target
|
||||
begin
|
||||
Pipeline.track_files [ Source.binary; Source.articles ]
|
||||
>>> Yocaml_yaml.Pipeline.read_file_with_metadata (module Page) file
|
||||
>>> first compute_index
|
||||
>>* (fun (obj, str) -> Eff.return (obj#with_host host, str))
|
||||
>>> (lift (fun (articles, tpl) ->
|
||||
articles,
|
||||
Yocaml_jingoo.render ~strict:true
|
||||
(List.map (fun (k, v) -> k, Yocaml_jingoo.from v) (Articles.normalize articles))
|
||||
tpl))
|
||||
>>> Yocaml_jingoo.Pipeline.as_template ~strict:true
|
||||
(module Articles)
|
||||
(Source.template "layout.html")
|
||||
>>> Yocaml_cmarkit.content_to_html ()
|
||||
>>> drop_first ()
|
||||
end
|
||||
|
||||
let feed_title = "Root of Reynir"
|
||||
let site_url = "https://reyn.ir/"
|
||||
let feed_description = "Reynir's blog"
|
||||
|
||||
let fetch_articles =
|
||||
let open Task in
|
||||
Pipeline.track_files [ Source.binary; Source.articles ]
|
||||
>>> Articles.fetch
|
||||
(module Yocaml_yaml)
|
||||
~where:(Path.has_extension "md")
|
||||
~compute_link:(Target.as_html @@ Path.abs [ "articles" ])
|
||||
Source.articles
|
||||
|
||||
let rss1 =
|
||||
let from_articles ~title ~site_url ~description ~feed_url () =
|
||||
let open Yocaml_syndication in
|
||||
Rss1.from ~title ~url:feed_url ~link:site_url ~description
|
||||
@@ fun (path, article) ->
|
||||
let title = Article.title article in
|
||||
let link = site_url ^ Yocaml.Path.to_string path in
|
||||
let description = Article.description article in
|
||||
Rss1.item ~title ~link ~description
|
||||
in
|
||||
let open Task in
|
||||
Action.write_static_file Target.rss1
|
||||
begin
|
||||
fetch_articles
|
||||
>>> from_articles ~title:feed_title ~site_url
|
||||
~description:feed_description
|
||||
~feed_url:"https://blog.robur.coop/rss1.xml" ()
|
||||
end
|
||||
|
||||
let rss2 =
|
||||
let open Task in
|
||||
let from_articles ~title ~site_url ~description ~feed_url () =
|
||||
let open Yocaml_syndication in
|
||||
lift
|
||||
begin
|
||||
fun articles ->
|
||||
let last_build_date =
|
||||
List.fold_left
|
||||
begin
|
||||
fun acc (_, elt) ->
|
||||
let v = Date.to_archetype_date_time (Article.date elt) in
|
||||
match acc with
|
||||
| None -> Some v
|
||||
| Some a ->
|
||||
if Archetype.Datetime.compare a v > 0 then Some a
|
||||
else Some v
|
||||
end
|
||||
None articles
|
||||
|> Option.map Datetime.make
|
||||
in
|
||||
let feed =
|
||||
Rss2.feed ?last_build_date ~title ~link:site_url ~url:feed_url
|
||||
~description
|
||||
begin
|
||||
fun (path, article) ->
|
||||
let title = Article.title article in
|
||||
let link = site_url ^ Path.to_string path in
|
||||
let guid = Rss2.guid_from_link in
|
||||
let description = Article.description article in
|
||||
let pub_date =
|
||||
Datetime.make
|
||||
(Date.to_archetype_date_time (Article.date article))
|
||||
in
|
||||
Rss2.item ~title ~link ~guid ~description ~pub_date ()
|
||||
end
|
||||
articles
|
||||
in
|
||||
Xml.to_string feed
|
||||
end
|
||||
in
|
||||
Action.write_static_file Target.rss2
|
||||
begin
|
||||
fetch_articles
|
||||
>>> from_articles ~title:feed_title ~site_url
|
||||
~description:feed_description
|
||||
~feed_url:"https://blog.robur.coop/feed.xml" ()
|
||||
end
|
||||
|
||||
let atom =
|
||||
let open Task in
|
||||
let open Yocaml_syndication in
|
||||
let authors = Yocaml.Nel.singleton @@ Person.make "Reynir Björnsson" in
|
||||
let from_articles ?(updated = Atom.updated_from_entries ()) ?(links = [])
|
||||
?id ~site_url ~authors ~title ~feed_url () =
|
||||
let id = Option.value ~default:feed_url id in
|
||||
let feed_url = Atom.self feed_url in
|
||||
let base_url = Atom.link site_url in
|
||||
let links = base_url :: feed_url :: links in
|
||||
Atom.from ~links ~updated ~title ~authors ~id
|
||||
begin
|
||||
fun (path, article) ->
|
||||
let title = Article.title article in
|
||||
let content_url = site_url ^ Yocaml.Path.to_string path in
|
||||
let updated =
|
||||
Datetime.make (Date.to_archetype_date_time (Article.date article))
|
||||
in
|
||||
let categories = List.map Category.make (Article.tags article) in
|
||||
let summary = Atom.text (Article.description article) in
|
||||
let links = [ Atom.alternate content_url ~title ] in
|
||||
Atom.entry ~links ~categories ~summary ~updated ~id:content_url
|
||||
~title:(Atom.text title) ()
|
||||
end
|
||||
in
|
||||
Action.write_static_file Target.atom
|
||||
begin
|
||||
fetch_articles
|
||||
>>> from_articles ~site_url ~authors ~title:(Atom.text feed_title)
|
||||
~feed_url:"https://blog.robur.coop/atom.xml" ()
|
||||
end
|
||||
|
||||
let process_all ~host =
|
||||
let open Eff in
|
||||
Action.restore_cache ~on:`Source Source.cache
|
||||
>>= process_css_files >>= process_js_files >>= process_images_files
|
||||
>>= process_audio_files
|
||||
>>= process_contact >>= process_about >>= process_archive ~host
|
||||
>>= process_articles ~host >>= process_index ~host >>= rss1 >>= rss2 >>= atom
|
||||
>>= Action.store_cache ~on:`Source Source.cache
|
||||
end
|
||||
|
||||
module Make (S : sig
|
||||
val source : Path.t
|
||||
end) =
|
||||
Make_with_target (struct
|
||||
include S
|
||||
|
||||
let target = Path.(source / "_site")
|
||||
end)
|
||||
15
src/dune
15
src/dune
|
|
@ -2,13 +2,20 @@
|
|||
(public_name reynir-www)
|
||||
(name reynir_www)
|
||||
(libraries
|
||||
logs
|
||||
logs.fmt
|
||||
logs.cli
|
||||
fmt
|
||||
fmt.tty
|
||||
logs logs.fmt
|
||||
fmt.cli
|
||||
cmdliner
|
||||
preface
|
||||
mirage-clock-unix
|
||||
http-lwt-client
|
||||
git-unix
|
||||
yocaml
|
||||
yocaml_yaml
|
||||
yocaml_cmarkit
|
||||
yocaml_cmark
|
||||
yocaml_unix
|
||||
yocaml_git
|
||||
yocaml_jingoo
|
||||
yocaml_syndication))
|
||||
yocaml_jingoo))
|
||||
|
|
|
|||
19
src/file.ml
Normal file
19
src/file.ml
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
open Yocaml
|
||||
|
||||
let is_css = with_extension "css"
|
||||
let is_javascript =
|
||||
let open Preface.Predicate in
|
||||
with_extension "js" ||
|
||||
with_extension "map"
|
||||
|
||||
let is_image =
|
||||
let open Preface.Predicate in
|
||||
with_extension "png" ||
|
||||
with_extension "svg" ||
|
||||
with_extension "jpg" ||
|
||||
with_extension "jpeg" ||
|
||||
with_extension "gif"
|
||||
|
||||
let is_markdown =
|
||||
let open Preface.Predicate in
|
||||
with_extension "md" || with_extension "markdown"
|
||||
6
src/file.mli
Normal file
6
src/file.mli
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
open Yocaml
|
||||
|
||||
val is_css : Filepath.t -> bool
|
||||
val is_javascript : Filepath.t -> bool
|
||||
val is_image : Filepath.t -> bool
|
||||
val is_markdown : Filepath.t -> bool
|
||||
152
src/model.ml
Normal file
152
src/model.ml
Normal file
|
|
@ -0,0 +1,152 @@
|
|||
open Yocaml
|
||||
|
||||
let article_path file =
|
||||
let filename = basename $ replace_extension file "html" in
|
||||
filename |> into "posts"
|
||||
|
||||
module Author = struct
|
||||
type t = {
|
||||
name : string;
|
||||
}
|
||||
|
||||
let equal a b = String.equal a.name b.name
|
||||
|
||||
let make name = { name }
|
||||
|
||||
let from (type a) (module V : Metadata.VALIDABLE with type t = a) obj =
|
||||
V.object_and
|
||||
(fun assoc ->
|
||||
let open Validate.Applicative in
|
||||
make
|
||||
<$> V.(required_assoc string) "name" assoc)
|
||||
obj
|
||||
|
||||
let default_author =
|
||||
make "Reynir Björnsson"
|
||||
|
||||
let inject (type a) (module D : Key_value.DESCRIBABLE with type t = a) { name } =
|
||||
D.[ "name", string name ]
|
||||
end
|
||||
|
||||
module Article = struct
|
||||
type t = {
|
||||
title : string;
|
||||
date : Date.t;
|
||||
author : Author.t;
|
||||
}
|
||||
|
||||
let make title date author =
|
||||
{ title; date; author }
|
||||
|
||||
let from (type a) (module V : Metadata.VALIDABLE with type t = a) obj =
|
||||
V.object_and
|
||||
(fun assoc ->
|
||||
let open Validate.Applicative in
|
||||
make
|
||||
<$> V.(required_assoc string) "title" assoc
|
||||
<*> V.(required_assoc (Metadata.Date.from (module V))) "date" assoc
|
||||
<*> V.(optional_assoc_or (Author.from (module V))) "author" assoc ~default:Author.default_author)
|
||||
obj
|
||||
|
||||
let from_string (module V : Metadata.VALIDABLE) = function
|
||||
| None -> Validate.error $ Error.Required_metadata [ "Article" ]
|
||||
| Some str ->
|
||||
let open Validate.Monad in
|
||||
V.from_string str >>=
|
||||
from (module V)
|
||||
|
||||
let inject (type a) (module D : Key_value.DESCRIBABLE with type t = a)
|
||||
{ title; date; author } =
|
||||
D.[ "title", string title;
|
||||
"date", object_ $ Metadata.Date.inject (module D) date;
|
||||
"author", object_ $ Author.inject (module D) author ];
|
||||
end
|
||||
|
||||
module Articles = struct
|
||||
type t = (string * Article.t) list
|
||||
|
||||
let make path article = (path, article)
|
||||
|
||||
let sort articles =
|
||||
List.sort
|
||||
(fun (_, a) (_, b) ->
|
||||
~-(Date.compare a.Article.date b.Article.date))
|
||||
articles
|
||||
|
||||
let inject (type a) (module D : Key_value.DESCRIBABLE with type t = a) articles =
|
||||
D.[
|
||||
"articles",
|
||||
list
|
||||
(List.map (fun (path, article) ->
|
||||
object_ @@
|
||||
[ "location", string path ] @
|
||||
Article.inject (module D) article)
|
||||
articles)
|
||||
]
|
||||
end
|
||||
|
||||
module With_path (V : Metadata.INJECTABLE) = struct
|
||||
type t = {
|
||||
path : string;
|
||||
extension : V.t;
|
||||
}
|
||||
|
||||
let merge path v =
|
||||
{ path; extension=v; }
|
||||
|
||||
let inject (type a) (module D : Key_value.DESCRIBABLE with type t = a) { path; extension } =
|
||||
D.[ "path", string path ] @ V.inject (module D) extension
|
||||
end
|
||||
|
||||
module Page = struct
|
||||
type t = {
|
||||
title : string;
|
||||
head_extra : string option;
|
||||
}
|
||||
|
||||
let make title head_extra = { title; head_extra }
|
||||
|
||||
let from (type a) (module V : Metadata.VALIDABLE with type t = a) obj =
|
||||
V.object_and
|
||||
(fun assoc ->
|
||||
let open Validate.Applicative in
|
||||
make
|
||||
<$> V.(required_assoc string) "title" assoc
|
||||
<*> V.(optional_assoc string) "head_extra" assoc)
|
||||
obj
|
||||
|
||||
let from_string (module V : Metadata.VALIDABLE) = function
|
||||
| None -> Validate.valid { title = "TODO"; head_extra = None }
|
||||
| Some str ->
|
||||
Validate.Monad.bind
|
||||
(from (module V))
|
||||
(V.from_string str)
|
||||
|
||||
let inject (type a) (module D : Key_value.DESCRIBABLE with type t = a)
|
||||
{ title; head_extra } =
|
||||
let r = D.[ "title", string title ] in
|
||||
match head_extra with
|
||||
| None -> r
|
||||
| Some head_extra -> ("head_extra", D.string head_extra) :: r
|
||||
end
|
||||
|
||||
module With_layout (V : Metadata.INJECTABLE) = struct
|
||||
type t = {
|
||||
title : string;
|
||||
head_extra : string option;
|
||||
extension : V.t
|
||||
}
|
||||
|
||||
let merge ~title ~head_extra v =
|
||||
{ title; head_extra; extension = v }
|
||||
|
||||
let inject (type a) (module D : Key_value.DESCRIBABLE with type t = a)
|
||||
{ title; head_extra; extension = v } =
|
||||
let r =
|
||||
D.[ "title", string title ] @
|
||||
V.inject (module D) v
|
||||
in
|
||||
match head_extra with
|
||||
| None -> r
|
||||
| Some head_extra -> ("head_extra", D.string head_extra) :: r
|
||||
end
|
||||
|
|
@ -1,26 +1,76 @@
|
|||
let caller = Filename.basename Sys.argv.(0)
|
||||
let version = "%%VERSION%%"
|
||||
let default_port = 8888
|
||||
let default_target = Fpath.v "_site"
|
||||
|
||||
let watch port =
|
||||
let level = `Info in
|
||||
let module Dest = Blog.Make(struct
|
||||
let source = Yocaml.Path.rel []
|
||||
end)
|
||||
in
|
||||
let host = Fmt.str "http://localhost:%d" port in
|
||||
Yocaml_unix.serve ~level ~target:Dest.target ~port
|
||||
@@ fun () -> Dest.process_all ~host
|
||||
let program ~target =
|
||||
let open Yocaml in
|
||||
let* () = Task.move_css target in
|
||||
let* () = Task.move_images target in
|
||||
let* () = Task.move_js target in
|
||||
let* () = Task.move_audio target in
|
||||
let* () = Task.process_articles target in
|
||||
let* () = Task.generate_about target in
|
||||
let* () = Task.generate_contact target in
|
||||
let* () = Task.generate_archive target in
|
||||
Task.generate_index target
|
||||
|
||||
let build () =
|
||||
let level = `Info in
|
||||
let module Dest = Blog.Make(struct
|
||||
let source = Yocaml.Path.rel []
|
||||
end)
|
||||
let local_build _quiet target =
|
||||
Yocaml_unix.execute (program ~target:(Fpath.to_string target))
|
||||
|
||||
let watch quiet target port =
|
||||
let () = local_build quiet target in
|
||||
let target = Fpath.to_string target in
|
||||
let server = Yocaml_unix.serve ~filepath:target ~port (program ~target) in
|
||||
Lwt_main.run server
|
||||
|
||||
let common_options = "COMMON OPTIONS"
|
||||
|
||||
let verbosity =
|
||||
let open Cmdliner in
|
||||
let env = Cmd.Env.info "REYNIR_LOGS" in
|
||||
Logs_cli.level ~docs:common_options ~env ()
|
||||
|
||||
let renderer =
|
||||
let open Cmdliner in
|
||||
let env = Cmd.Env.info "REYNIR_FMT" in
|
||||
Fmt_cli.style_renderer ~docs:common_options ~env ()
|
||||
|
||||
let utf_8 =
|
||||
let open Cmdliner in
|
||||
let doc = "Allow binaries to emit UTF-8 characters." in
|
||||
let env = Cmd.Env.info "BLOGGER_UTF_8" in
|
||||
Arg.(value & opt bool true & info [ "with-utf-8" ] ~doc ~env)
|
||||
|
||||
let reporter ppf =
|
||||
let report src level ~over k msgf =
|
||||
let k _ =
|
||||
over ();
|
||||
k ()
|
||||
in
|
||||
let host = Fmt.str "/" in
|
||||
Yocaml_unix.run ~level
|
||||
@@ fun () -> Dest.process_all ~host
|
||||
let with_metadata header _tags k ppf fmt =
|
||||
Fmt.kpf
|
||||
k
|
||||
ppf
|
||||
("%a[%a]: " ^^ fmt ^^ "\n%!")
|
||||
Logs_fmt.pp_header
|
||||
(level, header)
|
||||
Fmt.(styled `Magenta string)
|
||||
(Logs.Src.name src)
|
||||
in
|
||||
msgf @@ fun ?header ?tags fmt -> with_metadata header tags k ppf fmt
|
||||
in
|
||||
{ Logs.report }
|
||||
|
||||
let setup_logs utf_8 style_renderer level =
|
||||
Fmt_tty.setup_std_outputs ~utf_8 ?style_renderer ();
|
||||
Logs.set_level level;
|
||||
Logs.set_reporter (reporter Fmt.stderr);
|
||||
Option.is_none level
|
||||
|
||||
|
||||
let setup_logs =
|
||||
Cmdliner.Term.(const setup_logs $ utf_8 $ renderer $ verbosity)
|
||||
|
||||
let man =
|
||||
let open Cmdliner in
|
||||
|
|
@ -33,13 +83,18 @@ let watch_cmd =
|
|||
website on demand"
|
||||
in
|
||||
let exits = Cmd.Exit.defaults in
|
||||
let path_arg =
|
||||
let doc = "Specify where we build the website" in
|
||||
let arg = Arg.info ~doc [ "destination" ] in
|
||||
Arg.(value & opt (conv (Fpath.of_string, Fpath.pp)) default_target & arg)
|
||||
in
|
||||
let port_arg =
|
||||
let doc = "The port" in
|
||||
let arg = Arg.info ~doc [ "port"; "P"; "p" ] in
|
||||
Arg.(value & opt int default_port & arg)
|
||||
in
|
||||
let info = Cmd.info "watch" ~version ~doc ~exits ~man in
|
||||
Cmd.v info Term.(const watch $ port_arg)
|
||||
Cmd.v info Term.(const watch $ setup_logs $ path_arg $ port_arg)
|
||||
|
||||
|
||||
let build_cmd =
|
||||
|
|
@ -47,7 +102,12 @@ let build_cmd =
|
|||
let doc = "Build the website into the specified directory" in
|
||||
let exits = Cmd.Exit.defaults in
|
||||
let info = Cmd.info "build" ~version ~doc ~exits ~man in
|
||||
Cmd.v info Term.(const build $ const ())
|
||||
let path_arg =
|
||||
let doc = "Specify where to build the website" in
|
||||
let arg = Arg.info ~doc ["destination"] in
|
||||
Arg.(value & opt (conv (Fpath.of_string, Fpath.pp)) default_target & arg)
|
||||
in
|
||||
Cmd.v info Term.(const local_build $ setup_logs $ path_arg)
|
||||
|
||||
let cmd =
|
||||
let open Cmdliner in
|
||||
|
|
|
|||
109
src/task.ml
Normal file
109
src/task.ml
Normal file
|
|
@ -0,0 +1,109 @@
|
|||
open Yocaml
|
||||
module Metaformat = Yocaml_yaml
|
||||
module Markup = Yocaml_cmark
|
||||
module Template = Yocaml_jingoo
|
||||
|
||||
let css_target target = "css" |> into target
|
||||
let images_target target = "images" |> into target
|
||||
let js_target target = "js" |> into target
|
||||
let audio_target target = "audio" |> into target
|
||||
let index_html target = "index.html" |> into target
|
||||
let about_html target = "about.html" |> into target
|
||||
let contact_html target = "contact.html" |> into target
|
||||
let archive_html target = "archive.html" |> into target
|
||||
let article_target file target = Model.article_path file |> into target
|
||||
|
||||
let move_css target =
|
||||
process_files
|
||||
[ "css" ]
|
||||
File.is_css
|
||||
(Build.copy_file ~into:(css_target target))
|
||||
|
||||
let move_images target =
|
||||
process_files
|
||||
[ "images" ]
|
||||
File.is_image
|
||||
(Build.copy_file ~into:(images_target target))
|
||||
|
||||
let move_js target =
|
||||
process_files
|
||||
[ "js" ]
|
||||
File.is_javascript
|
||||
(Build.copy_file ~into:(js_target target))
|
||||
|
||||
let move_audio target =
|
||||
process_files
|
||||
[ "audio" ]
|
||||
(with_extension "ogg")
|
||||
(Build.copy_file ~into:(audio_target target))
|
||||
|
||||
let with_layout (type a) (module M : Metadata.INJECTABLE with type t = a)
|
||||
(read_model : (_, a) Build.t) page target =
|
||||
let open Build in
|
||||
let module M = Model.With_layout(M) in
|
||||
let apply_template_from_string (v, content) =
|
||||
let values = M.inject (module Template) v in
|
||||
let content = Template.to_string ~strict:true values content in
|
||||
(v, content)
|
||||
in
|
||||
create_file target
|
||||
(watch Sys.argv.(0)
|
||||
>>> Metaformat.read_file_with_metadata (module Model.Page) page
|
||||
&&& read_model
|
||||
>>^ (fun (({ Model.Page.title; head_extra }, content), v) ->
|
||||
M.merge ~title ~head_extra v, content)
|
||||
>>^ apply_template_from_string
|
||||
>>> Markup.content_to_html ~strict:false ()
|
||||
>>> Template.apply_as_template (module M) "templates/layout.html"
|
||||
>>^ Stdlib.snd)
|
||||
|
||||
let process_articles target =
|
||||
let open Build in
|
||||
process_files [ "posts" ] File.is_markdown (fun article_file ->
|
||||
create_file (article_target article_file target)
|
||||
(Metaformat.read_file_with_metadata (module Model.Article) article_file
|
||||
>>> Markup.content_to_html ~strict:false ()
|
||||
>>> Template.apply_as_template (module Model.Article) "templates/article.html"
|
||||
>>> Template.apply_as_template (module Model.Article) "templates/layout.html"
|
||||
>>^ Stdlib.snd))
|
||||
|
||||
|
||||
let articles =
|
||||
let open Build in
|
||||
collection
|
||||
(read_child_files "posts" File.is_markdown)
|
||||
(fun path ->
|
||||
Metaformat.read_file_with_metadata (module Model.Article) path
|
||||
>>^ fun (meta, _data) ->
|
||||
(Model.article_path path, meta))
|
||||
(fun articles () -> Model.Articles.sort articles)
|
||||
|
||||
let generate_archive target =
|
||||
let* articles = articles in
|
||||
with_layout (module Model.Articles) articles "pages/archive.md" (archive_html target)
|
||||
|
||||
let page page_file target =
|
||||
let open Build in
|
||||
create_file target
|
||||
(watch Sys.argv.(0)
|
||||
>>> Metaformat.read_file_with_metadata (module Model.Page) page_file
|
||||
>>> Markup.content_to_html ~strict:false ()
|
||||
>>> Template.apply_as_template (module Model.Page) "templates/layout.html"
|
||||
>>^ Stdlib.snd)
|
||||
|
||||
let generate_about target =
|
||||
page "pages/about.md" (about_html target)
|
||||
|
||||
let generate_contact target =
|
||||
page "pages/contact.md" (contact_html target)
|
||||
|
||||
let generate_index target =
|
||||
let* articles = articles in
|
||||
let rec take n xs =
|
||||
match n, xs with
|
||||
| 0, _ | _, [] -> []
|
||||
| _, x :: xs -> x :: take (pred n) xs
|
||||
in
|
||||
let open Build in
|
||||
let articles = articles >>^ take 3 in
|
||||
with_layout (module Model.Articles) articles "pages/index.md" (index_html target)
|
||||
|
|
@ -3,7 +3,5 @@
|
|||
<h2>{{title}}</h2>
|
||||
Written by {{author.name}}, {{date.month_repr}} {{date.day}}, {{date.year}}
|
||||
</header>
|
||||
{%- autoescape false -%}
|
||||
{{yocaml_body}}
|
||||
{% endautoescape %}
|
||||
{{body|safe}}
|
||||
</article>
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@
|
|||
</header>
|
||||
<main>
|
||||
{%- autoescape false -%}
|
||||
{{ yocaml_body }}
|
||||
{{ body }}
|
||||
{% endautoescape %}
|
||||
</main>
|
||||
<footer>
|
||||
|
|
|
|||
Loading…
Reference in a new issue