I am trying to implement something like OOP observable pattern in OCaml with using first-class modules. I have a project with a list of modules and want to extend them with observation without changing. To minimize code duplication I created Subject module and plan to use it as a part of the common way (in the project context) for this extending. I declared three module types:
OBSERVER:
module type OBSERVER = sig
type event
type t
val send : event -> t -> t
end
OBSERVABLE:
module type OBSERVABLE = sig
type event
type subscr
type t
module type OBSERVER = OBSERVER with type event = event
val subscribe : (module OBSERVER with type t = 't) -> 't -> t -> (subscr * t)
val unsubscribe : subscr -> t -> t
end
and SUBJECT that is merging of OBSERVER and OBSERVABLE:
module type SUBJECT = sig
include OBSERVER
include OBSERVABLE
with type event := event
and type t := t
end
The next thing that I implemented is Subject module. The responsibility of this module is to aggregate many OBSERVERs into one. Of course, they should process the same event type and that's why I implemented "Subject" (Subject.Make) as a functor.
module Subject = struct
module Make (Event : sig type t end) : sig
include SUBJECT with type event = Event.t
val empty : t
end = struct
type event = Event.t
module type OBSERVER = OBSERVER with type event = event
...
To store instances of OBSERVER's first-class modules with the ability to add and remove (in any order) them I use Map with int as key (which is subscr).
...
type subscr = int
module SMap = Map.Make (Int)
...
As we can see from send signature in OBSERVER (val send : event -> t -> t) it isn't only necessary to store instances of OBSERVER's first-class modules but also states of them (instances of "OBSERVER.t"). I can't store all states in one collection because of different types. So I declared module type PACK to pack instance of OBSERVER's first-class module and instance of its state together in the instance of PACK.
...
module type PACK = sig
module Observer : OBSERVER
val state : Observer.t
end
type t =
{ next_subscr : subscr;
observers : (module PACK) SMap.t
}
let empty =
{ next_subscr = 0;
observers = SMap.empty
}
let subscribe (type t)
(module Obs : OBSERVER with type t = t) init o =
o.next_subscr,
{ next_subscr = succ o.next_subscr;
observers = o.observers |> SMap.add
o.next_subscr
( module struct
module Observer = Obs
let state = init
end : PACK
)
}
let unsubscribe subscription o =
{ o with
observers = o.observers |> SMap.remove subscription
}
...
Function send of Subject repacks each pack within new state and within old Observer module.
...
let send event o =
let send (module Pack : PACK) =
( module struct
module Observer = Pack.Observer
let state = Observer.send event Pack.state
end : PACK
) in
{ o with
observers = SMap.map send o.observers
}
end
end
To test Subject and to see how module extending with observation without changes will look - I created some module Acc
module Acc : sig
type t
val zero : t
val add : int -> t -> t
val multiply : int -> t -> t
val value : t -> int
end = struct
type t = int
let zero = 0
let add x o = o + x
let multiply x o = o * x
let value o = o
end
And extended it with observation functionality in module OAcc with the following signature that is merging of OBSERVABLE and module type of original Acc
module OAcc : sig
type event = Add of int | Multiply of int
include module type of Acc
include OBSERVABLE with type event := event
and type t := t
end =
...
I implemented OAcc with the delegation of observation responsibility to Subject and main responsibility to original Acc.
...
struct
type event = Add of int | Multiply of int
module Subject = Subject.Make (struct type t = event end)
module type OBSERVER = Subject.OBSERVER
type subscr = Subject.subscr
type t =
{ subject : Subject.t;
acc : Acc.t
}
let zero =
{ subject = Subject.empty;
acc = Acc.zero
}
let add x o =
{ subject = Subject.send (Add x) o.subject;
acc = Acc.add x o.acc
}
let multiply x o =
{ subject = Subject.send (Multiply x) o.subject;
acc = Acc.multiply x o.acc
}
let value o = Acc.value o.acc
let subscribe (type t) (module Obs : Subject.OBSERVER with type t = t) init o =
let subscription, subject =
Subject.subscribe (module Obs) init o.subject in
subscription, { o with subject }
let unsubscribe subscription o =
{ o with subject = Subject.unsubscribe subscription o.subject
}
end
Created some "OBSERVER module" that just prints operations into the console
module Printer : sig
include OAcc.OBSERVER
val make : string -> t
end = struct
type event = OAcc.event
type t = string
let make prefix = prefix
let send event o =
let () =
[ o;
( match event with
| OAcc.Add x -> "Add(" ^ (string_of_int x)
| OAcc.Multiply x -> "Multiply(" ^ (string_of_int x)
);
");\n"
]
|> String.concat ""
|> print_string in
o
end
Finally, I created function print_operations and tested that all works as expected
let print_operations () =
let p = (module Printer : OAcc.OBSERVER with type t = Printer.t) in
let acc = OAcc.zero in
let s1, acc = acc |> OAcc.subscribe p (Printer.make "1.") in
let s2, acc = acc |> OAcc.subscribe p (Printer.make "2.") in
let s3, acc = acc |> OAcc.subscribe p (Printer.make "3.") in
acc |> OAcc.add 1
|> OAcc.multiply 2
|> OAcc.unsubscribe s2
|> OAcc.multiply 3
|> OAcc.add 4
|> OAcc.unsubscribe s3
|> OAcc.add 5
|> OAcc.unsubscribe s1
|> OAcc.multiply 6
|> OAcc.value
After calling print_operations ();; I have the following output
# print_operations ();;
1.Add(1);
2.Add(1);
3.Add(1);
1.Multiply(2);
2.Multiply(2);
3.Multiply(2);
1.Multiply(3);
3.Multiply(3);
1.Add(4);
3.Add(4);
1.Add(5);- : int = 90
All works fine in the case when the logic of our first-class module observer is totally based on side effects and we don't need state of it outside Subject. But for the opposite situation, I didn't found any solution on how to extract the state of subscribed observer from Subject.
For example, I have the following "OBSERVER" (In this case it more visitor then observer)
module History : sig
include OAcc.OBSERVER
val empty : t
val to_list : t -> event list
end = struct
type event = OAcc.event
type t = event list
let empty = []
let send event o = event :: o
let to_list = List.rev
end
I can subscribe the first-class instance of History and some initial state of it to OAcc but I don't know how to extract it back.
let history_of_operations () =
let h = (module History : OAcc.OBSERVER with type t = History.t) in
let acc = OAcc.zero in
let s, acc = acc |> OAcc.subscribe h History.empty in
let history : History.t =
acc |> OAcc.add 1
|> OAcc.multiply 2
|> failwith "implement extraction of History.t from OAcc.t" in
history
What I tried to do. I changed the signature of unsubscribe in OBSERVABLE. Before it returns the state of "OBSERVABLE" without "OBSERVER" associated with the provided subscription and now it returns triple of this state, unsubscribed first-class module, and state of the unsubscribed module.
before:
module type OBSERVABLE = sig
...
val unsubscribe : subscr -> t -> t
end
after:
module type OBSERVABLE = sig
...
val unsubscribe : subscr -> t -> (t * (module OBSERVER with type t = 't) * 't))
end
OBSERVABLE is compilable but I can't implement it. The following example shows one of my tries.
module Subject = struct
module Make (Event : sig type t end) : sig
...
end = struct
...
let unsubscribe subscription o =
let (module Pack : PACK) =
o.observers |> SMap.find subscription
and observers =
o.observers |> SMap.remove subscription in
{ o with observers },
(module Pack.Observer : OBSERVER),
Pack.state
...
end
end
As a result, I have:
Pack.state ^^^^^^^^^^Error: This expression has type Pack.Observer.t
but an expression was expected of type 'a
The type constructor Pack.Observer.t would escape its scope
Is it possible to implement unsubscribe with this signature?
It doesn't work. I tried another solution. It based on the idea that unsubscribe can return an instance of PACK's first-class module. I like the previous idea better because it keeps the declaration of PACK as private in Subject. But the current one provides better progress in solution-finding.
I added PACK module type into OBSERVABLE and changed unsubscribe signature to the following.
module type OBSERVABLE = sig
...
module type PACK = sig
module Observer : OBSERVER
val state : Observer.t
end
...
val unsubscribe : subscr -> t -> (t * (module PACK))
end
Added PACK into OAcc implementation because its signature includes OBSERVABLE. Also, I reimplemented unsubscribe of OAcc.
module OAcc : sig
...
end = struct
...
module type PACK = Subject.PACK
...
let unsubscribe subscription o =
let subject, ((module Pack : PACK) as p) =
Subject.unsubscribe subscription o.subject in
{ o with subject }, p
end
Implementation of Subject already contains PACK, so no need to add it. Only unsubscribe was reimplemented.
module Subject = struct
module Make (Event : sig type t end) : sig
...
end = struct
...
let unsubscribe subscription o =
let ((module Pack : PACK) as p) =
o.observers |> SMap.find subscription
and observers =
o.observers |> SMap.remove subscription in
{ o with observers }, p
...
end
end
Finally, I created I changed history_of_operations to test solution
let history_of_operations () =
let h = (module History : OAcc.OBSERVER with type t = History.t) in
let acc = OAcc.zero in
let s, acc = acc |> OAcc.subscribe h History.empty in
let acc, (module Pack : OAcc.PACK) =
acc
|> OAcc.add 1
|> OAcc.multiply 2
|> OAcc.unsubscribe s in
Pack.state ;;
After calling history_of_operations ();; I have the error
Pack.state ^^^^^^^^^^Error: This expression has type Pack.Observer.t
but an expression was expected of type 'a
The type constructor Pack.Observer.t would escape its scope
Also, I tried
let history_of_operations () =
...
History.to_list Pack.state
But
History.to_list Pack.state ^^^^^^^^^^Error: This expression has type Pack.Observer.t
but an expression was expected of type History.t
How to extract the state from Pack with type List.t?
I changed the signature of unsubscribe
module type OBSERVABLE = sig
...
val unsubscribe : subscr -> t -> (t * (module PACK with type Observer.t = 't))
end
And tried to reimplement unsubscribe in Subject
module Subject = struct
module Make (Event : sig type t end) : sig
...
end = struct
...
let unsubscribe (type t) subscription o =
let ((module Pack : PACK with type Observer.t = t) as p) =
o.observers |> SMap.find subscription
and observers =
o.observers |> SMap.remove subscription in
{ o with observers }, p
...
end
end
But
o.observers |> SMap.find subscription ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^Error: This expression has type (module PACK)
but an expression was expected of type
(module PACK with type Observer.t = t)
It looks like OCaml has 3 levels of types abstraction
1. Concrete module A : sig type t = int end = struct ...
2. Abstract module A : sig type t end = struct ...
3. Packed to first-class module
Is it possible to store nested type of instance of the first-class module with (2) level of abstraction or with the ability to restore it to (2) level of abstraction?
How to return the instance of first-class module's nested type from a function?
Of course, it is possible to solve this problem by mutable state using but the question isn't about.
The initial compilable source code here.
Disclaimer: I won't pretend that I fully understand your question, this is by far the largest OCaml-related question I have seen on SO. But my intuition tells me that you're looking for existentials.
In this approach we can pack an object interface together with its state in a single existential GADT. We will be able to use the state as long as it doesn't escape the scope of its definition, which will be the function that unpacks our existential. Sometimes, it is what we want, but we will extend this approach in the next section.
Let's start with some preliminary definitions, let's define the interface of the object that we would like to pack, e.g., something like this:
module type T = sig
type t
val int : int -> t
val add : t -> t -> t
val sub : t -> t -> t
val out : t -> unit
end
Now, we can pack this interface together with the state (a value of type t) in an existential
type obj = Object : {
intf : (module T with type t = 'a);
self : 'a
} -> obj
We can then easily unpack the interface and the state and apply any function from the interface to the state. Therefore, our type t is purely abstract, and indeed existential types are abstract types, e.g.,
module Int = struct
type t = int
let int x = x
let add = (+)
let sub = (-)
let out = print_int
end
let zero = Object {
intf = (module Int);
self = 0;
}
let incr (Object {intf=(module T); self}) = Object {
intf = (module T);
self = T.add self (T.int 1)
}
let out (Object {intf=(module T); self}) = T.out self
But what if would like to recover the original type of the abstract type so that we can apply other functions that are applicable to values of this type. For that we need to store a witness that the type x belongs to the desired type y, which we can do, employing extensible GADT,
type 'a witness = ..
To create new witnesses, we will employ first-class modules,
let newtype (type u) () =
let module Witness = struct
type t = u
type _ witness += Id : t witness
end in
(module Witness : Witness with type t = u)
where module type Witness and its packed types are,
module type Witness = sig
type t
type _ witness += Id : t witness
end
type 'a typeid = (module Witness with type t = 'a)
Every time newtype is called it adds a new constructor to the witness type that is guaranteed not to be equal to any other constructor. To prove that two witness are actually created with the same constructor we will use the following function,
let try_cast : type a b. a typeid -> b typeid -> (a,b) eq option =
fun x y ->
let module X : Witness with type t = a = (val x) in
let module Y : Witness with type t = b = (val y) in
match X.Id with
| Y.Id -> Some Equal
| _ -> None
which returns the equality proof that is defined as,
type ('a,'b) eq = Equal : ('a,'a) eq
In the environments in which we can construct an object of type (x,y) eq the typechecker will treat values of type x having the same type as y. Sometimes, when you are really sure that the cast must success, you can use, the cast function,
let cast x y = match try_cast x y with
| None -> failwith "Type error"
| Some Equal -> Equal
as,
let Equal = cast t1 t2 in
(* here we have proved that types witnessed by t1 and t2 are the same *)
Ok, now when we have the dynamic types, we can employ them to make our object types recoverable and state escapable. What we need, is just to add runtime information to our object representation,
type obj = Object : {
intf : (module T with type t = 'a);
self : 'a;
rtti : 'a typeid;
} -> obj
Now let's define the runtime representation for type int (note that in general we can put more information in rtti, other just the witness, we can also make it an oredered type and extend dynamic types in runtime with new operations, and implement ad hoc polymorphism),
let int : int typeid = newtype ()
So now our zero object is defined as,
let zero = Object {
intf = (module Int);
self = 0;
rtti = int;
}
The incr function is still the same (modulo an extra field in the object representation), since it doesn't require escaping. But now we can write the cast_object function that will take the desired type and cast object to it,
let cast_object (type a) (t : a typeid) (Object {self; rtti}) : a option =
match try_cast t rtti with
| Some Equal -> Some self
| None -> None
and
# cast_object int zero;;
- : int option = Some 0
# cast_object int (incr zero);;
- : int option = Some 1
Another example,
let print_if_int (Object {self; rtti}) =
match try_cast int rtti with
| Some Equal -> print_int self
| None -> ()
You can read more about dynamic types here. There are also many libraries in OCaml that provide dynamic types and heterogeneous dictionaries, and so on.