Mini jQuery

---------- Type du DOM (cours 4) ----------

// Un attribut : (nom, valeur) *)
type attr = string * string

// Un nœud DOM *)
type xml =
  | Text of string                     // Texte brut *)
  | Elem of string * attr list * xml list
                               // Tag, attributs, enfants *)

// Exemple : <div class="container">Bonjour</div> *)
let ex_div =
  Elem ("div",
        [("class", "container")],
        [Text "Bonjour"])

---------- Utilitaires DOM ----------

// Récupérer la valeur d'un attribut *)
let get_attr name attrs =
  List.find_opt (fun (k, _) -> k = name) attrs
  |> Option.map snd

// Test si un élément a une classe CSS *)
let has_class cls attrs =
  match get_attr "class" attrs with
  | None -> false
  | Some s  ->
      s |> String.split_on_char ' '
        |> List.mem cls

// Test si un élément a un id *)
let has_id id attrs =
  get_attr "id" attrs = Some id

// Récupérer le texte d'un sous-arbre (concaténation) *)
let rec text_content node =
  match node with
  | Text s    -> s
  | Elem (_, _, children) ->
      children |> List.map text_content |> String.concat ""

---------- Type d'un sélecteur ----------

type selector =
  | Tag of string               // "div" *)
  | Class of string             // ".active" *)
  | Id of string                 // "#main" *)
  | Desc of selector * selector  // "div p" (descendant) *)
  | AndS of selector * selector  // "div.active" (et) *)
  | Any                            // "*" (tout élément) *)

// Parseur de sélecteur CSS (mini) *)
let parse_selector s =
  let parts = String.split_on_char ' ' s in
  let parse_simple tok =
    if tok = "*" then Any
    else if tok.[0] = '.' then Class (String.sub tok 1 (String.length tok - 1))
    else if tok.[0] = '#' then Id (String.sub tok 1 (String.length tok - 1))
    else Tag tok
  in
  let compound tok =
    // Gère "div.active" → AndS(Tag "div", Class "active") *)
    let pieces =
      String.split_on_char '.' tok
      |> List.filter (fun p -> p <> "")
    in
    match pieces with
    | []      -> Any
    | [p]     -> parse_simple p
    | tag :: classes ->
        List.fold_left (fun acc cls ->
          AndS (acc, Class cls))
          (parse_simple tag) classes
  in
  match parts with
  | []      -> Any
  | [p]     -> compound p
  | first :: rest ->
      List.fold_left (fun acc p -> Desc (acc, compound p))
        (compound first) (List.tl parts)

---------- matching ----------

// Un élément correspond-il à un sélecteur ? *)
let rec matches sel node =
  match node with
  | Text _ -> false
  | Elem (tag, attrs, _) ->
    match sel with
    | Any           -> true
    | Tag t        -> tag = t
    | Class c      -> has_class c attrs
    | Id i        -> has_id i attrs
    | AndS (a, b) -> matches a node && matches b node
    | Desc (_, _)  -> false  // géré dans find *)

// $("div.active") en OCaml *)
let sel = AndS (Tag "div", Class "active")

// Avec parse_selector : *)
parse_selector "div.active"
(* = AndS (Tag "div", Class "active") *)

// $("main") en OCaml *)
parse_selector "#main"
(* = Id "main" *)

---------- Sélecteur descendant ----------

// Trouver les nœuds correspondant à un sélecteur dans l'arbre *)
let rec find sel node =
  match node with
  | Text _ -> []
  | Elem (_, _, children) ->
    let self = if matches sel node then [node] else [] in
    let deeper = children |> List.map (find sel) |> List.flatten in
    self @ deeper

// Gère Desc : d'abord trouver l'ancêtre, puis chercher le descendant *)
let rec find_sel sel node =
  match sel with
  | Desc (ancestor, descendant) ->
      // Trouver tous les nœuds qui matchent ancestor *)
      let ancestors = find_sel ancestor node in
      // Pour chaque ancêtre, chercher le descendant dans ses descendants *)
      ancestors |> List.map (fun a -> find_sel descendant a)
                |> List.flatten
  | _ -> find sel node

// Sélecteurs multiples : union des résultats *)
let find_all selectors node =
  selectors |> List.map (fun sel -> find_sel sel node)
            |> List.flatten
            |> dedup  // en pratique, éliminer les doublons *)

