rework on tuple non resident object with schematics as protocol

2 files changed, 35 insertions, 38 deletions

diff --git a/lib/protocols/Schematics.ml b/lib/protocols/Schematics.ml
index b0297e7..d2e50ad 100644
--- a/lib/protocols/Schematics.ml
+++ b/lib/protocols/Schematics.ml
@@ -1,30 +1,24 @@
-module type S = sig
-  module Schema : Abstract.Schematics.SCHEMA
-  type t
+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}
 
-  class type implementation = object
-    method schema : (Schema.t, Concepts.Condition.condition) result
-  end
+(* 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
 
-  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
+class type implementation = object
+  method describe : unit -> (description, 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 Handle.protocol += Schematics of implementation
-  type t = 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
+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
index d8533bf..dc8f320 100644
--- a/lib/protocols/Schematics.mli
+++ b/lib/protocols/Schematics.mli
@@ -1,18 +1,21 @@
-(** Instantiate once and share the protocol with schema providers and evaluators. *)
-module type S = sig
-  module Schema : Abstract.Schematics.SCHEMA
-  type t
+type t
 
-  class type implementation = object
-    method schema : (Schema.t, Concepts.Condition.condition) result
-  end
+(* 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}
 
-  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
+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
 
-module Make (Schema : Abstract.Schematics.SCHEMA) : S with module Schema = Schema
+val make : #implementation -> Handle.protocol
+val from : Handle.t -> t Handle.interface option
+val describe : t Handle.interface -> (description, Concepts.Condition.condition) result