path: root/mpdwatch/parse.ml

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"