// Parser "$(\"div, p.active\")" *)
let parse_selectors s =
  s |> String.split_on_char ','
    |> List.map String.trim
    |> List.filter (fun p -> p <> "")
    |> List.map parse_selector

// Exemple : $(document, "h1, h2, h3") *)
let headings doc =
  find_all (parse_selectors "h1, h2, h3") doc

---------- Traversée ----------

// Obtenir les enfants directs d'un élément *)
let children node =
  match node with
  | Text _      -> []
  | Elem (_, _, cs) -> cs

// Obtenir le premier enfant *)
let first_child node =
  children node |> List.nth_opt 0

// Obtenir le dernier enfant *)
let last_child node =
  children node |> List.nth_opt (List.length (children node) - 1)

// Vérifier si un nœud a des enfants *)
let has_children node = children node <> []

// Pour trouver le parent, on a besoin d'une fonction qui *
// parcourt l'arbre en gardant la trace du parent *)
type parented_node = {
  node   : xml;
  parent : xml option;
}

// Parcourir l'arbre avec contexte parent *)
let rec walk parent node =
  { node; parent }
  :: (match node with
     | Text _ -> []
     | Elem (_, _, cs) ->
         cs |> List.map (walk (Some node)) |> List.flatten)

// Trouver le parent d'un nœud spécifique *)
let parent_of root target =
  walk None root |>
  List.find_opt (fun pn -> pn.node == target)
  |> Option.bind (fun pn -> pn.parent)

// Filtrer une liste de nœuds par un sélecteur *)
let filter_nodes sel nodes =
  List.filter (matches sel) nodes

// Chercher des descendants dans chaque nœud de la sélection *)
let find_in_all sel nodes =
  nodes |> List.map (find_sel sel) |> List.flatten

// Obtenir les frères (siblings) d'un nœud dans son parent *)
let siblings root target =
  match parent_of root target with
  | None -> []
  | Some (Elem (_, _, cs)) ->
      List.filter (fun c -> c != target) cs
  | Some (Text _) -> []

---------- Manipulation d'attributs ----------

// Ajouter un attribut (ou le remplacer s'il existe) *)
let set_attr name value attrs =
  let rec replace seen lst =
    match lst with
    | []                     -> List.rev ((name, value) :: seen)
    | (k, _) :: rest when k = name ->
        List.rev_append seen ((name, value) :: rest)
    | h :: rest            -> replace (h :: seen) rest
  in replace [] attrs

// Supprimer un attribut *)
let remove_attr name attrs =
  List.filter (fun (k, _) -> k <> name) attrs

// Ajouter une classe CSS (sans doublon) *)
let add_class cls attrs =
  match get_attr "class" attrs with
  | None -> set_attr "class" cls attrs
  | Some existing ->
      let classes = String.split_on_char ' ' existing in
      if List.mem cls classes then attrs
      else set_attr "class" (existing ^ " " ^ cls) attrs

// Retirer une classe CSS *)
let remove_class cls attrs =
  match get_attr "class" attrs with
  | None -> attrs
  | Some existing ->
      let classes =
        String.split_on_char ' ' existing
        |> List.filter (fun c -> c <> cls)
      in
      set_attr "class" (String.concat " " classes) attrs

// Appliquer une fonction de modification d'attributs à un nœud *)
let rec map_attrs f node =
  match node with
  | Text _ -> node
  | Elem (tag, attrs, cs) ->
      Elem (tag, f attrs, List.map (map_attrs f) cs)

// Exemple : ajouter "highlight" à tous les <div> *)
let highlight_divs doc =
  let divs = find_sel (Tag "div") doc in
  // En pratique : transformer l'arbre en marquant les divs *)
  // map_attrs applique à tous les nœuds, pas seulement aux divs *)
  map_attrs (fun attrs -> add_class "highlight" attrs) doc

---------- Manipulation du contenu ----------

// Remplacer le contenu textuel d'un élément *)
let rec set_text txt node =
  match node with
  | Text _      -> Text txt
  | Elem (tag, attrs, _) ->
      Elem (tag, attrs, [Text txt])

