Browse Source

ocamlformat

Marcus Rohrmoser 1 year ago
parent
commit
f3ac2be742
7 changed files with 143 additions and 148 deletions
  1. 0 0
      .ocamlformat
  2. 53 61
      bin/meta.ml
  3. 11 11
      lib/datetime.ml
  4. 58 62
      lib/name.ml
  5. 1 1
      test/banal_test.ml
  6. 3 5
      test/parse_test.ml
  7. 17 8
      test/simple_test.ml

+ 0 - 0
.ocamlformat


+ 53 - 61
bin/meta.ml

@@ -9,18 +9,16 @@ let print_version () =
   0
 
 let print_help () =
-  let msg = "Add, delete and list tags from filenames, inspired by https://karl-voit.at/managing-digital-photographs/
-
-SYNOPSIS
-
-  $ meta tag lst [file]
-  $ meta tag add <tag> [file]
-  $ meta tag del <tag> [file]
-
-EXAMPLE
-
-  $ meta tag lst * | sort | uniq -c
-" in
+  let msg =
+    "Add, delete and list tags from filenames, inspired by \
+     https://karl-voit.at/managing-digital-photographs/\n\n\
+     SYNOPSIS\n\n\
+    \  $ meta tag lst [file]\n\
+    \  $ meta tag add <tag> [file]\n\
+    \  $ meta tag del <tag> [file]\n\n\
+     EXAMPLE\n\n\
+    \  $ meta tag lst * | sort | uniq -c\n"
+  in
   (*
   $ meta title set <title> [file]
   $ meta title get [file]
@@ -30,75 +28,69 @@ EXAMPLE
 
 let err i msgs =
   let exe = Filename.basename Sys.executable_name in
-  msgs
-    |> List.cons exe
-    |> String.concat ": "
-    |> prerr_endline;
+  msgs |> List.cons exe |> String.concat ": " |> prerr_endline;
   i
 
-let print_tag = function
-  | Name.Tag tv -> Printf.printf "%s\n" tv
+let print_tag = function Name.Tag tv -> Printf.printf "%s\n" tv
 
 let do_lst files =
   files
-    |> List.map (fun f -> let p = Name.parse f in p.tags)
-    |> List.concat
-    |> List.iter print_tag;
+  |> List.map (fun f ->
+         let p = Name.parse f in
+         p.tags)
+  |> List.concat |> List.iter print_tag;
   0
 
 let do_rename f p' =
   let f' = Name.unparse p' in
   (* https://ocaml.github.io/ocamlunix/ocamlunix.html#sec13 *)
   match Sys.file_exists f' with
-  | true  -> err 3 [f'; "file exists"]
-  | false -> try
-      Sys.rename f f';
-      Printf.printf "%s --> %s\n" f f'; 0
-    with
-    | Sys_error e -> err 4 [f; e]
+  | true -> err 3 [ f'; "file exists" ]
+  | false -> (
+      try
+        Sys.rename f f';
+        Printf.printf "%s --> %s\n" f f';
+        0
+      with Sys_error e -> err 4 [ f; e ] )
 
 let do_add tag f =
   let p = Name.parse f in
-  let tags = p.tags
-    |> List.cons tag
-    |> List.sort_uniq compare in
-  let p' = {p with tags = tags} in
+  let tags = p.tags |> List.cons tag |> List.sort_uniq compare in
+  let p' = { p with tags } in
   do_rename f p'
 
 let do_del tag f =
   let p = Name.parse f in
-  let tags = p.tags
-    |> List.sort_uniq compare
-    |> List.filter (fun x -> tag <> x)
+  let tags =
+    p.tags |> List.sort_uniq compare |> List.filter (fun x -> tag <> x)
   in
-  let p' = {p with tags = tags} in
+  let p' = { p with tags } in
   do_rename f p'
 
 let () =
-  let status = match Sys.argv |> Array.to_list |> List.tl with
-  | []  -> err 2 ["get help with -h"]
-  | arg ->
-    begin match List.hd arg with
-    | "-h"
-    | "--help"    -> print_help ()
-    | "-v"
-    | "--version" -> print_version ()
-    | "tag"       -> begin match List.tl arg with
-      | []   -> err 2 ["get help with -h"]
-      | prms -> let p2 = List.tl prms in
-        begin match List.hd prms with
-        | "lst" -> do_lst p2
-        | "add" -> let tag = Name.Tag (List.hd p2)
-          and files = List.tl p2 in
-          files |> List.iter (fun x -> (ignore (do_add tag x))); 0
-        | "del" -> let tag = Name.Tag (List.hd p2)
-          and files = List.tl p2 in
-          files |> List.iter (fun x -> (ignore (do_del tag x))); 0
-        | cmd   -> err 2 ["unknown command"; cmd]
-        end
-      end
-    | n         -> err 2 ["unknown noun"; n]
-    end
+  let status =
+    match Sys.argv |> Array.to_list |> List.tl with
+    | [] -> err 2 [ "get help with -h" ]
+    | arg -> (
+        match List.hd arg with
+        | "-h" | "--help" -> print_help ()
+        | "-v" | "--version" -> print_version ()
+        | "tag" -> (
+            match List.tl arg with
+            | [] -> err 2 [ "get help with -h" ]
+            | prms -> (
+                let p2 = List.tl prms in
+                match List.hd prms with
+                | "lst" -> do_lst p2
+                | "add" ->
+                    let tag = Name.Tag (List.hd p2) and files = List.tl p2 in
+                    files |> List.iter (fun x -> ignore (do_add tag x));
+                    0
+                | "del" ->
+                    let tag = Name.Tag (List.hd p2) and files = List.tl p2 in
+                    files |> List.iter (fun x -> ignore (do_del tag x));
+                    0
+                | cmd -> err 2 [ "unknown command"; cmd ] ) )
+        | n -> err 2 [ "unknown noun"; n ] )
   in
-  exit status;;
-
+  exit status

+ 11 - 11
lib/datetime.ml

@@ -1,23 +1,23 @@
+type year = Year of int
 
-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 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 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 time = hour * minute * second
 
+let create_time h m s = (Hour h, Minute m, Second s)
 
 type t = date * time
 
-let create y m d hh mm ss =
-  (create_date y m d, create_time hh mm ss)
+let create y m d hh mm ss = (create_date y m d, create_time hh mm ss)

+ 58 - 62
lib/name.ml

@@ -1,4 +1,3 @@
-
 (*
  * What is in a name?
  *
@@ -12,18 +11,21 @@
  * ext      (\.[^.]* )*$
  *)
 
-type dir   = Dir   of string
+type dir = Dir of string
+
 type title = Title of string
-type tag   = Tag   of string
-type ext   = Ext   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 ;
+  dirs : dir list;
+  datetime : Datetime.t option;
+  title : title;
+  tags : tag list;
+  exts : ext list;
 }
 
 (* https://caml.inria.fr/pub/docs/manual-ocaml/libref/Sys.html *)
@@ -32,82 +34,73 @@ module P = struct
   open Tyre
 
   let dir' =
-    let to_ s = Dir s
-    and of_ (Dir o) = o in
+    let to_ s = Dir s and of_ (Dir o) = o in
     conv to_ of_ (pcre "[^/]*/")
 
-  let dirs' =
-    list dir'
+  let dirs' = list dir'
 
   let datetime =
-    let to_ (((((dy,dm),dd),th),tm),ts) = Datetime.create
-      (int_of_string dy)
-      (int_of_string dm)
-      (int_of_string dd)
-      (int_of_string th)
-      (int_of_string tm)
-      (int_of_string ts)
-    and of_ ((dy,dm,dd),(th,tm,ts)) =
-      let dy' = match dy with Datetime.Year   x -> string_of_int x
-      and dm' = match dm with Datetime.Month  x -> string_of_int x
-      and dd' = match dd with Datetime.Day    x -> string_of_int x
-      and th' = match th with Datetime.Hour   x -> string_of_int x
+    let to_ (((((dy, dm), dd), th), tm), ts) =
+      Datetime.create (int_of_string dy) (int_of_string dm) (int_of_string dd)
+        (int_of_string th) (int_of_string tm) (int_of_string ts)
+    and of_ ((dy, dm, dd), (th, tm, ts)) =
+      let dy' = match dy with Datetime.Year x -> string_of_int x
+      and dm' = match dm with Datetime.Month x -> string_of_int x
+      and dd' = match dd with Datetime.Day x -> string_of_int x
+      and th' = match th with Datetime.Hour x -> string_of_int x
       and tm' = match tm with Datetime.Minute x -> string_of_int x
       and ts' = match ts with Datetime.Second x -> string_of_int x in
-      (((((dy',dm'),dd'),th'),tm'),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]"
-    )
+      (((((dy', dm'), dd'), th'), tm'), 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 ((dy,dm,dd),(th,tm,ts)) =
-    let dy' = match dy with Datetime.Year   x -> x
-    and dm' = match dm with Datetime.Month  x -> x
-    and dd' = match dd with Datetime.Day    x -> x
-    and th' = match th with Datetime.Hour   x -> x
+  let string_of_datetime ((dy, dm, dd), (th, tm, ts)) =
+    let dy' = match dy with Datetime.Year x -> x
+    and dm' = match dm with Datetime.Month x -> x
+    and dd' = match dd with Datetime.Day x -> x
+    and th' = match th with Datetime.Hour x -> x
     and tm' = match tm with Datetime.Minute x -> x
-    and ts' = match ts with Datetime.Second x -> x
-    in Format.sprintf "%04d-%02d-%02d-%02d%02d%02d-" dy' dm' dd' th' tm' ts'
+    and ts' = match ts with Datetime.Second x -> x in
+    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
+    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
+    let to_ s = Tag s and of_ (Tag o) = o in
     conv to_ of_ (pcre "[^_.]+")
 
   let sep' = "_"
+
   let sep = "_--"
 
-  let tags' =
-    str sep *> list ( str sep' *> tag' )
+  let tags' = str sep *> list (str sep' *> tag')
 
   let ext' =
-    let to_ s = Ext s
-    and of_ (Ext o) = o in
+    let to_ s = Ext s and of_ (Ext o) = o in
     conv to_ of_ (pcre "[.][^.]*")
 
-  let exts' =
-    list ext'
+  let exts' = list ext'
 
   (* 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} =
+      { 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_ (dirs' <&> (opt (datetime <* char '-') <&> (tit' <&> opt tags' <&> exts') <* stop))
+    conv to_ of_
+      ( dirs'
+      <&> (opt (datetime <* char '-') <&> (tit' <&> opt tags' <&> exts') <* stop)
+      )
 
   let full' = compile full
 end
@@ -119,17 +112,20 @@ let parse str : parsed_name =
 
 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 = match p.tags with
-  | [] -> ""
-  | t -> t |> List.map (function Tag o -> o) |> List.cons P.sep |> String.concat P.sep'
-  in p.exts
+  let dt =
+    match p.datetime with None -> "" | Some dt -> P.string_of_datetime dt
+  and tagpart =
+    match p.tags with
+    | [] -> ""
+    | t ->
+        t
+        |> 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 ""
-

+ 1 - 1
test/banal_test.ml

@@ -1,3 +1,3 @@
-
 let () = assert (1 = 1)
+
 let () = assert (1 + 1 = 2)

+ 3 - 5
test/parse_test.ml

@@ -1,9 +1,8 @@
-
 open Lib
 
-let () = 
+let () =
   let f = "2020-01-26-202853-Huhu_--_tag0_tag1.txt"
-  and tags' = List.map (fun x -> Name.Tag x) ["tag0"; "tag1"] in
+  and tags' = List.map (fun x -> Name.Tag x) [ "tag0"; "tag1" ] in
   let p = Name.parse f in
   let tags = p.tags in
   assert (tags' = tags)
@@ -19,5 +18,4 @@ let () =
 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)
-
+  assert ((d, t) = Datetime.create 2001 2 3 17 35 12)

+ 17 - 8
test/simple_test.ml

@@ -3,8 +3,11 @@
 (* A module with functions to test *)
 module To_test = struct
   let lowercase = String.lowercase_ascii
+
   let capitalize = String.capitalize_ascii
+
   let str_concat = String.concat ""
+
   let list_concat = List.append
 end
 
@@ -16,19 +19,25 @@ let test_capitalize () =
   Alcotest.(check string) "same string" "World." (To_test.capitalize "world.")
 
 let test_str_concat () =
-  Alcotest.(check string) "same string" "foobar" (To_test.str_concat ["foo"; "bar"])
+  Alcotest.(check string)
+    "same string" "foobar"
+    (To_test.str_concat [ "foo"; "bar" ])
 
 let test_list_concat () =
-  Alcotest.(check (list int)) "same lists" [1; 2; 3] (To_test.list_concat [1] [2; 3])
+  Alcotest.(check (list int))
+    "same lists" [ 1; 2; 3 ]
+    (To_test.list_concat [ 1 ] [ 2; 3 ])
 
 (* Run it *)
 let () =
   let open Alcotest in
-  run "Utils" [
-      "string-case", [
-          test_case "Lower case"     `Quick test_lowercase;
+  run "Utils"
+    [
+      ( "string-case",
+        [
+          test_case "Lower case" `Quick test_lowercase;
           test_case "Capitalization" `Quick test_capitalize;
-        ];
-      "string-concat", [ test_case "String mashing" `Quick test_str_concat  ];
-      "list-concat",   [ test_case "List mashing"   `Slow  test_list_concat ];
+        ] );
+      ("string-concat", [ test_case "String mashing" `Quick test_str_concat ]);
+      ("list-concat", [ test_case "List mashing" `Slow test_list_concat ]);
     ]