ocaml-init / src / init.ml

(*---------------------------------------------------------------------------
   Copyright (c) 2025 Anil Madhavapeddy <[e-mail]>. All rights reserved.
   SPDX-License-Identifier: ISC
  ---------------------------------------------------------------------------*)

(** Declarative INI data manipulation for OCaml.

    Init provides bidirectional codecs for INI files following Python's
    configparser semantics. *)

type 'a fmt = Format.formatter -> 'a -> unit

(* ---- Text Locations ---- *)

module Textloc = struct
  type fpath = string
  let file_none = "-"

  type byte_pos = int
  let byte_pos_none = -1

  type line_num = int
  let line_num_none = -1

  type line_pos = line_num * byte_pos
  let line_pos_first = (1, 0)
  let line_pos_none = (line_num_none, byte_pos_none)

  type t = {
    file : fpath;
    first_byte : byte_pos;
    last_byte : byte_pos;
    first_line : line_pos;
    last_line : line_pos;
  }

  let none = {
    file = file_none;
    first_byte = byte_pos_none;
    last_byte = byte_pos_none;
    first_line = line_pos_none;
    last_line = line_pos_none;
  }

  let make ~file ~first_byte ~last_byte ~first_line ~last_line =
    { file; first_byte; last_byte; first_line; last_line }

  let file t = t.file
  let set_file t file = { t with file }
  let first_byte t = t.first_byte
  let last_byte t = t.last_byte
  let first_line t = t.first_line
  let last_line t = t.last_line

  let is_none t = t.first_byte < 0
  let is_empty t = t.first_byte > t.last_byte

  let equal t0 t1 =
    String.equal t0.file t1.file &&
    t0.first_byte = t1.first_byte &&
    t0.last_byte = t1.last_byte

  let compare t0 t1 =
    let c = String.compare t0.file t1.file in
    if c <> 0 then c else
    let c = Int.compare t0.first_byte t1.first_byte in
    if c <> 0 then c else
    Int.compare t0.last_byte t1.last_byte

  let set_first t ~first_byte ~first_line =
    { t with first_byte; first_line }

  let set_last t ~last_byte ~last_line =
    { t with last_byte; last_line }

  let to_first t =
    { t with last_byte = t.first_byte; last_line = t.first_line }

  let to_last t =
    { t with first_byte = t.last_byte; first_line = t.last_line }

  let before t =
    { t with last_byte = t.first_byte - 1; last_line = t.first_line }

  let after t =
    { t with first_byte = t.last_byte + 1; first_line = t.last_line }

  let span t0 t1 =
    let first_byte, first_line, last_byte, last_line, file =
      if t0.first_byte <= t1.first_byte then
        if t0.last_byte >= t1.last_byte then
          t0.first_byte, t0.first_line, t0.last_byte, t0.last_line, t0.file
        else
          t0.first_byte, t0.first_line, t1.last_byte, t1.last_line, t1.file
      else
        if t1.last_byte >= t0.last_byte then
          t1.first_byte, t1.first_line, t1.last_byte, t1.last_line, t1.file
        else
          t1.first_byte, t1.first_line, t0.last_byte, t0.last_line, t0.file
    in
    { file; first_byte; last_byte; first_line; last_line }

  let reloc ~first ~last =
    { file = last.file;
      first_byte = first.first_byte;
      first_line = first.first_line;
      last_byte = last.last_byte;
      last_line = last.last_line }

  let pp_ocaml ppf t =
    let l, c = t.first_line in
    let el, ec = t.last_line in
    if is_none t then Format.fprintf ppf "%s" t.file
    else if is_empty t then
      Format.fprintf ppf "%s:%d:%d" t.file l (t.first_byte - c)
    else if l = el then
      Format.fprintf ppf "%s:%d:%d-%d" t.file l (t.first_byte - c) (t.last_byte - ec)
    else
      Format.fprintf ppf "%s:%d:%d-%d:%d" t.file l (t.first_byte - c) el (t.last_byte - ec)

  let pp_gnu ppf t =
    let l, c = t.first_line in
    if is_none t then Format.fprintf ppf "%s" t.file
    else Format.fprintf ppf "%s:%d.%d" t.file l (t.first_byte - c + 1)

  let pp = pp_ocaml

  let pp_dump ppf t =
    Format.fprintf ppf "@[<h>{file=%S;@ first_byte=%d;@ last_byte=%d;@ \
                        first_line=(%d,%d);@ last_line=(%d,%d)}@]"
      t.file t.first_byte t.last_byte
      (fst t.first_line) (snd t.first_line)
      (fst t.last_line) (snd t.last_line)
