Source file Syn.ml

(*
 * SPDX-FileCopyrightText: 2024 The Forester Project Contributors
 *
 * SPDX-License-Identifier: GPL-3.0-or-later
 *)

open Base
open Forester_xml_names

type node =
  | Text of string
  | Verbatim of string
  | Group of delim * t
  | Math of math_mode * t
  | Link of {dest: t; title: t option}
  | Subtree of string option * t
  | Fun of string binding list * t
  | Var of string
  | Sym of Symbol.t
  | Put of t * t * t
  | Default of t * t * t
  | Get of t
  | Xml_tag of xml_qname * (xml_qname * t) list * t
  | TeX_cs of TeX_cs.t
  | Unresolved_ident of ((resolver_data, Range.t option) Trie.t [@opaque]) * Trie.path
  | Prim of Prim.t
  | Object of {self: string option; methods: (string * t) list}
  | Patch of {obj: t; self: string option; super: string option; methods: (string * t) list}
  | Call of t * string
  | Results_of_query
  | Transclude
  | Embed_tex
  | Ref
  | Title
  | Parent
  | Taxon
  | Meta
  | Attribution of Types.attribution_role * [`Content | `Uri]
  | Tag of [`Content | `Uri]
  | Date
  | Number
  | Dx_sequent of t * t list
  | Dx_query of string * t list * t list
  | Dx_prop of t * t list
  | Dx_var of string
  | Dx_const of [`Content | `Uri] * t
  | Dx_execute
  | Route_asset
  | Syndicate_query_as_json_blob
  | Syndicate_current_tree_as_atom_feed
  | Current_tree
[@@deriving show]

and t = node Range.located list
[@@deriving show]

and resolver_data =
  | Term of t
  | Xmlns of {xmlns: string; prefix: string}
[@@deriving show]

let map f node =
  match node with
  | Group (d, t) -> Group (d, f @@ t)
  | Math (m, t) -> Math (m, f @@ t)
  | Subtree (a, t) -> Subtree (a, f @@ t)
  | Link {dest; title} -> Link {dest = f @@ dest; title = Option.map f title}
  | Fun (b, t) -> Fun (b, f t)
  | Put (r, s, t) -> Put (f r, f s, f t)
  | Default (r, s, t) -> Default (f r, f s, f t)
  | Get t -> Get (f t)
  | Xml_tag (q, qs, t) -> Xml_tag (q, List.map (fun (q, t) -> q, f t) qs, f t)
  | Call (t, s) -> Call (f t, s)
  | Object {self; methods} ->
    Object {self; methods = List.map (fun (str, t) -> str, f t) methods}
  | Patch {obj; self; super; methods} ->
    Patch {obj = f obj; self; super; methods = List.map (fun (str, t) -> str, f t) methods}
  | Dx_sequent (t, ts) -> Dx_sequent (f t, List.map f ts)
  | Dx_query (s, ps, ns) -> Dx_query (s, List.map f ps, List.map f ns)
  | Dx_const (s, n) -> Dx_const (s, f n)
  | Dx_prop (t, ts) -> Dx_prop (f t, List.map f ts)
  | Text _
  | Verbatim _
  | Var _
  | Sym _
  | TeX_cs _
  | Unresolved_ident _
  | Prim _
  | Results_of_query
  | Transclude
  | Embed_tex
  | Ref
  | Title
  | Parent
  | Taxon
  | Meta
  | Attribution (_, _)
  | Tag _
  | Date
  | Number
  | Dx_var _
  | Dx_execute
  | Route_asset
  | Syndicate_current_tree_as_atom_feed
  | Syndicate_query_as_json_blob
  | Current_tree ->
    node

let children (node : node Range.located) =
  match node.value with
  | Group (_, t) -> t
  | Math (_, t) -> t
  | Subtree (_, t) -> t
  | Link {dest; title} -> Option.fold ~some: (fun t -> t @ dest) ~none: dest title
  | Fun (_, t) -> t
  | Put (r, s, t) -> r @ s @ t
  | Default (r, s, t) -> r @ s @ t
  | Get t -> t
  | Xml_tag (_, qs, t) -> List.concat_map snd qs @ t
  | Call (t, _) -> t
  | Object {methods; _} ->
    List.concat_map snd methods
  | Patch {obj; methods; _} ->
    List.concat_map snd methods @
      obj
  | Dx_sequent (t, ts) -> t @ List.concat ts
  | Dx_query (_, ps, ns) -> List.concat ps @ List.concat ns
  | Dx_const (_, n) -> n
  | Dx_prop (t, ts) -> t @ List.concat ts
  | Text _
  | Verbatim _
  | Var _
  | Sym _
  | TeX_cs _
  | Unresolved_ident _
  | Prim _
  | Results_of_query
  | Transclude
  | Embed_tex
  | Ref
  | Title
  | Parent
  | Taxon
  | Meta
  | Attribution (_, _)
  | Tag _
  | Date
  | Number
  | Dx_var _
  | Dx_execute
  | Route_asset
  | Syndicate_current_tree_as_atom_feed
  | Syndicate_query_as_json_blob
  | Current_tree ->
    []