code less verbose.

bin/gen_link_flags.sh

@@ -7,7 +7,7 @@ case "$(uname -s)" in
     echo '()'
     ;;
   *)
-    echo '(-ccopt "-static")'
+    echo '(-ccopt -static)'
     ;;
 esac
 

bin/meta.ml

@@ -1,5 +1,4 @@
-(*
- *)
+(* *)
 
 open Lib
 
@@ -20,24 +19,17 @@ let file_rename oc f p' =
         0
       with Sys_error e -> err 4 [ f; e ])
 
-let tag_add oc tag f =
-  let p = Name.parse f in
-  let tags = p.tags |> List.cons tag |> List.sort_uniq compare in
-  { p with tags } |> file_rename oc f
-
-let tag_del oc tag f =
-  let p = Name.parse f in
-  let tags =
-    p.tags |> List.sort_uniq compare |> List.filter (fun x -> tag <> x)
-  in
-  { p with tags } |> file_rename oc f
-
 let title_get oc files =
-  let print_title = function Name.Title tv -> Printf.fprintf oc "%s\n" tv in
-  files |> List.map (fun f -> (Name.parse f).title) |> List.iter print_title;
+  files
+  |> List.map (fun f ->
+         let _, _, title, _, _ = Name.parse f in
+         title)
+  |> List.iter (fun (Name.Title tv) -> Printf.fprintf oc "%s\n" tv);
   0
 
-let title_set oc title f = { (Name.parse f) with title } |> file_rename oc f
+let title_set oc title f =
+  let dir, datetime, _, tags, exts = Name.parse f in
+  (dir, datetime, title, tags, exts) |> file_rename oc f
 
 let () =
   let print_help oc =
@@ -62,11 +54,15 @@ let () =
     Printf.fprintf oc "%s: https://mro.name/%s/v%s, built: %s\n" exe "meta"
       Version.git_sha Version.date;
     0
+  and tag_add oc tag f = tag |> Name.tag_add (Name.parse f) |> file_rename oc f
+  and tag_del oc tag f = tag |> Name.tag_del (Name.parse f) |> file_rename oc f
   and tag_lst oc files =
-    let print_tag = function Name.Tag tv -> Printf.fprintf oc "%s\n" tv in
     files
-    |> List.map (fun f -> (Name.parse f).tags)
-    |> List.concat |> List.iter print_tag;
+    |> List.map (fun f ->
+           let _, _, _, tags, _ = Name.parse f in
+           tags)
+    |> List.concat
+    |> List.iter (fun (Name.Tag tv) -> Printf.fprintf oc "%s\n" tv);
     0
   and each v fkt lst =
     lst |> List.iter (fun x -> ignore (fkt v x));

lib/datetime.ml

@@ -1,23 +0,0 @@
-type year = Year of int
-
-type month = Month of int
-
-type day = Day of int
-
-type date = year * month * day
-
-let create_date (y, m, d) = (Year y, Month m, Day d)
-
-type hour = Hour of int
-
-type minute = Minute of int
-
-type second = Second of int
-
-type time = hour * minute * second
-
-let create_time (h, m, s) = (Hour h, Minute m, Second s)
-
-type t = date * time
-
-let create (da, ti) = (create_date da, create_time ti)

lib/name.ml

@@ -12,81 +12,43 @@
  *)
 
 type dir = Dir of string
-
+type datetime = Datetime of string
 type title = Title of string
-
 type tag = Tag of string
-
 type ext = Ext of string
