lib/protocols/Schematics.ml


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
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