Move page structuring from Html to Template

src/converters/html.ml

@@ -10,63 +10,32 @@ let head ~style t =
          meta ~a:[a_charset "utf-8"] ();
        ]
 
-let logarion_header ?(header_tpl=None) blog_url title =
-  match header_tpl with
-  | Some (Template.Header s) -> Unsafe.data Template.(fold_header blog_url title s)
-  | None   -> header [ h1 [ pcdata title] ]
-
 let default_style = "/static/main.css"
 
-let logarion_page ?(style=default_style) ?(header_tpl=None) blog_url head_title header_title main = 
+let page ?(style=default_style) blog_url head_title header main =
-  html (head ~style head_title) (body [ logarion_header ~header_tpl blog_url header_title; main ])
+  html (head ~style head_title) (body [ header; main ])
 
-let logarion_note ?(note_tpl=None) ymd =
+let heading1 data = h1 [ pcdata data ]
-  match note_tpl with
-  | Some (Template.Note s) -> Unsafe.data Template.(fold_note ymd s)
-  | None ->
-     let open Note in
-     let open Meta in
-     let ymd_body = Omd.to_html (Omd.of_string ymd.body) in
-     article [
-         details
-           (summary [Unsafe.data ymd.meta.abstract])
-           [time ~a:[a_datetime Date.(pretty_date @@ last ymd.meta.date)] []];
-         Unsafe.data ymd_body;
-       ]
 
-let of_note ?(style=default_style) ?(header_tpl=None) ?(note_tpl=None) blog_url lgrn ymd =
+let header data = header [ data ]
-  logarion_page
-    ~style
-    ~header_tpl
-    blog_url
-    (Note.title ymd ^ " by " ^ ymd.Note.meta.Meta.author.Meta.Author.name)
-    Logarion.(lgrn.Archive.Configuration.title)
-    (logarion_note ~note_tpl ymd)
-  |> to_string
 
-let article_link meta =
+let note ~date ~abstract ~body =
-  let open Logarion in
+  article [
-  let u = "/note/" ^ Meta.alias meta in
+      details (summary [Unsafe.data abstract]) [time ~a:[a_datetime date] []];
-  let d =
+      Unsafe.data body;
-    let open Meta in
+    ]
-    Unsafe.data Note.(meta.Meta.title ^ (Meta.Date.pretty_date (meta.date |> Meta.Date.last)))
-  in
-  li [ a ~a:[ a_href (uri_of_string u) ] [ d ] ]
 
-let of_entries  ?(style=default_style) ?(header_tpl=None) ?(list_tpl=None) ?(item_tpl=None) ?(from=0) ?(n=0) blog_url lgrn notes =
+let anchor url content = a ~a:[ a_href (uri_of_string url) ] [ Unsafe.data content ]
-  let title = Logarion.(lgrn.Archive.Configuration.title) in
-  logarion_page
-    ~style
-    ~header_tpl
-    blog_url
-    title
-    title
-    (match list_tpl with
-     | Some (Template.List s) -> Unsafe.data Template.(fold_list ~item_tpl ~from ~n notes s)
-     | None -> (div [ h2 [pcdata "Articles"]; ul (List.map article_link notes); ]))
-  |> to_string
 
-let form ?(header_tpl=None) blog_url lgrn ymd =
+let message message = [ pcdata message ]
+
+let list_unordered = ul
+
+let list_item content = li [ content ]
+
+let block = Unsafe.data
+
+let form blog_url lgrn ymd =
   let article_form =
     let input_set title input = p [ label [ pcdata title; input ] ] in
     let either a b = if a <> "" then a else b in
