Browse Source

- stdout explicit
- mirror

Marcus Rohrmoser 1 year ago
parent
commit
02ba70881e
7 changed files with 156 additions and 98 deletions
  1. 17 1
      README.md
  2. 51 56
      bin/meta.ml
  3. 1 1
      bootstrap.txt
  4. 60 0
      doap.rdf
  5. 3 3
      lib/datetime.ml
  6. 20 33
      lib/name.ml
  7. 4 4
      test/parse_test.ml

+ 17 - 1
README.md

@@ -1,5 +1,5 @@
 
-Add, delete and list tag of files stored in filenames, inspired by
+Add, delete and list tags of files stored in filenames, inspired by
 https://karl-voit.at/managing-digital-photographs/
 
 ## Synopsis
@@ -12,3 +12,19 @@ $ meta title set <title> [file]
 $ meta title get [file]
 ```
 
+
+## Design Goals
+
+| Quality         | very good | good | normal | irrelevant |
+|-----------------|:---------:|:----:|:------:|:----------:|
+| Functionality   |           |   ×  |        |            |
+| Reliability     |           |      |    ×   |            |
+| Usability       |           |   ×  |        |            |
+| Efficiency      |           |      |    ×   |            |
+| Changeability   |           |   ×  |        |            |
+| Portability     |           |      |        |      ×     |
+
+
+## Mirrors
+
+see doap.rdf

+ 51 - 56
bin/meta.ml

@@ -8,15 +8,7 @@ let err i msgs =
   msgs |> List.cons exe |> String.concat ": " |> prerr_endline;
   i
 
-let print_tag = function Name.Tag tv -> Printf.printf "%s\n" tv
-
-let tag_lst files =
-  files
-  |> List.map (fun f -> (Name.parse f).tags)
-  |> List.concat |> List.iter print_tag;
-  0
-
-let file_rename f p' =
+let file_rename oc f p' =
   let f' = Name.unparse p' in
   (* https://ocaml.github.io/ocamlunix/ocamlunix.html#sec13 *)
   match Sys.file_exists f' with
@@ -24,66 +16,69 @@ let file_rename f p' =
   | false -> (
       try
         Sys.rename f f';
-        Printf.printf "%s --> %s\n" f f';
+        Printf.fprintf oc "%s --> %s\n" f f';
         0
-      with Sys_error e -> err 4 [ f; e ] )
+      with Sys_error e -> err 4 [ f; e ])
 
-let tag_add tag f =
+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 f
+  { p with tags } |> file_rename oc f
 
-let tag_del tag 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 f
-
-let print_title = function Name.Title tv -> Printf.printf "%s\n" tv
+  { p with tags } |> file_rename oc f
 
-let title_get files =
+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;
   0
 
-let title_set title f = { (Name.parse f) with title } |> file_rename f
-
-let each v fkt lst =
-  lst |> List.iter (fun x -> ignore (fkt v x));
-  0
-
-let print_version () =
-  let exe = Filename.basename Sys.executable_name in
-  Printf.printf "%s: https://mro.name/%s/v%s, built: %s\n" exe "meta"
-    Version.git_sha Version.date;
-  0
-
-let print_help () =
-  let msg =
-    "Add, delete and list tags from filenames, inspired by \
-     https://karl-voit.at/managing-digital-photographs/\n\n\
-     SYNOPSIS\n\n\
-    \  $ meta -h                # get this help\n\
-    \  $ meta -v                # version\n\n\
-    \  $ meta tag lst [file]\n\
-    \  $ meta tag add <tag> [file]\n\
-    \  $ meta tag del <tag> [file]\n\n\
-    \  $ meta title get [file]\n\
-    \  $ meta title set <title> [file]\n\n\
-     EXAMPLE\n\n\
-    \  $ meta tag lst * | sort | uniq -c\n"
-  in
-  Printf.printf "%s\n" msg;
-  0
+let title_set oc title f = { (Name.parse f) with title } |> file_rename oc f
 
 let () =
-  ( match Sys.argv |> Array.to_list |> List.tl with
-  | [ "-h" ] | [ "--help" ] -> print_help ()
-  | [ "-v" ] | [ "--version" ] -> print_version ()
-  | "tag" :: "lst" :: fs -> fs |> tag_lst
-  | "tag" :: "add" :: t :: fs -> fs |> each (Name.Tag t) tag_add
-  | "tag" :: "del" :: t :: fs -> fs |> each (Name.Tag t) tag_del
-  | "title" :: "get" :: fs -> fs |> title_get
-  | "title" :: "set" :: t :: fs -> fs |> each (Name.Title t) title_set
-  | _ -> err 2 [ "get help with -h" ] )
+  let print_help oc =
+    let msg =
+      "Add, delete and list tags from filenames, inspired by \
+       https://karl-voit.at/managing-digital-photographs/\n\n\
+       SYNOPSIS\n\n\
+      \  $ meta -h                # get this help\n\
+      \  $ meta -V                # version\n\n\
+      \  $ meta tag lst [file]\n\
+      \  $ meta tag add <tag> [file]\n\
+      \  $ meta tag del <tag> [file]\n\n\
+      \  $ meta title get [file]\n\
+      \  $ meta title set <title> [file]\n\n\
+       EXAMPLE\n\n\
+      \  $ meta tag lst * | sort | uniq -c\n"
+    in
+    Printf.fprintf oc "%s\n" msg;
+    0
+  and print_version oc =
+    let exe = Filename.basename Sys.executable_name in
+    Printf.fprintf oc "%s: https://mro.name/%s/v%s, built: %s\n" exe "meta"
+      Version.git_sha Version.date;
+    0
+  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;
+    0
+  and each v fkt lst =
+    lst |> List.iter (fun x -> ignore (fkt v x));
+    0
+  in
+  (match Sys.argv |> Array.to_list |> List.tl with
+  | [ "-h" ] | [ "--help" ] -> print_help stdout
+  | [ "-V" ] | [ "--version" ] -> print_version stdout
+  | "tag" :: "lst" :: fs -> fs |> tag_lst stdout
+  | "tag" :: "add" :: t :: fs -> fs |> each (Name.Tag t) (tag_add stdout)
+  | "tag" :: "del" :: t :: fs -> fs |> each (Name.Tag t) (tag_del stdout)
+  | "title" :: "get" :: fs -> fs |> title_get stdout
+  | "title" :: "set" :: t :: fs -> fs |> each (Name.Title t) (title_set stdout)
+  | _ -> err 2 [ "get help with -h" ])
   |> exit

+ 1 - 1
bootstrap.txt

@@ -21,4 +21,4 @@ $ nice opam switch install 4.10.0+musl+static+flambda
 # $ fgrep -- '--disable-shared' ~/.opam/repo/default/packages/ocaml-variants/ocaml-variants.4.??.?+musl+static+flambda/opam
 # https://github.com/ocaml/opam-repository/commit/87bc3c71
 
-$ nice opam install --yes dune tyre angstrom safepass syndic yaml
+$ nice opam install --yes dune tyre

+ 60 - 0
doap.rdf

@@ -0,0 +1,60 @@
+<?xml version="1.0" encoding="utf-8"?>
+<rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+   xmlns="http://usefulinc.com/ns/doap#">
+  <Project>
+    <name>Tagger</name>
+    <shortdesc xml:lang="en">
+Add, delete and list tag of files stored in filenames.
+    </shortdesc>
+    <homepage rdf:resource="https://mro.name/Tagger"/>
+    <programming-language>OCaml</programming-language>
+    <bug-database rdf:resource="https://code.mro.name/mro/Tagger/issues"/>
+    <maintainer rdf:resource="https://code.mro.name/mro"/>
+    <description xml:lang="en">
+Add, delete and list tag of files stored in filenames, inspired by https://karl-voit.at/managing-digital-photographs/
+
+Synopsis
+
+$ meta tag add <tag> [file]
+$ meta tag lst [file]
+$ meta tag del <tag> [file]
+$ meta title set <title> [file]
+$ meta title get [file
+    </description>
+    <repository>
+      <GitRepository>
+        <browse rdf:resource="https://code.mro.name/mro/Tagger"/>
+        <location rdf:resource="https://code.mro.name/mro/Tagger.git"/>
+      </GitRepository>
+    </repository>
+<!--
+    <repository>
+      <GitRepository>
+        <browse rdf:resource="https://github.com/mro/form2xhtml"/>
+      </GitRepository>
+    </repository>
+    <repository>
+      <GitRepository>
+        <browse rdf:resource="https://gitlab.com/mro/Tagger"/>
+      </GitRepository>
+    </repository>
+    <repository>
+      <GitRepository>
+        <browse rdf:resource="https://notabug.org/mro/Tagger"/>
+      </GitRepository>
+    </repository>
+-->
+    <repository>
+      <GitRepository>
+        <browse rdf:resource="https://codeberg.org/mro/Tagger"/>
+      </GitRepository>
+    </repository>
+<!--
+    <repository>
+      <GitRepository>
+        <browse rdf:resource="https://repo.or.cz/Tagger.git"/>
+      </GitRepository>
+    </repository>
+-->
+  </Project>
+</rdf:RDF>

+ 3 - 3
lib/datetime.ml

@@ -6,7 +6,7 @@ type day = Day of int
 
 type date = year * month * day
 
-let create_date y m d = (Year y, Month m, Day d)
+let create_date (y, m, d) = (Year y, Month m, Day d)
 
 type hour = Hour of int
 
@@ -16,8 +16,8 @@ type second = Second of int
 
 type time = hour * minute * second
 
-let create_time h m s = (Hour h, Minute m, Second s)
+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 (da, ti) = (create_date da, create_time ti)

+ 20 - 33
lib/name.ml

@@ -37,36 +37,27 @@ module P = struct
     let to_ s = Dir s and of_ (Dir o) = o in
     conv to_ of_ (pcre "[^/]*/")
 
-  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
-      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')
+      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 "[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]" )
+      <&> 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
-    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'
+  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
@@ -86,8 +77,6 @@ module P = struct
     let to_ s = Ext s and of_ (Ext o) = o in
     conv to_ of_ (pcre "[.][^.]*")
 
-  let exts' = list ext'
-
   (* https://gabriel.radanne.net/papers/tyre/tyre_paper.pdf#page=9 *)
   let full =
     let to_ (dirs, (datetime, ((title, ta), exts))) =
@@ -98,9 +87,10 @@ module P = struct
       (dirs, (datetime, ((title, ta), exts)))
     in
     conv to_ of_
-      ( dirs'
-      <&> (opt (datetime <* char '-') <&> (tit' <&> opt tags' <&> exts') <* stop)
-      )
+      (list dir'
+      <&> (opt (datetime <* char '-')
+          <&> (tit' <&> opt tags' <&> list ext')
+          <* stop))
 
   let full' = compile full
 end
@@ -115,12 +105,9 @@ let unparse p : string =
   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'
+    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)

+ 4 - 4
test/parse_test.ml

@@ -2,20 +2,20 @@ open Lib
 
 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' = [ "tag0"; "tag1" ] |> List.map (fun x -> Name.Tag x) in
   let p = Name.parse f in
   let tags = p.tags 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)
+  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)
+  assert (d = Datetime.create_date (2001, 2, 3))
 
 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)))