Source file parser.ml

(*****************************************************************************)
(*                                                                           *)
(*  Copyright (C) 2026 Yves Ndiaye                                           *)
(*                                                                           *)
(* This Source Code Form is subject to the terms of the Mozilla Public       *)
(* License, v. 2.0. If a copy of the MPL was not distributed with this       *)
(* file, You can obtain one at https://mozilla.org/MPL/2.0/.                 *)
(*                                                                           *)
(*****************************************************************************)

open Angstrom

let is_digit = function '0' .. '9' -> true | _ -> false
let number = map ~f:int_of_string (take_while1 is_digit)
let number64 = map ~f:Int64.of_string (take_while1 is_digit)
let number = choice [ number; map ~f:( ~- ) @@ (char '-' *> number) ]
let number64 = choice [ number64; map ~f:Int64.neg @@ (char '-' *> number64) ]
let whitespace next = skip_while (function ' ' -> true | _ -> false) *> next
let sexp_escape_char = Util.sexp_escape_char

let length =
  choice
    [
      map2 number (char ':' *> number) ~f:(fun min sec -> (min * 60) + sec);
      number;
    ]

let string_sexp f =
  let scanner_quoted state =
    let parser =
      scan_state (state, String.empty) (fun (state, buffer) c ->
          match state with
          | `Escaped ->
              (* Horrendous but can not use buffer. *)
              let buffer = Printf.sprintf "%s%c" buffer c in
              Some (`Unscaped, buffer)
          | `Unscaped -> (
              match c with
              | '\\' ->
                  Some (`Escaped, buffer)
              | '"' ->
                  None
              | _ ->
                  let buffer = Printf.sprintf "%s%c" buffer c in
                  Some (state, buffer)
            )
      )
    in
    map ~f:(fun (_, buffer) -> buffer) parser
  in
  let p =
    choice
      [
        char '"' *> scanner_quoted `Unscaped <* char '"';
        Angstrom.take_while (fun c -> not (List.mem c sexp_escape_char));
      ]
  in
  map p ~f

let string_all k = map (take_while (Fun.const true)) ~f:k

let sfield_choice ~pstring p i f =
  p *> char ':'
  *> choice
       [
         (* [true] for regex, i for case sensibility. *)
         char ':' *> pstring (fun s -> f true i s);
         pstring (fun s -> f false i s);
       ]

let sfield_cs ~pstring name f =
  let name = Printf.sprintf "%%%s" name in
  sfield_choice ~pstring (string name) false f

let sfield_ci ~pstring name f = sfield_choice ~pstring (string name) true f

let sfield ~pstring name f =
  choice [ sfield_cs ~pstring name f; sfield_ci ~pstring name f ]

let string_field ~pstring =
  choice
    [
      sfield ~pstring Keys.title Field.String.title;
      sfield ~pstring Keys.sort_name Field.String.sort_name;
      sfield ~pstring Keys.artist Field.String.artist;
      sfield ~pstring Keys.album Field.String.album;
      sfield ~pstring Keys.album_artist Field.String.album_artist;
      sfield ~pstring Keys.composer Field.String.composer;
      sfield ~pstring Keys.genre Field.String.genre;
      sfield ~pstring Keys.path Field.String.path;
      sfield ~pstring Keys.extension Field.String.extension;
    ]

(** Bool *)

let bfield name f =
  string name *> char ':'
  *> choice
       [
         map (string_ci "true") ~f:(fun _ -> f true);
         map (string_ci "false") ~f:(fun _ -> f false);
         map number ~f:(fun n -> f (n <> 0));
       ]

let flag = bfield Keys.flag Field.Bool.flag
let art = bfield Keys.art Field.Bool.art
let bool_field = choice [ art; flag ]

(* Int *)

let range parser =
  let oparser = option None (map ~f:Option.some parser) in
  map2 oparser (string ".." *> oparser) ~f:Range.range

let field_range name parser k =
  string name *> char ':'
  *> map ~f:k (choice [ range parser; map parser ~f:Range.value ])

let int_field =
  choice
    [
      field_range Keys.id number64 Field.Int.id;
      field_range Keys.size number64 Field.Int.size;
      field_range Keys.track number Field.Int.track;
      field_range Keys.year number Field.Int.year;
      field_range Keys.disc number Field.Int.disc;
      field_range Keys.plays number Field.Int.plays;
      field_range Keys.length length Field.Int.length;
      field_range Keys.rating number Field.Int.rating;
      field_range Keys.album_count number Field.Int.album_count;
    ]

(* Float *)

let field ~pstring =
  choice
    [
      map ~f:Field.string (string_field ~pstring);
      map ~f:Field.int int_field;
      map ~f:Field.bool bool_field;
    ]

let substring ~pstring = pstring Node.substring

let node ~pstring ~substr =
  choice [ map ~f:Node.field (field ~pstring); substring ~pstring:substr ]

let node_cli = node ~pstring:string_all ~substr:string_all
let node_sexp = node ~pstring:string_sexp ~substr:string_sexp