// Insérer du HTML parsé dans un élément *)
let set_html html_str node =
  match run xml_parser html_str with
  | None -> node
  | Some (parsed, _) ->
      match node with
      | Text _ -> parsed
      | Elem (tag, attrs, _) ->
          Elem (tag, attrs,
                (match parsed with
                 | Elem (_, _, cs) -> cs
                 | t               -> [t]))

// Ajouter un enfant à la fin *)
let append_child child node =
  match node with
  | Text s -> Elem ("span", [], [Text s; child])
  | Elem (tag, attrs, cs) ->
      Elem (tag, attrs, cs @ [child])

---------- Templates ----------

// Type d'un template (repris du cours 5) *)
type template =
  | Lit  of string
  | Hole of string
  | Cat  of template * template
  | Each of string * template
       // {{#items}} ... {{/items}} *)

// Parser un template avec boucles {{#items}}...{{/items}} *)
let rec parse_template s =
  // Version simplifiée : on utilise String.concat et *)
  // on passe le template au remplissage *)
  // Voir cours 5 pour une implémentation complète *)
  parse_template s

// Remplir un template avec des données (dict) *)
type dict = (string * string) list

let rec render data tmpl =
  match tmpl with
  | Lit s -> s
  | Hole k -> (try List.assoc k data with Not_found -> "")
  | Cat (a, b) -> render data a ^ render data b
  | Each (key, body) ->
      // En pratique : chercher key dans data, *)
      // split sur ',' et itérer *)
      ""  // à implémenter selon le format de données *)

// Générer du HTML à partir d'un template et d'une liste de données *)
let generate_list tmpl_str dataset =
  let tmpl = parse_template tmpl_str in
  dataset |> List.map (render tmpl) |> String.concat "\n"

// Exemple concret : générer une liste HTML *)
let items = [
  [("nom", "Alice"); ("age", "30")];
  [("nom", "Bob"); ("age", "25")];
]

let tmpl = "<li><strong>{{nom}}</strong> ({{age}} ans)</li>"

// generate_list tmpl items
// → "<li><strong>Alice</strong> (30 ans)</li>" *)
//   "<li><strong>Bob</strong> (25 ans)</li>" *)

---------- Pipeline DOM complet ----------

// 1. Charger une page HTML *)
let load_html content =
  match run xml_parser content with
  | None      -> failwith "Parse error"
  | Some (doc, _) -> doc

// 2. Sélectionner des éléments *)
let $ doc sel_str =
  parse_selectors sel_str |> find_all |> (fun f -> f doc)

// 3. Transformer les attributs *)
let add_class_to_all cls nodes =
  nodes |> List.map (fun (Elem (t, a, c)) ->
    Elem (t, add_class cls a, c)
  | n -> n)

// 4. Générer une nouvelle page à partir d'un template *)
let generate_report data template_file =
  let tmpl = parse_template template_file in
  String.concat "\n" (List.map (render data) tmpl)

// 5. Pipeline complet *)
let process_page html_input =
  html_input
  |> load_html             // Parse l'HTML *)
  |> fun doc -> $ doc "div.item"  // Sélectionne les div.item *)
  |> add_class_to_all "processed"  // Marque le traitement *)
  |> List.map text_content  // Extrait le texte *)
  |> String.concat "\n---\n"

---------- Exemple concret ----------

// Page HTML d'exemple *)
let page = {|
<div class="catalogue">
  <div class="item" data-prix="15">Livre A</div>
  <div class="item" data-prix="25">Livre B</div>
  <div class="item sold-out" data-prix="0">Livre C</div>
</div>|}

// Sélectionner tous les items non épuisés *)
let items =
  load_html page
  |> find_sel (AndS (Class "item",
                    Desc (Tag "div", Any)))
  // Trop complexe → utilisons plutôt filter_nodes *)

// Version simple : charger, trouver les div.item, *)
// filtrer ceux qui n'ont pas "sold-out" *)
let disponibles =
  let doc = load_html page in
  find_sel (Class "item") doc
  |> List.filter (fun n ->
       match n with
       | Elem (_, a, _) -> not (has_class "sold-out" a)
       | _ -> false)

// Afficher les textes des items disponibles *)
let _ = disponibles |> List.map text_content
(* = ["Livre A"; "Livre B"] *)