end

(* ---- Metadata ---- *)

module Meta = struct
  type t = {
    textloc : Textloc.t;
    ws_before : string;
    ws_after : string;
    comment : string option;  (* Associated comment *)
  }

  let none = {
    textloc = Textloc.none;
    ws_before = "";
    ws_after = "";
    comment = None;
  }

  let make ?(ws_before = "") ?(ws_after = "") ?comment textloc =
    { textloc; ws_before; ws_after; comment }

  let is_none t = Textloc.is_none t.textloc
  let textloc t = t.textloc
  let ws_before t = t.ws_before
  let ws_after t = t.ws_after
  let comment t = t.comment

  let with_textloc t textloc = { t with textloc }
  let with_ws_before t ws_before = { t with ws_before }
  let with_ws_after t ws_after = { t with ws_after }
  let with_comment t comment = { t with comment }

  let clear_ws t = { t with ws_before = ""; ws_after = "" }
  let clear_textloc t = { t with textloc = Textloc.none }

  let copy_ws src ~dst =
    { dst with ws_before = src.ws_before; ws_after = src.ws_after }
end

type 'a node = 'a * Meta.t

(* ---- Paths ---- *)

module Path = struct
  type index =
    | Section of string node
    | Option of string node

  let pp_index ppf = function
    | Section (s, _) -> Format.fprintf ppf "[%s]" s
    | Option (s, _) -> Format.fprintf ppf "%s" s

  type t = index list  (* Reversed *)

  let root = []
  let is_root = function [] -> true | _ -> false

  let section ?(meta = Meta.none) name path = Section (name, meta) :: path
  let option ?(meta = Meta.none) name path = Option (name, meta) :: path

  let rev_indices t = t

  let pp ppf t =
    let rec loop = function
      | [] -> ()
      | [i] -> pp_index ppf i
      | i :: rest -> loop rest; Format.fprintf ppf "/"; pp_index ppf i
    in
    loop (List.rev t)
end

(* ---- Errors ---- *)

module Error = struct
  type kind =
    | Parse of string
    | Codec of string
    | Missing_section of string
    | Missing_option of { section : string; option : string }
    | Duplicate_section of string
    | Duplicate_option of { section : string; option : string }
    | Type_mismatch of { expected : string; got : string }
    | Interpolation of { option : string; reason : string }
    | Unknown_option of string
    | Unknown_section of string

  type t = {
    kind : kind;
    meta : Meta.t;
    path : Path.t;
  }

  let make ?(meta = Meta.none) ?(path = Path.root) kind =
    { kind; meta; path }

  let kind e = e.kind
  let meta e = e.meta
  let path e = e.path

  exception Error of t

  let raise ?meta ?path kind = raise (Error (make ?meta ?path kind))

  let kind_to_string = function
    | Parse msg -> Printf.sprintf "parse error: %s" msg
    | Codec msg -> Printf.sprintf "codec error: %s" msg
    | Missing_section name -> Printf.sprintf "missing section: [%s]" name
    | Missing_option { section; option } ->
        Printf.sprintf "missing option '%s' in section [%s]" option section
    | Duplicate_section name -> Printf.sprintf "duplicate section: [%s]" name
    | Duplicate_option { section; option } ->
        Printf.sprintf "duplicate option '%s' in section [%s]" option section
    | Type_mismatch { expected; got } ->
        Printf.sprintf "type mismatch: expected %s, got %s" expected got
    | Interpolation { option; reason } ->
        Printf.sprintf "interpolation error in '%s': %s" option reason
    | Unknown_option name -> Printf.sprintf "unknown option: %s" name
    | Unknown_section name -> Printf.sprintf "unknown section: [%s]" name

  let to_string e =
    let loc = if Meta.is_none e.meta then "" else
      Format.asprintf "%a: " Textloc.pp (Meta.textloc e.meta)
    in
    let path = if Path.is_root e.path then "" else
      Format.asprintf " at %a" Path.pp e.path
    in
    Printf.sprintf "%s%s%s" loc (kind_to_string e.kind) path

  let pp ppf e = Format.pp_print_string ppf (to_string e)
