Dans un développement logiciel récent, j'ai un type représentant
des documents, ces derniers étant "évalués" vers du XML (du XHTML plus précisément).
Cette évaluation nécessite un contexte, par exemple pour la numérotation
des numéros de sections. Enfin, l'évaluation n'est pas faite d'un seul
coup, mais en plusieurs étapes: le serveur évalue tout ce qu'il peut
pour obtenir un document XML avec des "trous" qu'il envoie au client.
Puis il envoie les morceaux manquants quand il sont prêts. De son côté, le client
peut changer des paramètres (via un formulaire) dans un morceau du document et
demander sa réévaluation avec ces nouveaux paramètres.
Et là, c'est le drame. Il faut un moyen au serveur de connaître
le contexte à utiliser pour évaluer ce morceau de document.
En fait, rien de compliqué, il suffit de passer par une représentation
du contexte en string, pour que le client le renvoie au
serveur1.
Là où ça se complique, c'est que ces informations de contexte
sont extensibles. Le type représentant les document est un
type variant
ouvert, auquel on peut ajouter des constructeurs.
Cela permet d'enrichir la représentation des documents, pourvu
qu'on donne une traduction vers XML.
Ces fonctions de traduction nécessitent (éventuellement) des
informations de contexte, ce dernier doit donc naturellement pouvoir
être enrichi lui aussi.
Enfin, comme il s'agit de développer un cadriciel, on aura la possibilité
d'ajouter des représentations de documents (et donc des valeurs au contexte)
par greffons ou bien en compilant ou pas certains modules.
On a donc en gros et de façon très simplifiée quelque chose comme:
type doc = .. val doc_to_xml_ref : (doc -> ctx -> ctx * xml) ref val doc_to_xml : doc -> ctx -> ctx * xml
Le type doc étant extensible, lorsqu'on lui ajoutera un constructeur,
on modifiera la fonction doc_to_xml_ref pour traiter ce constructeur,
et appeler l'ancienne fonction pour les autres constructeurs.
Bref, ce qui nous intéresse ici est le type ctx représentant le
contexte d'évaluation des documents, documents évidemment récursifs; le
contexte est donc passé (et parfois modifié) récursivement lors de cette
évaluation.
Une solution simple serait de définir le contexte comme un map de
string vers string, les clés et les valeurs étant
forcément des string, et éventuellemen parser les valeurs
si elles contiennent une information un minimum structurée.
Mais nous sommes ici en OCaml, pas en Perl ou PHP. Nous avons un vrai système
de types, alors profitons-en.
Pour définir ce type ctx, l'idée est d'utiliser la même technique
que pour la représentation des documents, à savoir deux types extensibles,
l'un pour les clés, l'autre pour les valeurs associées dans un map:
module type Ctx = sig type key = .. type value = .. type ctx val empty : ctx val get : ctx -> key -> value option val set : ctx -> key -> value -> ctx end;; module C : Ctx = struct type key = .. type value = .. module M = Map.Make (struct type t = key let compare = Stdlib.compare end) type ctx = value M.t let empty = M.empty let get ctx k = try Some (M.find k ctx) with Not_found -> None let set ctx k v = M.add k v ctx end;;
Nous nous contentons d'utiliser la fonction Pervasives.compare
pour avoir un ordre sur le type des clés. Nous pourrions aussi définir
notre propre fonction, mais il faudrait pouvoir l'enrichir lorsque de
nouveaux constructeurs sont ajoutés, ce qui compliquerait les choses et
à priori Pervasives.compare suffira.
Nous pouvons maintenant nous servir de notre structure pour définir
un nouveau constructeur de clés et un nouveau constructeur de valeurs:
type C.key += Section_path ;; type C.value += Path of int list ;;
Ensuite, get et set permettent de récupérer ou ajouter
une association clé/valeur dans le contexte:
# let ctx = C.set C.empty Section_path (Path [1 ; 2 ; 1]) ;; val ctx : C.ctx = <abstr> # match C.get ctx Section_path with Some (Path path) -> path | _ -> assert false;; - : int list = [1; 2; 1]
Bien sûr, la définition de nouveaux constructeurs peut être faite dans des
modules où se restreint leur utilisation, dans notre cas ce serait dans le
même module qui enrichit le type doc et qui utilise des associations
clés/valeurs du contexte pour l'évaluation vers du XML.
Il est même possible (c'est ce que je fais dans le code en question) de paramétrer
ces modules par les modules définissant le type doc et le type ctx.
Cela donne quelque chose de la forme:
module My_ctx (D: Doc) (C : Ctx) = struct type D.doc += ... (* constructeurs supplementaires *) type C.key += Mon_option type C.value += Int of int let doc_to_xml doc ctx = ... end
Comme dit plus haut, j'ai également besoin d'une représentation du contexte sous forme
de string, pour passer au client qui la redonnera au serveur lors d'une
demande d'évaluation d'un morceau de document.
Pour cela, j'ajoute deux fonctions to_string et of_string à la signature
Ctx, et j'utilise l'extension de syntaxe
ppx_deriving_yojson,
permettant
de générer les fonctions de lecture et écriture en JSON de n'importe quel type de données
OCaml:
module type Ctx = sig type key = .. [@@deriving yojson] type value = .. [@@deriving yojson] type ctx val empty : ctx val get : ctx -> key -> value option val set : ctx -> key -> value -> ctx val to_string : ctx -> string val of_string : string -> ctx end =
Pour les types extensibles, le code généré fournit deux fonctions
(..._of_yojson et ..._to_yojson) qui échouent
mais surtout il fournit également de quoi étendre ces fonctions pour traiter les nouveaux
constructeurs2.
Mon implémentation du contexte devient alors la suivante. Je dois définir un
type assoc_list annoté par [@@deriving yojson] pour obtenir
des fonctions de (dé)sérialisation d'une liste de paires (key, value),
car l'extension ppx_deriving_yojson ne gère pas encore les maps. Pour obtenir
une représentation de mon contexte en string, je transforme donc
le map en liste de paires et j'utilise le code généré par l'extension pour
obtenir une chaîne (contenant une représentation JSON). Pour la lecture
depuis une chaîne, les opérations inverses sont effectuées: lecture du JSON
puis appel de la fonction transformant ce JSON en liste de paires et reconstruction
du map. Si la chaîne est syntaxiquement incorrecte ou que le JSON ne correspond
pas à mon type de données, je retourne un contexte vide3:
module C : Ctx = struct type key = .. [@@deriving yojson] type value = .. [@@deriving yojson] type assoc_list = (key * value) list [@@deriving yojson] module M = Map.Make (struct type t = key let compare = Pervasives.compare end) type ctx = value M.t let empty = M.empty let get ctx k = try Some (M.find k ctx) with Not_found -> None let set ctx k v = M.add k v ctx let map_to_list = let f = M.fold (fun k v acc -> (k, v) :: acc) in fun map -> f map [] let map_of_list = List.fold_left (fun map (k,v) -> M.add k v map) empty let to_string ctx = Yojson.Safe.to_string (assoc_list_to_yojson (map_to_list ctx)) let of_string str = match assoc_list_of_yojson (Yojson.Safe.from_string str) with | exception _ -> empty | `Ok map -> map_of_list map | `Error _ -> empty end
Dans les modules où les types key et value sont enrichis par
de nouveaux constructeurs, il suffit d'ajouter [@@deriving yojson]
pour que la (dé)sérialisation de ces nouveaux constructeurs soit utilisable
par les fonctions assoc_list_to_yojson et assoc_list_of_yojson
ci-dessus (générées par l'extension ppx):
module My_ctx (D: Doc) (C : Ctx) = struct ... type C.key += Mon_option [@@deriving yojson] type C.value += Int of int [@@deriving yojson] ... end
Il serait sans doute possible d'utiliser une autre extension permettant la
génération des fonctions de (dé)sérialisation. Cependant, je n'ai pas pris le temps
de regarder lesquelles supportent les types extensibles (j'ai dû ajouter le support
des types extensibles à ppx_deriving_yojson, il n'y était pas au départ).
Comme je compte utiliser la sérialisation JSON dans le reste de l'application,
ça me va tout à fait.
Si d'aventure des problèmes de performace apparaissaient
à cause de cette sérialisation, et qu'une autre extension offrait les mêmes
possibilités dans un autre format, il me suffirait de changer d'extension et les
fonctions qui y font appel dans ma définition de Ctx,
tout le reste ne changeant pas.