diff options
| author | Marcos Magueta <maguetamarcos@gmail.com> | 2026-09-09 21:14:29 -0300 |
|---|---|---|
| committer | Marcos Magueta <maguetamarcos@gmail.com> | 2026-09-11 01:07:39 -0300 |
| commit | f61e42262ce75179f356e122a5c63ed34e584082 (patch) | |
| tree | ca624bf1dd16873f27df9f257683df95685c2b0b | |
| parent | 3c17e2cb4d5b533ed3b2a55b673642a3c4b6bb01 (diff) | |
| download | RNT-f61e42262ce75179f356e122a5c63ed34e584082.tar.gz RNT-f61e42262ce75179f356e122a5c63ed34e584082.zip | |
schematics protocol
| -rw-r--r-- | lib/protocols/Schematics.ml | 30 | ||||
| -rw-r--r-- | lib/protocols/Schematics.mli | 18 |
2 files changed, 48 insertions, 0 deletions
diff --git a/lib/protocols/Schematics.ml b/lib/protocols/Schematics.ml new file mode 100644 index 0000000..b0297e7 --- /dev/null +++ b/lib/protocols/Schematics.ml @@ -0,0 +1,30 @@ +module type S = sig + module Schema : Abstract.Schematics.SCHEMA + type t + + class type implementation = object + method schema : (Schema.t, Concepts.Condition.condition) result + end + + val make : #implementation -> Handle.protocol + val from : Handle.t -> t Handle.interface option + val schema : t Handle.interface -> (Schema.t, Concepts.Condition.condition) result + val attributes : + t Handle.interface -> + ((string * Schema.attribute) BatFingerTree.t, Concepts.Condition.condition) result +end + +module Make (Schema : Abstract.Schematics.SCHEMA) = struct + module Schema = Schema + class type implementation = object + method schema : (Schema.t, Concepts.Condition.condition) result + end + + type Handle.protocol += Schematics of implementation + type t = implementation + + let make impl = Schematics (impl :> implementation) + let from handle = Handle.into handle (function Schematics impl -> Some impl | _ -> None) + let schema i = Handle.invoke i (fun o -> o#schema) + let attributes i = Result.map Schema.attributes (schema i) +end diff --git a/lib/protocols/Schematics.mli b/lib/protocols/Schematics.mli new file mode 100644 index 0000000..d8533bf --- /dev/null +++ b/lib/protocols/Schematics.mli @@ -0,0 +1,18 @@ +(** Instantiate once and share the protocol with schema providers and evaluators. *) +module type S = sig + module Schema : Abstract.Schematics.SCHEMA + type t + + class type implementation = object + method schema : (Schema.t, Concepts.Condition.condition) result + end + + val make : #implementation -> Handle.protocol + val from : Handle.t -> t Handle.interface option + val schema : t Handle.interface -> (Schema.t, Concepts.Condition.condition) result + val attributes : + t Handle.interface -> + ((string * Schema.attribute) BatFingerTree.t, Concepts.Condition.condition) result +end + +module Make (Schema : Abstract.Schematics.SCHEMA) : S with module Schema = Schema |