end

(* ---- Codec Types ---- *)

(* Internal representation for codec implementations *)
module Repr = struct
  (* A decoded INI value with metadata *)
  type ini_value = {
    raw : string;           (* Raw string value *)
    interpolated : string;  (* After interpolation *)
    meta : Meta.t;
  }

  (* A section's options *)
  type ini_section = {
    name : string node;
    options : (string node * ini_value) list;
    meta : Meta.t;  (* Section header metadata *)
  }

  (* A full INI document *)
  type ini_doc = {
    defaults : (string node * ini_value) list;
    sections : ini_section list;
    meta : Meta.t;  (* Document metadata *)
  }

  (* Codec error during decode/encode *)
  type 'a codec_result = ('a, Error.t) result

  (* Section decoder state *)
  type 'dec section_state = {
    decode : ini_section -> 'dec codec_result;
    encode : 'dec -> ini_section;
    known_options : string list;
    unknown_handler : [ `Skip | `Error | `Keep ];
  }

  (* Document decoder state *)
  type 'dec document_state = {
    decode : ini_doc -> 'dec codec_result;
    encode : 'dec -> ini_doc;
    known_sections : string list;
    unknown_handler : [ `Skip | `Error ];
  }
end

(* The abstract codec type *)
type 'a t = {
  kind : string;
  doc : string;
  (* Value-level decode/encode (for individual option values) *)
  dec : Repr.ini_value -> ('a, Error.t) result;
  enc : 'a -> Meta.t -> Repr.ini_value;
  (* Section-level decode/encode (for Section.finish) *)
  section : 'a Repr.section_state option;
  (* Document-level decode/encode (for Document.finish) *)
  document : 'a Repr.document_state option;
}

let kind c = c.kind
let doc c = c.doc

let with_doc ?kind:k ?doc:d c =
  { c with
    kind = Option.value ~default:c.kind k;
    doc = Option.value ~default:c.doc d }

let section_state c = c.section
let document_state c = c.document

(* ---- Base Codecs ---- *)

let make_value_codec ~kind ~doc ~dec ~enc = {
  kind; doc; dec; enc;
  section = None;
  document = None;
}

let string = make_value_codec
  ~kind:"string"
  ~doc:""
  ~dec:(fun v -> Ok v.Repr.interpolated)
  ~enc:(fun s meta -> { Repr.raw = s; interpolated = s; meta })

let int = make_value_codec
  ~kind:"integer"
  ~doc:""
  ~dec:(fun v ->
    match int_of_string_opt v.Repr.interpolated with
    | Some i -> Ok i
    | None -> Error (Error.make (Type_mismatch {
        expected = "integer"; got = v.interpolated })))
  ~enc:(fun i meta ->
    let s = Int.to_string i in
    { Repr.raw = s; interpolated = s; meta })

let int32 = make_value_codec
  ~kind:"int32"
  ~doc:""
  ~dec:(fun v ->
    match Int32.of_string_opt v.Repr.interpolated with
    | Some i -> Ok i
    | None -> Error (Error.make (Type_mismatch {
        expected = "int32"; got = v.interpolated })))
  ~enc:(fun i meta ->
    let s = Int32.to_string i in
    { Repr.raw = s; interpolated = s; meta })

let int64 = make_value_codec
  ~kind:"int64"
  ~doc:""
  ~dec:(fun v ->
    match Int64.of_string_opt v.Repr.interpolated with
    | Some i -> Ok i
    | None -> Error (Error.make (Type_mismatch {
        expected = "int64"; got = v.interpolated })))
  ~enc:(fun i meta ->
    let s = Int64.to_string i in
    { Repr.raw = s; interpolated = s; meta })

let float = make_value_codec
  ~kind:"float"
  ~doc:""
  ~dec:(fun v ->
    match float_of_string_opt v.Repr.interpolated with
    | Some f -> Ok f
    | None -> Error (Error.make (Type_mismatch {
        expected = "float"; got = v.interpolated })))
  ~enc:(fun f meta ->
    let s = Float.to_string f in
    { Repr.raw = s; interpolated = s; meta })

(* Python configparser-compatible boolean parsing *)
let parse_bool s =
  match String.lowercase_ascii s with
  | "1" | "yes" | "true" | "on" -> Some true
  | "0" | "no" | "false" | "off" -> Some false
  | _ -> None

let bool = make_value_codec
  ~kind:"boolean"
  ~doc:"Accepts: 1/yes/true/on (true), 0/no/false/off (false)"
  ~dec:(fun v ->
    match parse_bool v.Repr.interpolated with
    | Some b -> Ok b
    | None -> Error (Error.make (Type_mismatch {
        expected = "boolean (yes/no/true/false/on/off/1/0)";
        got = v.interpolated })))
  ~enc:(fun b meta ->
    let s = if b then "true" else "false" in
    { Repr.raw = s; interpolated = s; meta })

let bool_01 = make_value_codec
  ~kind:"boolean (0/1)"
  ~doc:""
  ~dec:(fun v ->
    match v.Repr.interpolated with
    | "1" -> Ok true
    | "0" -> Ok false
    | s -> Error (Error.make (Type_mismatch { expected = "0 or 1"; got = s })))
  ~enc:(fun b meta ->
    let s = if b then "1" else "0" in
    { Repr.raw = s; interpolated = s; meta })

let bool_yesno = make_value_codec
  ~kind:"boolean (yes/no)"
  ~doc:""
  ~dec:(fun v ->
    match String.lowercase_ascii v.Repr.interpolated with
    | "yes" -> Ok true
    | "no" -> Ok false
    | s -> Error (Error.make (Type_mismatch { expected = "yes or no"; got = s })))
  ~enc:(fun b meta ->
    let s = if b then "yes" else "no" in
    { Repr.raw = s; interpolated = s; meta })

let bool_truefalse = make_value_codec
  ~kind:"boolean (true/false)"
  ~doc:""
  ~dec:(fun v ->
    match String.lowercase_ascii v.Repr.interpolated with
    | "true" -> Ok true
    | "false" -> Ok false
    | s -> Error (Error.make (Type_mismatch {
        expected = "true or false"; got = s })))
  ~enc:(fun b meta ->
    let s = if b then "true" else "false" in
    { Repr.raw = s; interpolated = s; meta })

let bool_onoff = make_value_codec
  ~kind:"boolean (on/off)"
  ~doc:""
  ~dec:(fun v ->
    match String.lowercase_ascii v.Repr.interpolated with
    | "on" -> Ok true
    | "off" -> Ok false
    | s -> Error (Error.make (Type_mismatch { expected = "on or off"; got = s })))
  ~enc:(fun b meta ->
    let s = if b then "on" else "off" in
    { Repr.raw = s; interpolated = s; meta })

(* ---- Combinators ---- *)

let map ?kind:k ?doc:d ~dec ~enc c =
  let kind = Option.value ~default:c.kind k in
  let doc = Option.value ~default:c.doc d in
  { kind; doc;
    dec = (fun v -> Result.map dec (c.dec v));
    enc = (fun x meta -> c.enc (enc x) meta);
    section = None;
    document = None;
  }

let enum ?cmp ?kind ?doc assoc =
  let cmp = Option.value ~default:Stdlib.compare cmp in
  let kind = Option.value ~default:"enum" kind in
  let doc = Option.value ~default:"" doc in
  let lc_assoc = List.map (fun (k, v) -> (String.lowercase_ascii k, v)) assoc in
  let rev_assoc = List.map (fun (s, v) -> (v, s)) assoc in
  make_value_codec ~kind ~doc
    ~dec:(fun v ->
      match List.assoc_opt (String.lowercase_ascii v.Repr.interpolated) lc_assoc with
      | Some x -> Ok x
      | None -> Error (Error.make (Type_mismatch {
          expected = kind; got = v.interpolated })))
    ~enc:(fun x meta ->
      match List.find_opt (fun (v', _) -> cmp x v' = 0) rev_assoc with
      | Some (_, s) -> { Repr.raw = s; interpolated = s; meta }
      | None -> failwith "enum value not in association list")

let option ?kind ?doc c =
  let kind = Option.value ~default:("optional " ^ c.kind) kind in
  let doc = Option.value ~default:c.doc doc in
  { kind; doc;
    dec = (fun v ->
      if v.Repr.interpolated = "" then Ok None
      else Result.map Option.some (c.dec v));
    enc = (function
      | Some x -> c.enc x
      | None -> fun meta -> { Repr.raw = ""; interpolated = ""; meta });
    section = None;
    document = None;
  }

let default def c = {
  c with
  dec = (fun v -> Ok (Result.value ~default:def (c.dec v)));
}

let list ?(sep = ',') c = {
  kind = "list of " ^ c.kind;
  doc = "";
  dec = (fun v ->
    if v.Repr.interpolated = "" then Ok []
    else
      let parts = String.split_on_char sep v.Repr.interpolated in
      let parts = List.map String.trim parts in
      let rec decode_all acc = function
        | [] -> Ok (List.rev acc)
        | part :: rest ->
            let pv = { v with Repr.raw = part; interpolated = part } in
            match c.dec pv with
            | Ok x -> decode_all (x :: acc) rest
            | Error e -> Error e
      in
      decode_all [] parts);
  enc = (fun xs meta ->
    let parts = List.map (fun x -> (c.enc x meta).Repr.interpolated) xs in
    let s = String.concat (String.make 1 sep ^ " ") parts in
    { Repr.raw = s; interpolated = s; meta });
  section = None;
  document = None;
}

(* ---- Result helpers ---- *)

module Result_syntax = struct
  let ( let* ) = Result.bind
end

(* ---- Section Codecs ---- *)

module Section = struct
  type 'a codec = 'a t

  type ('o, 'dec) map = {
    kind : string;
    doc : string;
    decode : Repr.ini_section -> 'dec Repr.codec_result;
    encode : 'o -> Repr.ini_section;
    known : string list;
    unknown : [ `Skip | `Error | `Keep ];
  }

  let obj ?kind ?doc (f : 'dec) : ('o, 'dec) map =
    let kind = Option.value ~default:"section" kind in
    let doc = Option.value ~default:"" doc in
    {
      kind; doc;
      decode = (fun _ -> Ok f);
      encode = (fun _ -> {
        Repr.name = ("", Meta.none);
        options = [];
        meta = Meta.none;
      });
      known = [];
      unknown = `Skip;
    }

  let mem ?doc:_ ?dec_absent ?enc ?enc_omit name (c : 'a codec)
      (m : ('o, 'a -> 'dec) map) : ('o, 'dec) map =
    let open Result_syntax in
    let lc_name = String.lowercase_ascii name in
    {
      m with
      known = lc_name :: m.known;
      decode = (fun sec ->
        let opt = List.find_opt (fun ((n, _), _) ->
          String.lowercase_ascii n = lc_name) sec.Repr.options in
        let decoded = match opt with
          | Some (_, v) -> c.dec v
          | None ->
              Option.to_result
                ~none:(Error.make (Missing_option { section = fst sec.name; option = name }))
                dec_absent
        in
        let* a = decoded in
        let* f = m.decode sec in
        Ok (f a));
      encode = (fun o ->
        let sec = m.encode o in
        match enc with
        | None -> sec
        | Some enc_fn ->
            let v = enc_fn o in
            let should_omit = Option.fold ~none:false ~some:(fun f -> f v) enc_omit in
            if should_omit then sec
            else
              let iv = c.enc v Meta.none in
              { sec with options = ((name, Meta.none), iv) :: sec.options });
    }

  let opt_mem ?doc ?enc name c m =
    let opt_c = option c in
    let enc' = Option.map (fun f o -> f o) enc in
    mem ?doc ~dec_absent:None ?enc:enc' ~enc_omit:Option.is_none name opt_c m

  let skip_unknown m = { m with unknown = `Skip }
  let error_unknown m = { m with unknown = `Error }

  let keep_unknown ?enc (m : ('o, (string * string) list -> 'dec) map)
      : ('o, 'dec) map =
    {
      kind = m.kind;
      doc = m.doc;
      known = m.known;
      unknown = `Keep;
      decode = (fun sec ->
        let unknown_opts = List.filter_map (fun ((n, _), v) ->
          let lc_n = String.lowercase_ascii n in
          if List.mem lc_n m.known then None
          else Some (n, v.Repr.interpolated)
        ) sec.Repr.options in
        m.decode sec |> Result.map (fun f -> f unknown_opts));
      encode = (fun o ->
        let sec = m.encode o in
        match enc with
        | None -> sec
        | Some enc_fn ->
            let new_opts = List.map (fun (k, v) ->
              ((k, Meta.none), { Repr.raw = v; interpolated = v; meta = Meta.none })
            ) (enc_fn o) in
            { sec with options = new_opts @ sec.options });
    }

  let finish (m : ('o, 'o) map) : 'o codec =
    let section_state : 'o Repr.section_state = {
      decode = (fun sec ->
        (* Check for unknown options *)
        (match m.unknown with
        | `Skip -> ()
        | `Keep -> ()
        | `Error ->
            List.iter (fun ((n, _), _) ->
              let lc_n = String.lowercase_ascii n in
              if not (List.mem lc_n m.known) then
                Error.raise (Unknown_option n)
            ) sec.Repr.options);
        m.decode sec);
      encode = (fun o ->
        let sec = m.encode o in
        { sec with options = List.rev sec.options });
      known_options = m.known;
      unknown_handler = m.unknown;
    } in
    {
      kind = m.kind;
      doc = m.doc;
      dec = (fun _ -> Error (Error.make (Codec "section codec requires section-level decode")));
      enc = (fun _ _ -> { Repr.raw = ""; interpolated = ""; meta = Meta.none });
      section = Some section_state;
      document = None;
    }
end

(* ---- Document Codecs ---- *)

module Document = struct
  type 'a codec = 'a t

  type ('o, 'dec) map = {
    kind : string;
    doc : string;
    decode : Repr.ini_doc -> 'dec Repr.codec_result;
    encode : 'o -> Repr.ini_doc;
    known : string list;
    unknown : [ `Skip | `Error ];
  }

  let obj ?kind ?doc (f : 'dec) : ('o, 'dec) map =
    let kind = Option.value ~default:"document" kind in
    let doc = Option.value ~default:"" doc in
    {
      kind; doc;
      decode = (fun _ -> Ok f);
      encode = (fun _ -> {
        Repr.defaults = [];
        sections = [];
        meta = Meta.none;
      });
      known = [];
      unknown = `Skip;
    }

  let get_section_state sec_codec fn_name =
    match sec_codec.section with
    | Some s -> s
    | None -> failwith (fn_name ^ ": codec must be a section codec")

  let section ?doc:_ ?enc name (sec_codec : 'a codec)
      (m : ('o, 'a -> 'dec) map) : ('o, 'dec) map =
    let open Result_syntax in
    let sec_state = get_section_state sec_codec "section" in
    let lc_name = String.lowercase_ascii name in
    {
      m with
      known = lc_name :: m.known;
      decode = (fun doc ->
        let sec = List.find_opt (fun s ->
          String.lowercase_ascii (fst s.Repr.name) = lc_name) doc.Repr.sections in
        let* sec = Option.to_result ~none:(Error.make (Missing_section name)) sec in
        let* a = sec_state.decode sec in
        let* f = m.decode doc in
        Ok (f a));
      encode = (fun o ->
        let doc = m.encode o in
        match enc with
        | None -> doc
        | Some enc_fn ->
            let sec = sec_state.encode (enc_fn o) in
            { doc with sections = { sec with name = (name, Meta.none) } :: doc.sections });
    }

  let opt_section ?doc:_ ?enc name (sec_codec : 'a codec)
      (m : ('o, 'a option -> 'dec) map) : ('o, 'dec) map =
    let open Result_syntax in
    let sec_state = get_section_state sec_codec "opt_section" in
    let lc_name = String.lowercase_ascii name in
    {
      m with
      known = lc_name :: m.known;
      decode = (fun doc ->
        let sec = List.find_opt (fun s ->
          String.lowercase_ascii (fst s.Repr.name) = lc_name) doc.Repr.sections in
        let* value = match sec with
          | None -> Ok None
          | Some sec ->
              let* a = sec_state.decode sec in
              Ok (Some a)
        in
        let* f = m.decode doc in
        Ok (f value));
      encode = (fun o ->
        let doc = m.encode o in
        match enc with
        | None -> doc
        | Some enc_fn ->
            match enc_fn o with
            | None -> doc
            | Some v ->
                let sec = sec_state.encode v in
                { doc with sections = { sec with name = (name, Meta.none) } :: doc.sections });
    }

  let defaults ?doc:_ ?enc (sec_codec : 'a codec)
      (m : ('o, 'a -> 'dec) map) : ('o, 'dec) map =
    let open Result_syntax in
    let sec_state = get_section_state sec_codec "defaults" in
    {
      m with
      known = "default" :: m.known;
      decode = (fun doc ->
        let fake_sec = {
          Repr.name = ("DEFAULT", Meta.none);
          options = doc.defaults;
          meta = Meta.none;
        } in
        let* a = sec_state.decode fake_sec in
        let* f = m.decode doc in
        Ok (f a));
      encode = (fun o ->
        let doc = m.encode o in
        match enc with
        | None -> doc
        | Some enc_fn ->
            let v = enc_fn o in
            let sec = sec_state.encode v in
            { doc with defaults = sec.options });
    }

  let opt_defaults ?doc:_ ?enc (sec_codec : 'a codec)
      (m : ('o, 'a option -> 'dec) map) : ('o, 'dec) map =
    let open Result_syntax in
    let sec_state = get_section_state sec_codec "opt_defaults" in
    {
      m with
      known = "default" :: m.known;
      decode = (fun doc ->
        let* value =
          if doc.Repr.defaults = [] then Ok None
          else
            let fake_sec = {
              Repr.name = ("DEFAULT", Meta.none);
              options = doc.defaults;
              meta = Meta.none;
            } in
            let* a = sec_state.decode fake_sec in
            Ok (Some a)
        in
        let* f = m.decode doc in
        Ok (f value));
      encode = (fun o ->
        let doc = m.encode o in
        match enc with
        | None -> doc
        | Some enc_fn ->
            match enc_fn o with
            | None -> doc
            | Some v ->
                let sec = sec_state.encode v in
                { doc with defaults = sec.options });
    }

  let skip_unknown m = { m with unknown = `Skip }
  let error_unknown m = { m with unknown = `Error }

  let finish (m : ('o, 'o) map) : 'o codec =
    let document_state : 'o Repr.document_state = {
      decode = (fun doc ->
        (* Check for unknown sections *)
        (match m.unknown with
        | `Skip -> ()
        | `Error ->
            List.iter (fun sec ->
              let lc_n = String.lowercase_ascii (fst sec.Repr.name) in
              if not (List.mem lc_n m.known) then
                Error.raise (Unknown_section (fst sec.name))
            ) doc.Repr.sections);
        m.decode doc);
      encode = (fun o ->
        let doc = m.encode o in
        { doc with sections = List.rev doc.sections });
      known_sections = m.known;
      unknown_handler = m.unknown;
    } in
    {
      kind = m.kind;
      doc = m.doc;
      dec = (fun _ -> Error (Error.make (Codec "document codec requires document-level decode")));
      enc = (fun _ _ -> { Repr.raw = ""; interpolated = ""; meta = Meta.none });
      section = None;
      document = Some document_state;
    }
end