software-archive/logarion-2016
2
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Compare commits

base: software-archive:bb5316a3d466bb925569ce830786650b18c94ff4
Branches Tags
software-archive:master
...
compare: software-archive:792d29487ea7c4c27bd9b7b5584c47d5d05e2282
Branches Tags
software-archive:master

10 Commits
bb5316a3d4 ... 792d29487e

Author SHA1 Message Date
Stavros Polymenis
792d29487e Correct jbuild paths for templates 2017-12-18 22:24:24 +00:00
Stavros Polymenis
62a77d169b Relativize font path in Sass and css 2017-12-17 10:19:20 +00:00
Stavros Polymenis
b1a77050e0 Relativize header links 2017-12-16 00:25:56 +00:00
Stavros Polymenis
d43764b49a Fix web server 2017-12-07 23:47:24 +00:00
Stavros Polymenis
ae986e4566 Move high-level conversion functions to Template for reuse in web server 2017-12-07 22:47:26 +00:00
Stavros Polymenis
2d260a37de Fix CSS to work with new conversion 2017-12-06 00:09:09 +00:00
Stavros Polymenis
98d4dac32a Generalise templates, not only for HTML 2017-12-04 19:14:00 +00:00
Stavros Polymenis
7e445b3603 Experimenting with new method for selectiong Template functions 2017-12-04 19:03:45 +00:00
Stavros Polymenis
63d915c8be Reorganise Template and HTML 2017-12-04 00:09:29 +00:00
Stavros Polymenis
381d4a235f Wrap all Tyxml.elt values in lists so that they can be concatenated in a single list. Thanks to Drup 2017-11-30 01:31:14 +00:00
18 changed files with 194 additions and 236 deletions
Show Stats Expand all files Collapse all files

1
share/html_templates/header.mustache
View File

@ -1 +0,0 @@
<h1><a href="{{blog_url}}">{{title}}</a></h1>

7
share/html_templates/item.mustache
View File

@ -1,7 +0,0 @@
<li>
<time>{{date_human}}</time>
<div>
<a href="{{url}}" class="title">{{title}}</a>
<p class="abstract">{{abstract}}</p>
</div>
</li>

17
share/html_templates/list.mustache
View File

@ -1,17 +0,0 @@
<main>
<h3>Topics</h3>
<ul class="topics">
{{topics}}
</ul>
<h3>Recent articles</h3>
<ul class="timeline">
{{recent_texts_listing}}
</ul>
<nav>
{{navigation}}
</nav>
</main>

13
share/html_templates/note.mustache
View File

@ -1,13 +0,0 @@
<article>
<h1>{{title}}</h1>
<details>
<summary>{{abstract}}</summary>
<a href="" rel="author">{{author_name}}</a>
<time datetime="{{date}}">{{date_human}}</time>
<span>Series: {{series}}</span>
<span>Topics: {{topics}}</span>
<span>Keywords: {{keywords}}</span>
<span>UUID: {{uuid}}</span>
</details>
{{body}}
</article>

15
share/sass/layout.sass
View File

@ -1,4 +1,4 @@
$font-url: "/static/fonts"
$font-url: "fonts"
@import fonts/orbitron.sass
@ -87,7 +87,8 @@ button
border: .5mm solid
.timeline
width: 90ch
max-width: 90ch
margin: auto auto
.timeline > li
position: relative
@ -95,13 +96,15 @@ button
.timeline > li time
float: left
width: 14ch
text-align: center
width: 30%
text-align: right
.timeline > li div
padding: 0 2ch 1em 0;
.timeline > li .title
float: left
padding: 0 0 1em 2ch
width: 60%
max-width: 60%
.topics > li
display: inline

2
share/sass/main-dark.sass
View File

@ -6,5 +6,5 @@ body
body, a, header a:visited
color: #f2f2f2
pre, .timeline > li div
pre, .timeline > li .title
border-left: 1mm solid #f2f2f233

2
share/sass/main-light.sass
View File

