♊️ Mirror of https://code.mro.name/mro/Tagger | 🐫 Add, delete and list tags of files stored in filenames.
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
75 lines
2.2 KiB
75 lines
2.2 KiB
(* |
|
* What is in a name? |
|
* |
|
* /some/dir/2019-12-31-173519-MyFooBar_--_sometag_anothertag.a.b.gz |
|
* |--dirs--||---datetime----| |title-| |-tag-| |--tag---||exts-| |
|
* |
|
* dirs ^([^/]*/)* |
|
* datetime ((\d{4})-(\d{2})-(\d{2})-(\d{2})(\d{2})(\d{2})-)? |
|
* title (.*?) |
|
* tags (_--(_[^_.]+)* )? |
|
* ext (\.[^.]* )*$ |
|
*) |
|
|
|
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 |
|
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' = conv (fun s -> Dir s) (fun (Dir o) -> o) (pcre "[^/]*/") |
|
|
|
let datetime = |
|
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' = conv (fun s -> Ext s) (fun (Ext o) -> o) (pcre "[.][^.]*") |
|
|
|
(* https://gabriel.radanne.net/papers/tyre/tyre_paper.pdf#page=9 *) |
|
let full = |
|
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') |
|
<* stop)) |
|
|
|
let full' = compile full |
|
end |
|
|
|
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 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 )
|
|
|