Add support for markup in titles and blocks v0.1

Currently there is only one markup processor available, namely markdown,
but infrastructure for more markup processors has been introduced.
Markdown can be enabled using the --markdown flag.

8 files changed, 52 insertions, 21 deletions

diff --git a/_tags b/_tags
index c94104e..4123a24 100644
--- a/_tags
+++ b/_tags
@@ -1,4 +1,4 @@
 true : bin_annot, safe_string, package(bytes ptime angstrom astring)
 <src> : include
 
-<src/logbook*> : package(lwt lwt.unix jingoo)
+<src/logbook*> : package(lwt lwt.unix jingoo cow)
diff --git a/logbook.nix b/logbook.nix
index 695b907..d0b01e1 100644
--- a/logbook.nix
+++ b/logbook.nix
@@ -1,5 +1,5 @@
 { stdenv, ocaml, topkg, ocamlbuild, findlib, ocaml_lwt
-, jingoo, ptime, angstrom, astring, opam}:
+, jingoo, ptime, angstrom, astring, opam, cow}:
 
 stdenv.mkDerivation rec {
   version = "0.1";
@@ -7,7 +7,7 @@ stdenv.mkDerivation rec {
 
   src = ./.;
 
-  buildInputs = [ ocaml findlib ocamlbuild topkg opam
+  buildInputs = [ ocaml findlib ocamlbuild topkg opam cow
                   ocaml_lwt jingoo ptime angstrom astring
                 ];
 
diff --git a/opam b/opam
index b0c9dc1..c1e1277 100644
--- a/opam
+++ b/opam
@@ -17,6 +17,7 @@ depends: [
   "astring"
   "lwt"
   "jingoo"
+  "cow"
   ]
 depopts: []
 build: [
diff --git a/pkg/META b/pkg/META
index bb2b70f..d87022d 100644
--- a/pkg/META
+++ b/pkg/META
@@ -1,6 +1,6 @@
 description = "tool for personal log files"
 version = "%%VERSION_NUM%%"
-requires = "ptime angstrom astring lwt jingoo"
+requires = "ptime angstrom astring lwt jingoo omd"
 archive(byte) = "logbook.cma"
 archive(native) = "logbook.cmxa"
 plugin(byte) = "logbook.cma"
diff --git a/src/log.ml b/src/log.ml
index 3a4b95a..b2680f8 100644
--- a/src/log.ml
+++ b/src/log.ml
@@ -20,14 +20,14 @@ let privacy_level_of_char = function
   | '*' -> Some Semi_private
   | _   -> None
 
-type item = Item of privacy_level * string * string
+type 'a item = Item of privacy_level * 'a * 'a
 
 let filter_privacy_level mode items =
   List.filter (fun (Item (p, _, _)) -> compatible_privacy p mode) items
 
-type log_entry = Log_entry of Ptime.date * string * item list
+type 'a log_entry = Log_entry of Ptime.date * 'a * ('a item) list
 
-type log = log_entry list
+type 'a log = ('a log_entry) list
 
 (* parser *)
 
@@ -89,6 +89,15 @@ let log_parser =
   skip_many empty_line *>
   spaced_list log_entryp
 
+(* processing *)
+
+let apply_markup markup log =
+  let apply_items items =
+    List.map (fun (Item (priv, title, block)) ->
+      Item (priv, (markup title), (markup block))) items in
+  List.map (fun (Log_entry (date, summary, items)) ->
+    Log_entry (date, (markup summary), (apply_items items))) log
+
 (*---------------------------------------------------------------------------
    Copyright (c) 2017 sternenseemann
 
diff --git a/src/log.mli b/src/log.mli
index e62acea..de92068 100644
--- a/src/log.mli
+++ b/src/log.mli
@@ -13,17 +13,19 @@
 
 (** {2 Log Representation} *)
 
-(** Describes, how private a log item is. Semi-private means “visible to trusted persons” *)
+(** Describes, how private a log item is, where private means
+    “item only visible to oneself, semi-private “item visible to trusted persons”
+    and public “item visible to everyone”. *)
 type privacy_level = Private | Semi_private | Public
 
-(** A log item consisting of a title, a text (formatting/markup unknown) and its privacy level. *)
-type item = Item of privacy_level * string * string
+(** A log item consisting of its privacy level, a title and a text, both in markup ['a].  *)
+type 'a item = Item of privacy_level * 'a * 'a
 
-(** A log entry consisting of a date (point in time is sufficient, so Ptime is used), a summary and items *)
-type log_entry = Log_entry of Ptime.date * string * item list
+(** A log entry consisting of a date, a summary and items, both in markup ['a]. *)
+type 'a log_entry = Log_entry of Ptime.date * 'a * ('a item) list
 
-(** A log file consisting of multiple log entries for multiple days *)
-type log = log_entry list
+(** A log file consisting of multiple log entries for multiple days using markup ['a]. *)
+type 'a log = ('a log_entry) list
 
 (** A test to check wether a privacy level of e. g. an item is
     compatible with the (maximum) privacy level available. *)
@@ -32,7 +34,9 @@ val compatible_privacy : privacy_level -> privacy_level -> bool
 (** Get the corresponding privacy level for a char *)
 val privacy_level_of_char : char -> privacy_level option
 
-val filter_privacy_level : privacy_level -> item list -> item list
+(** Remove all items incompatible with the given privacy level
+    from the list of items. *)
+val filter_privacy_level : privacy_level -> ('a item) list -> ('a item) list
 
 (** {2 Log Parsing} 
 
@@ -40,7 +44,13 @@ val filter_privacy_level : privacy_level -> item list -> item list
 *)
 
 (** An angstrom parser for log files *)
-val log_parser : log Angstrom.t
+val log_parser : (string log) Angstrom.t
+
+(** {2 Log processing} *)
+
+(** Convert a log's markup. This is especially useful
+    to apply a specific markup to a freshly parsed log file. *)
+val apply_markup : ('a -> 'b) -> 'a log -> 'b log
 
 (** {2 Log Building} *)
 
diff --git a/src/logbook.ml b/src/logbook.ml
index 2da26c3..870caa3 100644
--- a/src/logbook.ml
+++ b/src/logbook.ml
@@ -8,6 +8,7 @@ let parse_file f =
 
 let input_file = ref None
 let privacy = ref Log.Public
+let markup = ref (fun s -> Cow_html.p (Cow_html.string s))
 
 let arglist =
   [ ("--file", Arg.String (fun f -> input_file := Some f), "log file to use");
@@ -17,9 +18,14 @@ let arglist =
     "set privacy level of output to public");
     ("--semi-private", Arg.Unit (fun () -> privacy := Log.Semi_private),
     "set privacy level of output to semi-private");
+    ("--markdown", Arg.Unit (fun () -> markup := Cow_markdown.of_string),
+    "enable markdown markup");
   ]
 
-let usage = Sys.argv.(0) ^ " --file [file.log] [--public | --private | --semi-private]"
+let usage =
+  Sys.argv.(0) ^ " --file [file.log]" ^
+  " [--public | --private | --semi-private]" ^
+  " [--markdown]"
 
 let _ =
   Arg.parse arglist (fun _ -> ()) usage;
@@ -29,6 +35,9 @@ let _ =
       match log with
       | Result.Error msg -> failwith msg
       | Result.Ok log -> return log)
+  in
+  let log_markup =
+    Log.apply_markup (fun x -> Cow_xml.to_string ~decl:false (!markup x)) log
   in print_string (Jg_template.from_string
     Logbook_template.template
-    ~models:(Logbook_models.model_of_log !privacy log))
+    ~models:(Logbook_models.model_of_log !privacy log_markup))
diff --git a/src/logbook_template.ml b/src/logbook_template.ml
index 36fbc5f..d21b3f9 100644
--- a/src/logbook_template.ml
+++ b/src/logbook_template.ml
@@ -10,14 +10,16 @@ let template = "<!doctype html>
     {% for entry in entries %}
     <article>
       <h2>{{ entry.date }}</h2>
-      <p>{{ entry.summary }}</p>
+      {% autoescape false %}
+      {{ entry.summary }}
       <ul>
       {% for item in entry.items %}
         <li>
-          <p><em>{{ item.title }}</em></p>
-          <p>{{ item.text }}</p>
+          {{ item.title }}
+          {{ item.text }}
         </li>
       {% endfor %}
+      {% endautoescape %}
       </ul>
     </article>
     {% endfor %}