Skip to content
Permalink
Browse files

Ran ocamlformat

  • Loading branch information...
tsileo committed Jul 2, 2019
1 parent efed821 commit 5e75193641679b6afc729c7f73b6deab9a25d58d
Showing with 941 additions and 685 deletions.
  1. +249 −214 bin/app.ml
  2. +15 −12 lib/config.ml
  3. +84 −70 lib/entry.ml
  4. +214 −173 lib/micropub.ml
  5. +58 −69 lib/utils.ml
  6. +134 −124 lib/webmention.ml
  7. +10 −5 lib/websub.ml
  8. +177 −18 template.html

Large diffs are not rendered by default.

@@ -1,38 +1,41 @@
open Lwt.Infix
open Lwt
open Utils
module Store = Irmin_unix.Git.FS.KV (Irmin.Contents.String)

module Store = Irmin_unix.Git.FS.KV(Irmin.Contents.String)
let html_tpl = load_file "template.html" |> Mustache.of_string

let html_tpl =
load_file "template.html"
|> Mustache.of_string
let atom_tpl = load_file "atom.xml" |> Mustache.of_string

let atom_tpl =
load_file "atom.xml"
|> Mustache.of_string

let rconf = match (load_file "config.yaml" |> Yaml.of_string) with
let rconf =
match load_file "config.yaml" |> Yaml.of_string with
| Ok r -> r
| Error e -> failwith "failed to load config"

let base_url = jdata_field rconf ["base_url"] "http://localhost:7888"

let blog_name = jdata_field rconf ["blog_name"] "Untitled"

let hero = jdata_field rconf ["hero"] ""

let author_name = jdata_field rconf ["author_name"] "Dev"

let author_email = jdata_field rconf ["author_email"] "dev@entries.pub"

let author_icon = jdata_field rconf ["author_icon"] ""

let websub_endpoint = jdata_field rconf ["websub_endpoint"] ""

let token_endpoint = jdata_field rconf ["token_endpoint"] ""

let authorization_endpoint = jdata_field rconf ["authorization_endpoint"] ""

(* For Irmin (a la Git) *)
let author = author_email ^ " <" ^ author_email ^ ">"

(* Irmin config *)
let config = Irmin_git.config ~bare:false "./db"

let info fmt = Irmin_unix.info ~author fmt

let build_url uid slug =
base_url ^ "/" ^ uid ^ "/" ^ slug
let build_url uid slug = base_url ^ "/" ^ uid ^ "/" ^ slug
@@ -1,7 +1,6 @@
open Lwt.Infix
open Lwt
include Cohttp_lwt_unix.Server

open Config
open Utils

@@ -18,7 +17,9 @@ let entry_tpl_data jdata =
let content = jform_field jdata ["properties"; "content"] "" in
let published = jform_field jdata ["properties"; "published"] "" in
let updated = jform_field jdata ["properties"; "updated"] "" in
let updated_pretty = if updated = "" then "" else (Date.of_string updated |> Date.to_pretty) in
let updated_pretty =
if updated = "" then "" else Date.of_string updated |> Date.to_pretty
in
let uid = jform_field jdata ["properties"; "uid"] "" in
let tags = jform_strings jdata ["properties"; "category"] in
let slug = jform_field jdata ["properties"; "mp-slug"] (slugify name) in
@@ -27,95 +28,108 @@ let entry_tpl_data jdata =
let has_category = if List.length tags > 0 then true else false in
let is_page = if List.mem "page" tags then true else false in
let is_draft = if List.mem "draft" tags then true else false in
let has_been_updated = if updated = "" then false else if updated <> published then true else false in
`O [
"name", `String name;
"slug", `String slug;
"content", `String (Omd.of_string content |> Omd.to_html);
"published", `String published;
"published_pretty", `String (Date.of_string published |> Date.to_pretty);
"updated", `String updated;
"updated_pretty", `String updated_pretty;
"author_name", `String author_name;
"author_email", `String author_email;
"author_url", `String base_url;
"author_icon", `String author_icon;
"url", `String (base_url ^ "/" ^ uid ^ "/" ^ slug);
"uid", `String uid;
"category", Ezjsonm.(strings tags);
"has_category", `Bool has_category;
"extra_head", `String extra_head;
"extra_body", `String extra_body;
"is_page", `Bool is_page;
"is_draft", `Bool is_draft;
"has_been_updated", `Bool has_been_updated;
]
let has_been_updated =
if updated = "" then false
else if updated <> published then true
else false
in
`O
[ ("name", `String name)
; ("slug", `String slug)
; ("content", `String (Omd.of_string content |> Omd.to_html))
; ("published", `String published)
; ("published_pretty", `String (Date.of_string published |> Date.to_pretty))
; ("updated", `String updated)
; ("updated_pretty", `String updated_pretty)
; ("author_name", `String author_name)
; ("author_email", `String author_email)
; ("author_url", `String base_url)
; ("author_icon", `String author_icon)
; ("url", `String (base_url ^ "/" ^ uid ^ "/" ^ slug))
; ("uid", `String uid)
; ("category", Ezjsonm.(strings tags))
; ("has_category", `Bool has_category)
; ("extra_head", `String extra_head)
; ("extra_body", `String extra_body)
; ("is_page", `Bool is_page)
; ("is_draft", `Bool is_draft)
; ("has_been_updated", `Bool has_been_updated) ]