@ -6,5 +6,5 @@ body
body, a, header a:visited
color: #191B22
pre, .timeline > li div
pre, .timeline > li .title
border-left: 1mm solid #191B22

22
share/static/main.css
View File

@ -1,18 +1,18 @@
@font-face {
font-family: "Orbitron Medium";
src: url("/static/fonts/orbitron/orbitron-medium.otf"); }
src: url("fonts/orbitron/orbitron-medium.otf"); }
@font-face {
font-family: "Orbitron Light";
src: url("/static/fonts/orbitron/orbitron-light.otf"); }
src: url("fonts/orbitron/orbitron-light.otf"); }
@font-face {
font-family: "Orbitron Bold";
src: url("/static/fonts/orbitron/orbitron-bold.otf"); }
src: url("fonts/orbitron/orbitron-bold.otf"); }
@font-face {
font-family: "Orbitron Black";
src: url("/static/fonts/orbitron/orbitron-black.otf"); }
src: url("fonts/orbitron/orbitron-black.otf"); }
body {
font-family: "sans-serif"; }
@ -97,7 +97,8 @@ button {
border: .5mm solid; }
.timeline {
width: 90ch; }
max-width: 90ch;
margin: auto auto; }
.timeline > li {
position: relative;
@ -105,13 +106,14 @@ button {
.timeline > li time {
float: left;
width: 14ch;
text-align: center; }
width: 30%;
text-align: right;
padding: 0 2ch 1em 0; }
.timeline > li div {
.timeline > li .title {
float: left;
padding: 0 0 1em 2ch;
width: 60%; }
max-width: 60%; }
.topics > li {
display: inline;
@ -129,5 +131,5 @@ body {
body, a, header a:visited {
color: #f2f2f2; }
pre, .timeline > li div {
pre, .timeline > li .title {
border-left: 1mm solid #f2f2f233; }

2
share/html_templates/frontpage.mustache → share/template/frontpage.mustache
View File

@ -1,3 +1,3 @@
Articles
## Articles
{{recent_texts_listing}}

1
share/template/header.mustache Normal file
View File

@ -0,0 +1 @@
{{title}}

3
share/template/item.mustache Normal file
View File

@ -0,0 +1,3 @@
{{date_human}}
{{link}}
{{abstract}}

7
share/template/list.mustache Normal file
View File

@ -0,0 +1,7 @@
### Topics
{{topics}}
### Recent articles
{{recent_texts_listing}}

5
share/template/note.mustache Normal file
View File

@ -0,0 +1,5 @@
# {{title}}
{{details}}
{{body}}

63
src/converters/html.ml
View File

@ -12,17 +12,21 @@ let head ~style t =
let default_style = "/static/main.css"
let page ?(style=default_style) blog_url head_title header main =
let page ?(style=default_style) head_title header main =
html (head ~style head_title) (body [ header; main ])
let heading1 data = h1 [ pcdata data ]
let anchor url content = a ~a:[ a_href (uri_of_string url) ] content
let div ?(style_class="") content =
let a = if style_class <> "" then [a_class [style_class]] else [] in
div ~a content
let unescaped_data = Unsafe.data
let data = pcdata
let title = h1
let header = header
let article = article
let note ~abstract ~author ~date ~series ~topics ~keywords ~uuid ~body =
article [
let meta ~abstract ~author ~date ~series ~topics ~keywords ~uuid =
details
(summary [Unsafe.data abstract])
[
@ -34,24 +38,45 @@ let note ~abstract ~author ~date ~series ~topics ~keywords ~uuid ~body =
div [pcdata ("Topics: " ^ topics)];
div [pcdata ("Keywords: " ^ keywords)];
div [pcdata ("UUID: " ^ uuid)];
];
Unsafe.data body;
]
let anchor url content = a ~a:[ a_href (uri_of_string url) ] content
let note = article
let div ?(style_class="") content =
let a = if style_class <> "" then [a_class [style_class]] else [] in
div ~a content
let listing url_of_meta metas =
let open Html in
let item meta =
let module Meta = Logarion.Meta in
li [
anchor
(url_of_meta @@ Meta.alias meta)
[
time @@ [unescaped_data Meta.Date.(pretty_date (last meta.Meta.date))];
pcdata "\n";
span ~a:[a_class ["title"]] [data meta.Meta.title];
]
]
in
ul ~a:[a_class ["timeline"]] @@ List.map item metas
let list_unordered = ul
module Renderer = struct
let meta meta e =
let e = List.hd e in
match e with
| "urn_name" -> [unescaped_data @@ "/note/" ^ Logarion.Meta.alias meta]
| "date" | "date_created" | "date_edited" | "date_published" | "date_human" ->
[time @@ [unescaped_data @@ Logarion.Meta.value_with_name meta e]]
| tag -> [unescaped_data @@ Logarion.Meta.value_with_name meta tag]
let list_item content = li [ content ]
let note note e = match List.hd e with
| "body" -> [unescaped_data @@ Omd.to_html @@ Omd.of_string note.Logarion.Note.body]
| _ -> meta note.Logarion.Note.meta e
let unescaped_data = Unsafe.data
let data = pcdata
let archive archive e = match List.hd e with
| "title" -> [h1 [anchor ("index.html") [data archive.Logarion.Archive.Configuration.title]]]
| tag -> prerr_endline ("unknown tag: " ^ tag); [unescaped_data ""]
end
let form blog_url lgrn ymd =
let form default_owner default_email 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
@ -59,8 +84,8 @@ let form blog_url lgrn ymd =
let open Meta in
let open Author in
let auth = ymd.meta.author in
let auth_name = either auth.name Logarion.(lgrn.Archive.Configuration.owner) in
let auth_addr = either (Email.to_string auth.email) Logarion.(lgrn.Archive.Configuration.email) in
let auth_name = either auth.name default_owner in
let auth_addr = either (Email.to_string auth.email) default_email in
[
input ~a:[a_name "uuid"; a_value (Id.to_string ymd.meta.uuid); a_input_type `Hidden] ();
input_set

176
src/converters/template.ml
View File

@ -1,96 +1,17 @@
type t = Mustache.t
module Configuration = struct
type path_t = Fpath.t option
type paths_t = {
dir : path_t;
header : path_t;
note : path_t;
front : path_t;
list : path_t;
item : path_t;
}
let of_config config =
let open Confix.ConfixToml in
let p k = path config ("templates" / k) in
{
dir = p "dir";
header = p "header";
note = p "note";
front = p "front";
list = p "list";
item = p "item";
}
end
type header_t = Header of t
type footer_t = Footer of t
type list_t = List of t
type item_t = Item of t
type note_t = Note of t
type front_t = Front of t
let of_string = Mustache.of_string
let of_file f = File.load f |> of_string
let map_tpl_opt f field ps =
let open Configuration in
match ps.dir, field with
| Some dir, Some bn -> Some (f (of_file (Fpath.append dir bn)))
| _ -> None
let string s = [Html.data s]
let section ~inverted name contents = [Html.unescaped_data ("section " ^ String.concat "." name)]
let unescaped elts = [Html.unescaped_data "use escaped instead"]
let partial ?indent name _ _ = [Html.data "partials not supported"]
let comment _ = [Html.data ""]
let concat = List.concat
let header ps = map_tpl_opt (fun v -> Header v) ps.Configuration.header ps
let note ps = map_tpl_opt (fun v -> Note v) ps.Configuration.note ps
let front ps = map_tpl_opt (fun v -> Front v) ps.Configuration.front ps
let list ps = map_tpl_opt (fun v -> List v) ps.Configuration.list ps
let item ps = map_tpl_opt (fun v -> Item v) ps.Configuration.item ps
let string s = Html.data s
let section ~inverted name contents = Html.unescaped_data ("section " ^ String.concat "." name)
let unescaped elts = Html.unescaped_data "use escaped instead"
let partial ?indent name _ _ = Html.data "partials not supported"
let comment _ = Html.data ""
let concat l = l
let escaped_meta (meta : Logarion.Meta.t) e =
let open Logarion in
let e = List.hd e in
match e with
| "url" -> "/note/" ^ Meta.alias meta
| "date" | "date_created" | "date_edited" | "date_published" | "date_human" ->
"<time>" ^ Meta.value_with_name meta e ^ "</time>"
| tag -> Meta.value_with_name meta tag
let escaped_note note e = match List.hd e with
| "body" -> Html.unescaped_data @@ Omd.to_html @@ Omd.of_string note.Logarion.Note.body
| _ -> Html.unescaped_data @@ escaped_meta note.Logarion.Note.meta e
let escaped_header blog_url title e = match List.hd e with
(* | "blog_url" -> *)
| "title" -> Html.heading1 title
| tag -> prerr_endline ("unknown tag: " ^ tag); Html.unescaped_data ""
let anchor_of_meta meta =
let module Meta = Logarion.Meta in
let open Html in
anchor
(Meta.alias meta ^ ".html")
[ div ~style_class:"title" [data meta.Meta.title];
div ~style_class:"time" [data Meta.Date.(pretty_date (last meta.Meta.date))] ]
let listing metas =
let open Html in
list_unordered @@ List.map (fun m -> list_item @@ anchor_of_meta @@ m) metas
let escaped_index ~from ~n metas e = Html.data "temp"
let escaped_index ~from ~n metas e = [Html.data "temp"]
(* match List.hd e with *)
(* | "navigation" -> *)
(* "" *)
(* ^ (if from > 0 then ("<a href=\"?p=" ^ string_of_int (pred from) ^ "\">previous</a> | ") else "") *)
(* ^ (if n <= List.length metas then ("<a href=\"?p=" ^ string_of_int (succ from) ^ "\">next</a>") else "") *)
(* | "recent_texts_listing" -> (\* listing metas *\) "" *)
(* | "topics" -> *)
(* let topics = *)
(* ListLabels.fold_left *)
@ -98,37 +19,62 @@ let escaped_index ~from ~n metas e = Html.data "temp"
(* ~f:(fun a e -> Logarion.Meta.unique_topics a e ) metas *)
(* in *)
(* Logarion.Meta.StringSet.fold (fun e a -> a ^ "<li><a href=\"/topic/" ^ e ^ "\">" ^ e ^ "</a></li>") topics "" *)
(* | e -> prerr_endline ("unknown tag: " ^ e); "" *)
let header_html template url title = match template with
| Some (Header s) ->
Mustache.fold ~string ~section ~escaped:(escaped_header url title) ~unescaped ~partial ~comment ~concat:(fun l -> Html.div l) s
|> (fun x -> Html.header [x])
| None -> Html.(header [heading1 title])
let header_custom template linker archive =
Mustache.fold ~string ~section ~escaped:(Html.Renderer.archive archive) ~unescaped ~partial ~comment ~concat template
|> Html.header
let note_page ?(header_template=None) ?(note_template=None) ~style url title note =
let note_html = match note_template with
| Some (Note s) ->
Mustache.fold ~string ~section ~escaped:(escaped_note note) ~unescaped ~partial ~comment ~concat:(fun l -> Html.article l) s
| None ->
let header_default linker archive =
Html.(header [title [anchor (linker "/") [data archive.Logarion.Archive.Configuration.title]]])
let meta meta =
let open Logarion.Note in
let open Logarion.Meta in
let abstract = note.meta.abstract in
let author = note.meta.author.name in
let date = Date.(pretty_date @@ last note.meta.date) in
let series = stringset_csv note.meta.series in
let topics = stringset_csv note.meta.topics in
let keywords = stringset_csv note.meta.keywords in
let uuid = Id.to_string note.meta.uuid in
let body = Omd.to_html (Omd.of_string note.body) in
Html.note ~abstract ~author ~date ~series ~topics ~keywords ~uuid ~body
in
Html.to_string @@ Html.page ~style url title (header_html header_template url title) note_html
let abstract = meta.abstract in
let author = meta.author.name in
let date = Date.(pretty_date @@ last meta.date) in
let series = stringset_csv meta.series in
let topics = stringset_csv meta.topics in
let keywords = stringset_csv meta.keywords in
let uuid = Id.to_string meta.uuid in
Html.meta ~abstract ~author ~date ~series ~topics ~keywords ~uuid
let listing_page ?(header_template=None) ?(listing_template=None) ~style ~from ~n url title metas =
let listing_html = match listing_template with
| Some (Note s) ->
Mustache.fold ~string ~section ~escaped:(escaped_index ~from ~n metas) ~unescaped ~partial ~comment ~concat:(fun l -> Html.article l) s
| None -> Html.article [listing metas]
in
Html.to_string @@ Html.page ~style url title (header_html header_template url title) listing_html
let body_custom template note =
Mustache.fold ~string ~section ~escaped:(Html.Renderer.note note) ~unescaped ~partial ~comment ~concat template
|> Html.note
let body_default note =
Html.note
[ Html.title [Html.unescaped_data note.Logarion.Note.meta.Logarion.Meta.title]; (* Don't add title if body contains one *)
meta note.meta;
Html.unescaped_data @@ Omd.to_html @@ Omd.of_string note.Logarion.Note.body ]
let listing url_of_meta metas =
Html.listing url_of_meta metas
let page ~style title header body =
Html.to_string @@ Html.page ~style title header body
let of_config config k = match config with
| Error msg -> prerr_endline "Couldn't load [templates] section"; None
| Ok c ->
let open Confix.ConfixToml in
path c ("templates" / k)
let converter default custom = function
| Some p ->
if Confix.Config.Path.path_exists p then custom @@ of_file p
else (prerr_endline @@ "Couldn't find: " ^ Fpath.to_string p; default)
| None -> default
let header_converter config = converter header_default header_custom @@ of_config config "header"
let body_converter config = converter body_default body_custom @@ of_config config "body"
let page_of_listing ?(style="static/main.css") header listing archive metas =
page ~style "Index" (header archive) (listing metas)
let page_of_note ?(style="static/main.css") header body archive note =
page ~style note.Logarion.Note.meta.Logarion.Meta.title (header archive) (body note)
let page_of_msg ?(style="static/main.css") header archive title msg =
page ~style title (header archive) (Html.div [Html.data msg])

10
src/jbuild
View File

@ -16,9 +16,9 @@
((section share)
(files (
(../share/config.toml as config.toml)
(../share/html_templates/frontpage.mustache as html_templates/frontpage.mustache)
(../share/html_templates/header.mustache as html_templates/header.mustache)
(../share/html_templates/item.mustache as html_templates/item.mustache)
(../share/html_templates/list.mustache as html_templates/list.mustache)
(../share/html_templates/note.mustache as html_templates/note.mustache)
(../share/template/frontpage.mustache as template/frontpage.mustache)
(../share/template/header.mustache as template/header.mustache)
(../share/template/item.mustache as template/item.mustache)
(../share/template/list.mustache as template/list.mustache)
(../share/template/note.mustache as template/note.mustache)
))))

27
src/logarion_cli.ml
View File

@ -123,13 +123,13 @@ 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 page =
let title = Note.(page.meta.Meta.title) in
Converters.Template.note_page ~style:"static/main.css" "localhost" title page
in
let page_of_note_listing =
Converters.Template.listing_page ~style:"static/main.css" ~from:0 ~n:1000 "localhost" "Index"
in
let template_config = toml_config in
let module T = Converters.Template in
let header = T.header_converter template_config in
let body = T.body_converter template_config in
let linker x = match Fpath.(relativize ~root:(v "/") (v x)) with Some l -> Fpath.to_string l | None -> "" in
let page_of_listing metas = T.page_of_listing (header linker) (T.listing (fun x -> x ^ ".html")) config metas in
let page_of_note note = T.page_of_note (header linker) body config note 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
@ -137,13 +137,14 @@ let convert directory =
close_out out
in
match create_dir directory |> create_dir_msg ~descr:"export" directory with
| Ok _ ->
(match copy ~recursive:true ".logarion/static" (directory) with
| Ok _ ->
List.iter (fun note -> file_creation (path_of_note note) (page_of_note note)) notes;
file_creation (directory ^ "/index.html") (page_of_note_listing metas);
| Error (`Msg m) -> prerr_endline m)
| Error _ -> ()
| Ok _ ->
match copy ~recursive:true ".logarion/static" (directory) with
| Ok _ ->
let note_write note = file_creation (path_of_note note) (page_of_note note) in
List.iter note_write notes;
file_creation (directory ^ "/index.html") (page_of_listing metas);
| Error (`Msg m) -> prerr_endline m
let convert_term =
let directory =

29
src/logarion_webserver.ml
View File

@ -8,7 +8,6 @@ module Configuration = struct
url : Uri.t;
static : Fpath.t;
styles : Fpath.t list;
template : Template.Configuration.paths_t;
}
let of_config config =
@ -19,7 +18,6 @@ module Configuration = struct
url = string config ("web"/"url") |> mandatory |> Uri.of_string;
static = path config ("web"/"static_dir") |> mandatory;
styles = paths config ("web"/"stylesheets") |> mandatory;
template = Template.Configuration.of_config config;
}
with Failure str -> Error str
@ -71,17 +69,8 @@ let serve config_filename =
let store = File.store config.repository in
let lgrn = L.{ config; store; } in
let header_tpl = Template.header web_config.Configuration.template in
let list_tpl = Template.list web_config.Configuration.template in
let item_tpl = Template.item web_config.Configuration.template in
let note_tpl = Template.note web_config.Configuration.template in
let blog_url = Uri.to_string web_config.Configuration.url in
let module Html = Converters.Html in
let page_of_msg = Html.of_message ~header_tpl blog_url config in
let page_of_note = Html.of_note ~header_tpl ~note_tpl blog_url config in
let form_of_note = Html.form ~header_tpl blog_url config in
let list_of_notes ~from ~n = Html.of_entries ~header_tpl ~list_tpl ~item_tpl ~from ~n blog_url config in
let lwt_blanknote () = Lwt.return (Logarion.Note.blank ()) in
@ -91,6 +80,19 @@ let serve config_filename =
>|= Converters.Atom.feed config blog_url (L.note_with_id lgrn)
>>= html_response
in
let template_config = toml_config in
let module T = Converters.Template in
let header = T.header_converter template_config in
let body = T.body_converter template_config in
let linker r x = match Fpath.(relativize ~root:(v r) (v x)) with Some l -> Fpath.to_string l | None -> "" in
let page_of_listing metas =
let listing = T.listing (fun x -> "note/" ^ x) in
T.page_of_listing ~style:"/static/main.css" (header (linker "/")) listing config metas in
let page_of_note note = T.page_of_note ~style:"/static/main.css" (header (linker "/note")) body config note in
let page_of_msg title msg = T.page_of_msg ~style:"/static/main.css" (header (linker "/note")) config title msg in
let form_of_note note = T.page "/static/main.css" "Write new note" ((header (linker "/")) config) (Converters.Html.form "" "" note) in
let post_note lgrn req =
note_of_req req
>>= L.with_note lgrn
@ -117,7 +119,7 @@ let serve config_filename =
in
Lwt.return (L.latest_listed lgrn)
>|= L.sublist ~from:(from * n) ~n
>|= list_of_notes ~from ~n
>|= page_of_listing
>>= html_response
in
@ -129,7 +131,7 @@ let serve config_filename =
in
Lwt.return (L.with_topic lgrn (param req param_name))
>|= L.sublist ~from:(from * n) ~n
>|= list_of_notes ~from ~n
>|= page_of_listing
>>= html_response
in
@ -153,6 +155,7 @@ let serve config_filename =
| Some meta -> L.note_with_id lgrn meta.Logarion.Meta.uuid
| None -> None)
|> get "/feed.atom" @@ atom_response lgrn
|> get "/index.html"@@ list_notes "p" lgrn
|> get "/" @@ list_notes "p" lgrn
|> App.start
in