Source file format.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/.                 *)
(*                                                                           *)
(*****************************************************************************)

module Node = struct
  type t =
    | Text of string
    | String of Field.String.Key.t
    | Bool of Field.Bool.Key.t
    | Int64 of Field.Int64.Key.t
    | Int of Field.Int.Key.t
    | Float of Field.Float.Key.t

  let conv = function
    | `String s ->
        String s
    | `Bool s ->
        Bool s
    | `Int64 s ->
        Int64 s
    | `Int s ->
        Int s
    | `Float s ->
        Float s

  let to_string = function
    | Text s ->
        s
    | String s ->
        Field.String.Key.to_string s
    | Bool s ->
        Field.Bool.Key.to_string s
    | Int64 s ->
        Field.Int64.Key.to_string s
    | Int s ->
        Field.Int.Key.to_string s
    | Float s ->
        Field.Float.Key.to_string s

  let to_text = function
    | Text s ->
        s
    | String _ | Bool _ | Int64 _ | Int _ | Float _ ->
        String.empty

  let equal lhs rhs =
    match (lhs, rhs) with
    | Text lhs, Text rhs ->
        String.equal lhs rhs
    | String l, String r ->
        Field.String.Key.equal l r
    | Bool l, Bool r ->
        Field.Bool.Key.equal l r
    | Int64 l, Int64 r ->
        Field.Int64.Key.equal l r
    | Int l, Int r ->
        Field.Int.Key.equal l r
    | Float l, Float r ->
        Field.Float.Key.equal l r
    | _, _ ->
        false

  let substitute m node =
    match
      List.find_map
        (fun (key, value) ->
          if equal key node then
            Some value
          else
            None
        )
        m
    with
    | None ->
        node
    | Some txt ->
        Text txt
end

type t = Node.t list

let of_string s =
  let rec flatten buffer = function
    | [] ->
        let s = Buffer.contents buffer in
        if s = String.empty then
          []
        else
          Node.Text s :: []
    | `Char c :: q ->
        let () = Buffer.add_char buffer c in
        flatten buffer q
    | `String s :: q ->
        let () = Buffer.add_string buffer s in
        flatten buffer q
    | `Field f :: q ->
        let f = Node.conv f in
        let s = Buffer.contents buffer in
        if s = String.empty then
          f :: flatten buffer q
        else
          let () = Buffer.clear buffer in
          Node.Text s :: f :: flatten buffer q
  in
  let r =
    match Angstrom.parse_string ~consume:All Parser.parser_format_string s with
    | Ok s ->
        s
    | Error _ ->
        [ `String s ]
  in
  flatten (Buffer.create 18) r

let map f s = List.map f s
let to_string s = s |> List.map Node.to_string |> String.concat String.empty
let to_text s = s |> List.map Node.to_text |> String.concat String.empty
let equal lhs rhs = List.equal Node.equal lhs rhs
let substitute m nodes = List.map (Node.substitute m) nodes
let to_list = Fun.id
let of_list = Fun.id