1 files changed, 85 insertions, 0 deletions
diff --git a/mpdwatch/parse.ml b/mpdwatch/parse.ml
new file mode 100644
index 0000000..bd7f0a0
--- /dev/null
+++ b/mpdwatch/parse.ml
@@ -0,0 +1,85 @@
+open Angstrom
+
+(**
+   We only care about tags in the intersection of those known
+   by MPD and ListenBrainz. They are (LB <-> MPD)
+   + artist_name <-> artist, performer, composer
+   + track_name <-> title
+   + tracknumber <-> track
+   + artist_mbids <-> musicbrainz_artistid
+   + release_mbid <-> musicbrainz_albumid
+   + recording_mbid <-> musicbrainz_trackid
+   MPD may return multiple entries for each tag.
+   See https://picard-docs.musicbrainz.org/downloads/MusicBrainz_Picard_Tag_Map.html
+   for the correspondence between LB and MPD tag names.
+*)
+type currentsong = {
+  artist: string list;
+  performer: string list;
+  composer: string list;
+  title: string option;
+  track: int option;
+  musicbrainz_albumid: string option;
+  musicbrainz_artistid: string list;
+  musicbrainz_trackid: string option;
+}
+
+exception ParseError of string
+
+let parse_string p s =
+  match Angstrom.parse_string ~consume:All (p >>= return) s with
+  | Ok parsed -> parsed
+  | Error m -> raise (ParseError m)
+
+let take_till_eol =
+  let is_eol = function
+    | '\n' | '\r' -> true
+    | _ -> false in
+  take_till is_eol <* end_of_line
+
+let is_whitespace = function
+  | ' ' | '\t' -> true
+  | _ -> false
+
+let skip_spaces = skip_while is_whitespace
+
+let currentsong_parser : currentsong Angstrom.t =
+  let open Angstrom in
+  fix (fun currentsong ->
+      lift2 (fun artist current -> { current with artist = artist :: current.artist })
+        (string "Artist:" *> skip_spaces *> take_till_eol)
+        currentsong
+      <|> lift2 (fun performer current -> { current with performer = performer :: current.performer })
+        (string "Performer:" *> skip_spaces *> take_till_eol)
+        currentsong
+      <|> lift2 (fun composer current -> { current with composer = composer :: current.composer })
+        (string "Composer:" *> skip_spaces *> take_till_eol)
+        currentsong
+      <|> lift2 (fun title current -> { current with title = Some title })
+        (string "Title:" *> skip_spaces *> take_till_eol)
+        currentsong
+      <|> lift2 (fun track current -> { current with track = Some (int_of_string track) })
+        (string "Track:" *> skip_spaces *> take_till_eol)
+        currentsong
+      <|> lift2 (fun albumid current -> { current with musicbrainz_albumid = Some albumid })
+        (string "MUSICBRAINZ_ALBUMID:" *> skip_spaces *> take_till_eol)
+        currentsong
+      <|> lift2 (fun artistid current ->
+          { current with musicbrainz_artistid = artistid :: current.musicbrainz_artistid })
+        (string "MUSICBRAINZ_ARTISTID:" *> skip_spaces *> take_till_eol)
+        currentsong
+      <|> lift2 (fun trackid current -> { current with musicbrainz_trackid = Some trackid })
+        (string "MUSICBRAINZ_TRACKID:" *> skip_spaces *> take_till_eol)
+        currentsong
+      <|> ((string "OK") *> return {
+          artist = [];
+          performer = [];
+          composer = [];
+          title = None;
+          track = None;
+          musicbrainz_albumid = None;
+          musicbrainz_artistid = [];
+          musicbrainz_trackid = None;
+        })
+      <|> (take_till_eol *> currentsong))
+  <?> "currentsong"