-
-(* A tuple would suffice because everything is semantically strict typed. *)
-type parsed_name = {
-  dirs : dir list;
-  datetime : Datetime.t option;
-  title : title;
-  tags : tag list;
-  exts : ext list;
-}
+type t = dir list * datetime option * title * tag list * ext list
 
 (* https://caml.inria.fr/pub/docs/manual-ocaml/libref/Sys.html *)
 
 module P = struct
   open Tyre
 
-  let dir' =
-    let to_ s = Dir s and of_ (Dir o) = o in
-    conv to_ of_ (pcre "[^/]*/")
+  let dir' = conv (fun s -> Dir s) (fun (Dir o) -> o) (pcre "[^/]*/")
 
   let datetime =
-    let to_ (((((dy, dm), dd), th), tm), ts) =
-      let i = int_of_string in
-      Datetime.create ((i dy, i dm, i dd), (i th, i tm, i ts))
-    and of_
-        ( (Datetime.Year dy, Datetime.Month dm, Datetime.Day dd),
-          (Datetime.Hour th, Datetime.Minute tm, Datetime.Second ts) ) =
-      let s = string_of_int in
-      (((((s dy, s dm), s dd), s th), s tm), s ts)
-    in
-    conv to_ of_
-      (pcre "[0-9]{4}" <* char '-'
-      <&> pcre "01|02|03|04|05|06|07|08|09|10|11|12"
-      <* char '-' <&> pcre "[0-3][0-9]" <* char '-' <&> pcre "[0-2][0-9]"
-      <&> pcre "[0-5][0-9]" <&> pcre "[0-5][0-9]")
-
-  (* brings the trailing - *)
-  let string_of_datetime
-      ( (Datetime.Year dy, Datetime.Month dm, Datetime.Day dd),
-        (Datetime.Hour th, Datetime.Minute tm, Datetime.Second ts) ) =
-    Format.sprintf "%04d-%02d-%02d-%02d%02d%02d-" dy dm dd th tm ts
-
-  let tit' =
-    let to_ s = Title s and of_ (Title o) = o in
-    conv to_ of_ (pcre "[^/]*?")
-
-  let tag' =
-    let to_ s = Tag s and of_ (Tag o) = o in
-    conv to_ of_ (pcre "[^_.]+")
-
+    conv
+      (fun s -> Datetime s)
+      (fun (Datetime o) -> o)
+      (pcre
+         ("[0-9]{4}" ^ "-" ^ "01|02|03|04|05|06|07|08|09|10|11|12" ^ "-"
+        ^ "[0-3][0-9]" ^ "-" ^ "[0-2][0-9]" ^ "[0-5][0-9]" ^ "[0-5][0-9]"))
+
+  let tit' = conv (fun s -> Title s) (fun (Title o) -> o) (pcre "[^/]*?")
+  let tag' = conv (fun s -> Tag s) (fun (Tag o) -> o) (pcre "[^_.]+")
   let sep' = "_"
-
   let sep = "_--"
-
   let tags' = str sep *> list (str sep' *> tag')
-
-  let ext' =
-    let to_ s = Ext s and of_ (Ext o) = o in
-    conv to_ of_ (pcre "[.][^.]*")
+  let ext' = conv (fun s -> Ext s) (fun (Ext o) -> o) (pcre "[.][^.]*")
 
   (* https://gabriel.radanne.net/papers/tyre/tyre_paper.pdf#page=9 *)
   let full =
-    let to_ (dirs, (datetime, ((title, ta), exts))) =
-      let tags = match ta with None -> [] | Some t -> t in
-      { dirs; datetime; title; tags; exts }
-    and of_ { dirs; datetime; title; tags; exts } =
-      let ta = match tags with [] -> None | t -> Some t in
-      (dirs, (datetime, ((title, ta), exts)))
-    in
-    conv to_ of_
+    conv
+      (fun (dirs, (datetime, ((title, ta), exts))) ->
+        let tags = match ta with None -> [] | Some t -> t in
+        (dirs, datetime, title, tags, exts))
+      (fun (dirs, datetime, title, tags, exts) ->
+        let ta = match tags with [] -> None | t -> Some t in
+        (dirs, (datetime, ((title, ta), exts))))
       (list dir'
       <&> (opt (datetime <* char '-')
           <&> (tit' <&> opt tags' <&> list ext')
@@ -95,24 +57,19 @@ module P = struct
   let full' = compile full
 end
 
-let parse str : parsed_name =
+let parse str : t =
   match Tyre.exec P.full' str with
   | Error _ -> failwith "gibt's nicht."
   | Ok n -> n
 
-let unparse p : string =
-  (* Tyre.eval P.full p *)
-  let dt =
-    match p.datetime with None -> "" | Some dt -> P.string_of_datetime dt
-  and tagpart =
-    p.tags
-    |> List.map (function Tag o -> o)
-    |> List.cons P.sep |> String.concat P.sep'
-  in
-  p.exts
-  |> List.map (function Ext o -> o)
-  |> List.cons tagpart
-  |> List.cons (match p.title with Title t -> t)
-  |> List.cons dt
-  |> List.append (p.dirs |> List.map (function Dir o -> o))
-  |> String.concat ""
+let unparse p : string = Tyre.eval P.full p
+
+let tag_add (drs, tim, tit, tags, xts) tag =
+  (drs, tim, tit, tags |> List.cons tag |> List.sort_uniq compare, xts)
+
+let tag_del (drs, tim, tit, tags, xts) tag =
+  ( drs,
+    tim,
+    tit,
+    tags |> List.sort_uniq compare |> List.filter (fun x -> tag <> x),
+    xts )

test/parse_test.ml

@@ -1,21 +1,22 @@
 open Lib
 
-let () =
+let test_parse () =
   let f = "2020-01-26-202853-Huhu_--_tag0_tag1.txt"
   and tags' = [ "tag0"; "tag1" ] |> List.map (fun x -> Name.Tag x) in
-  let p = Name.parse f in
-  let tags = p.tags in
+  let _, _, _, tags, _ = Name.parse f in
   assert (tags' = tags)
 
-let () =
-  let t = (Datetime.Hour 1, Datetime.Minute 2, Datetime.Second 3) in
-  assert (t = Datetime.create_time (1, 2, 3))
-
-let () =
-  let d = (Datetime.Year 2001, Datetime.Month 2, Datetime.Day 3) in
-  assert (d = Datetime.create_date (2001, 2, 3))
+let test_tyre_eval () =
+  let f = "/a/b/2020-01-26-202853-Huhu_--_tag0_tag1.txt" in
+  let p = Name.parse f in
+  let f' = Tyre.eval Name.P.full p in
+  assert (f = f');
+  let p' = Name.tag_add p (Name.Tag "tag2") in
+  let f'' = Tyre.eval Name.P.full p' in
+  assert ("/a/b/2020-01-26-202853-Huhu_--_tag0_tag1_tag2.txt" = f'')
 
 let () =
-  let t = (Datetime.Hour 17, Datetime.Minute 35, Datetime.Second 12) in
-  let d = (Datetime.Year 2001, Datetime.Month 2, Datetime.Day 3) in
-  assert ((d, t) = Datetime.create ((2001, 2, 3), (17, 35, 12)))
+  Unix.chdir "../../../test/";
+  test_parse ();
+  test_tyre_eval ();
+  assert true