@@ -106,22 +75,10 @@ let form ?(header_tpl=None) blog_url lgrn ymd =
         "Text"
         (textarea ~a:[a_name "body"] (pcdata ymd.body));
       p [ button ~a:[a_button_type `Submit] [pcdata "Submit"] ];
-    ] in
+    ]
-  logarion_page
+  in
-    ~header_tpl
+  div
-    blog_url
+    [ form
-    "Compose" "Article composition"
+        ~a:[a_method `Post; a_action (uri_of_string "/post.note"); a_accept_charset ["utf-8"]]
-    (div [ form
+        [ fieldset ~legend:(legend [pcdata "Article"]) article_form ]
-             ~a:[a_method `Post; a_action (uri_of_string "/post.note"); a_accept_charset ["utf-8"];]
+    ]
-             [ fieldset ~legend:(legend [pcdata "Article"]) article_form ]
-    ])
-  |> to_string
-
-let of_message ?(header_tpl=None) blog_url lgrn title message =
-  logarion_page
-    ~header_tpl
-    blog_url
-    title
-    Logarion.(lgrn.Archive.Configuration.title)
-    (div [pcdata message])
-  |> to_string

src/converters/template.ml

@@ -71,6 +71,8 @@ let fold_meta (meta : Logarion.Meta.t) =
     | tag -> Meta.value_with_name meta tag in
   Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat
 
+let fold_meta tpl meta = fold_meta meta tpl
+
 let fold_header blog_url title =
   let escaped e =
     let e = List.hd e in
@@ -80,31 +82,64 @@ let fold_header blog_url title =
     | _ -> prerr_endline ("unknown tag: " ^ e); "" in
   Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat
 
-let fold_list ?(item_tpl=None) ~from ~n notes =
+let anchor_of_meta meta =
   let module Meta = Logarion.Meta in
-  let simple meta =
+  Html.anchor
-    "<li><a href=\"/note/" ^ Meta.alias meta ^ "\"><p class=\"title\">"
+    ("/note/" ^ Meta.alias meta)
-    ^ meta.Meta.title ^ "</p><p class=\"time\">" ^ Meta.Date.(pretty_date (last meta.Meta.date))
+    ("<p class=\"title\">"  ^ meta.Meta.title ^ "</p><p class=\"time\">" ^ Meta.Date.(pretty_date (last meta.Meta.date))  ^ "</p>")
-    ^ "</p></a></li>"
+
-  in
+let listing metas =
-  let fold_meta tpl meta = fold_meta meta tpl in
+  let open Html in
-  let meta = match item_tpl with Some (Item e) -> fold_meta e | None -> simple in
+  list_unordered @@ List.map (fun m -> list_item @@ anchor_of_meta @@ m) metas
+
+let fold_index ~from ~n metas =
   let escaped e =
-    let e = List.hd e in
+    match List.hd e with
-    match e with
     | "navigation" ->
        ""
        ^ (if from > 0 then ("<a href=\"?p=" ^ string_of_int (pred from) ^ "\">previous</a> | ") else "")
-       ^ (if n <= List.length notes then ("<a href=\"?p=" ^  string_of_int (succ from) ^ "\">next</a>") else "")
+       ^ (if n <= List.length metas then ("<a href=\"?p=" ^  string_of_int (succ from) ^ "\">next</a>") else "")
-    | "recent_texts_listing" ->
+    | "recent_texts_listing" -> (* listing metas *) ""
-       let open Logarion in
-       ListLabels.fold_left ~init:"" ~f:(fun a e -> a ^ meta e) notes
     | "topics" ->
        let topics =
          ListLabels.fold_left
-           ~init:(Meta.StringSet.empty)
+           ~init:(Logarion.Meta.StringSet.empty)
-           ~f:(fun a e -> Meta.unique_topics a e ) notes
+           ~f:(fun a e -> Logarion.Meta.unique_topics a e ) metas
        in
-       Meta.StringSet.fold (fun e a -> a ^ "<li><a href=\"/topic/" ^ e ^ "\">" ^ e ^ "</a></li>") topics ""
+       Logarion.Meta.StringSet.fold (fun e a -> a ^ "<li><a href=\"/topic/" ^ e ^ "\">" ^ e ^ "</a></li>") topics ""
-    | _ -> prerr_endline ("unknown tag: " ^ e); "" in
+    | e -> prerr_endline ("unknown tag: " ^ e); "" in
   Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat
+
+let note_page ?(header_template=None) ?(note_template=None) ~style url title note =
+
+  let header_html = match header_template with
+    | Some (Header s) -> Html.header @@ Html.block @@ fold_header url title s
+    | None -> Html.(header (heading1 title))
+  in
+
+  let note_html = match note_template with
+    | Some (Note s) -> Html.block @@ fold_note note s
+    | None ->
+       let open Logarion.Note in
+       let open Logarion.Meta in
+       let date = Date.(pretty_date @@ last note.meta.date) in
+       let abstract = note.meta.abstract in
+       let body = Omd.to_html (Omd.of_string note.body) in
+       Html.note ~date ~abstract ~body
+  in
+
+  Html.to_string @@ Html.page ~style url title header_html note_html
+
+let listing_page ?(header_template=None) ?(listing_template=None) ~style ~from ~n url title metas =
+
+  let header_html = match header_template with
+    | Some (Header s) -> Html.header @@ Html.block @@ fold_header url title s
+    | None -> Html.(header (heading1 title))
+  in
+
+  let listing_html = match listing_template with
+    | Some (Note s) -> Html.block @@ fold_index ~from ~n metas s
+    | None -> listing metas
+  in
+
+  Html.to_string @@ Html.page ~style url title header_html listing_html

src/logarion_cli.ml

@@ -123,8 +123,8 @@ let convert directory =
   let notes = File.to_list L.note_lens archive.store in
   let metas = File.to_list L.meta_lens archive.store in
 
-  let page_of_note = Converters.Html.of_note ~style:"static/main.css" "localhost" config in
+  let page_of_note = Converters.Template.note_page ~style:"static/main.css" "localhost" "title for now" in
-  let page_of_note_listing =  Converters.Html.of_entries ~style:"static/main.css" "localhost" config in
+  let page_of_note_listing = Converters.Template.listing_page ~style:"static/main.css" ~from:0 ~n:1000 "localhost" "title for now" in
   let path_of_note note = directory ^ "/" ^ Meta.string_alias Note.(note.meta.Meta.title) ^ ".html" in
   let file_creation path content =
     let out = open_out path in