From b53a8d85da1ddb2e27619dfdc3848a8420fde70e Mon Sep 17 00:00:00 2001
From: Ryan Kavanagh <rak@rak.ac>
Date: Fri, 12 Nov 2021 21:33:05 -0500
Subject: Added parsing of currentsong for mpd protocol

---
 dune-project       |  7 +++++
 mpdwatch/dune      |  6 ++++
 mpdwatch/parse.ml  | 85 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 mpdwatch/parse.mli | 16 ++++++++++
 4 files changed, 114 insertions(+)
 create mode 100644 mpdwatch/dune
 create mode 100644 mpdwatch/parse.ml
 create mode 100644 mpdwatch/parse.mli

diff --git a/dune-project b/dune-project
index 5d36f61..8fc215d 100644
--- a/dune-project
+++ b/dune-project
@@ -14,3 +14,10 @@
   (base (>= 0.13.0))
   (cohttp-lwt-unix (>= 4.0.0))
   (lwt_ssl (>= 1.1.3))))
+
+(package
+ (name mpdlb)
+ (synopsis "ListenBrainz listen submitter for MPD")
+ (license GPL-3)
+ (depends
+  (ocamllb (>= 0))))
diff --git a/mpdwatch/dune b/mpdwatch/dune
new file mode 100644
index 0000000..1a24b65
--- /dev/null
+++ b/mpdwatch/dune
@@ -0,0 +1,6 @@
+(library
+ (name mpdwatch)
+ (libraries
+   angstrom
+   angstrom-lwt-unix)
+ (preprocess (pps lwt_ppx)))
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"
diff --git a/mpdwatch/parse.mli b/mpdwatch/parse.mli
new file mode 100644
index 0000000..6cd79dc
--- /dev/null
+++ b/mpdwatch/parse.mli
@@ -0,0 +1,16 @@
+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
+
+val parse_string : 'a Angstrom.t -> string -> 'a
+
+val currentsong_parser : currentsong Angstrom.t
-- 
cgit v1.2.3