aboutsummaryrefslogtreecommitdiffstats
path: root/lib/protocols/Schematics.ml
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/protocols/Schematics.ml24
-rw-r--r--lib/protocols/Schematics.mli21
2 files changed, 45 insertions, 0 deletions
diff --git a/lib/protocols/Schematics.ml b/lib/protocols/Schematics.ml
new file mode 100644
index 0000000..d2e50ad
--- /dev/null
+++ b/lib/protocols/Schematics.ml
@@ -0,0 +1,24 @@
+type multigroup_description = string BatMap.String.t
+type relation_description = string BatMap.String.t
+type tuple_description = {relation: relation_description; attributes: string BatMap.String.t}
+
+(* TODO: For now the description is completely detached from actual
+ types and domains. Later figure out a way to represent the links
+ without strings. *)
+type description =
+ | Multigroup of multigroup_description
+ | Relation of relation_description
+ | Tuple of tuple_description
+
+class type implementation = object
+ method describe : unit -> (description, 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 describe impl = Handle.invoke impl (fun o -> o#describe ())
diff --git a/lib/protocols/Schematics.mli b/lib/protocols/Schematics.mli
new file mode 100644
index 0000000..dc8f320
--- /dev/null
+++ b/lib/protocols/Schematics.mli
@@ -0,0 +1,21 @@
+type t
+
+(* TODO: For now the description is completely detached from actual
+ types and domains. Later figure out a way to represent the links
+ without strings. *)
+type multigroup_description = string BatMap.String.t
+type relation_description = string BatMap.String.t
+type tuple_description = {relation: relation_description; attributes: string BatMap.String.t}
+
+type description =
+ | Multigroup of multigroup_description
+ | Relation of relation_description
+ | Tuple of tuple_description
+
+class type implementation = object
+ method describe : unit -> (description, Concepts.Condition.condition) result
+end
+
+val make : #implementation -> Handle.protocol
+val from : Handle.t -> t Handle.interface option
+val describe : t Handle.interface -> (description, Concepts.Condition.condition) result