let discard_pages_and_drafts entries =
Lwt_list.filter_s (fun d ->
not ((jdata_bool d ["is_page"] false) or jdata_bool d ["is_draft"] false)
|> Lwt.return) entries
Lwt_list.filter_s
(fun d ->
(not (jdata_bool d ["is_page"] false or jdata_bool d ["is_draft"] false))
|> Lwt.return )
entries

(* Iter over all the entries as JSON objects *)
let iter map =
Store.Repo.v config >>=
Store.master >>= fun t ->
Store.list t ["entries"] >>= fun keys ->
(* Rev map for getting more recents post first *)
(Lwt_list.rev_map_s (fun (s, c) ->
Store.get t ["entries"; s] >>= fun stored ->
stored |> Ezjsonm.from_string |> map |> Lwt.return
) keys)
Store.Repo.v config >>= Store.master
>>= fun t ->
Store.list t ["entries"]
>>= fun keys ->
(* Rev map for getting more recents post first *)
Lwt_list.rev_map_s
(fun (s, c) ->
Store.get t ["entries"; s]
>>= fun stored -> stored |> Ezjsonm.from_string |> map |> Lwt.return )
keys

(* Get a specific entry as JSON *)
let get uid =
Store.Repo.v config >>=
Store.master >>= fun t ->
Store.find t ["entries"; uid] >>= fun entry ->
match entry with
| Some e ->
Store.Repo.v config >>= Store.master
>>= fun t ->
Store.find t ["entries"; uid]
>>= fun entry ->
match entry with
| Some e ->
(* Render the entry *)
let v = e |> Ezjsonm.from_string in
Some v |> Lwt.return
| None ->
Lwt.return None
| None -> Lwt.return None

(* Remove the given entry *)
let remove uid =
Store.Repo.v config >>=
Store.master >>= fun t ->
Store.remove t ~info:(info "Deleting entry %s" uid) ["entries"; uid]
Store.Repo.v config >>= Store.master
>>= fun t ->
Store.remove t ~info:(info "Deleting entry %s" uid) ["entries"; uid]

(* Set/update an entry *)
let set uid entry =
Store.Repo.v config >>=
Store.master >>= fun t ->
Store.set t ~info:(info "Updating entry %s" uid) ["entries"; uid] Ezjsonm.(to_string entry)

Store.Repo.v config >>= Store.master
>>= fun t ->
Store.set t
~info:(info "Updating entry %s" uid)
["entries"; uid]
Ezjsonm.(to_string entry)

(* Save a new entry *)
let save uid slug entry_type entry_content entry_name entry_published entry_category extra_head extra_body =
let save uid slug entry_type entry_content entry_name entry_published
entry_category extra_head extra_body =
(* Serialize the entry to JSON microformats2 format *)
let obj = `O [
"type", `A [ `String entry_type ];
"properties", `O [
"content", `A [ `String entry_content ];
"name", `A [ `String entry_name ];
"published", `A [ `String entry_published ];
"updated", `A [ `String entry_published ];
"uid", `A [ `String uid ];
"url", `A [ `String (build_url uid slug) ];
"category", Ezjsonm.(strings entry_category);
"mp-slug", `A [ `String slug ];
"mp-extra-head", `A [ `String extra_head ];
"mp-extra-body", `A [ `String extra_body ];
]
] in
let obj =
`O
[ ("type", `A [`String entry_type])
; ( "properties"
, `O
[ ("content", `A [`String entry_content])
; ("name", `A [`String entry_name])
; ("published", `A [`String entry_published])
; ("updated", `A [`String entry_published])
; ("uid", `A [`String uid])
; ("url", `A [`String (build_url uid slug)])
; ("category", Ezjsonm.(strings entry_category))
; ("mp-slug", `A [`String slug])
; ("mp-extra-head", `A [`String extra_head])
; ("mp-extra-body", `A [`String extra_body]) ] ) ]
in
(* JSON serialize *)
Log.info "%s" Ezjsonm.(to_string obj);
Log.info "%s" Ezjsonm.(to_string obj) ;
(* Save to repo *)
set uid obj

let update_hook url body =
Websub.ping Config.base_url >>= fun _ ->
let hbody = Omd.of_string body |> Omd.to_html in
Webmention.send_webmentions url hbody >>= fun _ -> Lwt.return true
Websub.ping Config.base_url
>>= fun _ ->
let hbody = Omd.of_string body |> Omd.to_html in
Webmention.send_webmentions url hbody >>= fun _ -> Lwt.return true

0 comments on commit 5e75193

Please sign in to comment.
You can’t perform that action at this time.