I have some module type Foo like below. I have multiple implementations of this module type and want to group them in a Map or Hashtbl based on a key. The key is a string and same string means same module.
This is the code
module type Foo = sig
type t
val make : t
val do_it : t -> t
end
module A : Foo = struct
type t = int
let make = 1
let do_it t = t + 1
end
module B : Foo = struct
type t = string
let make = "a"
let do_it t = t ^ t
end
type 'a x = (module Foo with type t = 'a)
type bound = B: 'a x * 'a -> bound
The constraint that I want to put into a type is that for a key I’ll always save the same module implementation. So something like this (this is obviously not working pseudocode):
type map = ???
let map = ????
let update map key data =
Map.update map key ~f:(function
| None -> [data]
| Some x -> data :: x
)
let do_something map key =
Map.find map key
|> Option.map ~f:(fun ((module X), x) -> X.do_it x)
|> ignore
I’ve been trying to work something out with GADTs but I don’t know how to link the key with the specific modules.
Any idea how to solve this? The Map or Hashtbl are not real requirements if it’s possible to solve it in an other way. So the only real requirement is that I need a function like update and do_something
Thanks
If you want to enforce that every element in the map share the same type, that can be done with a slight modification of the bound type:
type bound = B: 'a x * 'a list -> bound
If you end up with a lot of similar type, you may want to define a functor for defining those.
If you wanted to have map, with a type key:string -> map -> f(key), this is impossible because the type of the result cannot depend on the value of the key parameter.
However, if you are fine with a type: 'a key -> map -> 'a, where the key is bound to a given type, this is possible and is generally called an hmap. There are various implementation availalble on opam. For instalce, hmap.
The key trick for defining those hmap is to use extensible variant types as a collection of keys:
type _ keys = ..
module type key = sig
type t
type _ keys += Key: t keys
end
We can use a first-class module to pack everything at the value level
type 'a key = (module key with type t = 'a)
let new_key (type a) (): a key =
(module struct type t = a type _ keys += Key: a keys end)
Then, we can use pattern matching to recognize a specific key and its associated type:
type bound = B: 'a keys * 'a -> bound
let extract (type a) ((module K): a key) (B(k,x)) =
match k with
| K.Key -> Some (x:a)
| _ -> None;
Note that you might need to customize the keys of data, but that is not that hard, once the trick known.
2 Likes
Thanks, that seems to bring me a lot closer to the solution, but it seems I’m still missing something:
module type Foo = sig
type t
val make : t
val do_it : t -> t
end
module A : Foo = struct
type t = int
let make = 1
let do_it t = t + 1
end
module B : Foo = struct
type t = string
let make = "a"
let do_it t = t ^ "a"
end
type 'a x = (module Foo with type t = 'a)
type bound = B : ('a x * 'a) list -> bound
let key_a = Hmap.Key.create ()
let key_b = Hmap.Key.create ()
let map = Hmap.empty
let map = Hmap.add key_a (B [ ((module A), A.make) ]) map
let map = Hmap.add key_b (B [ ((module B), B.make) ]) map
let () =
let _map = match Hmap.find key_a map with
| Some (B modules) ->
let x = B (((module A), A.make):: modules) in
Hmap.add key_a x map
| None ->
failwith "TODO"
in
()
This fails with:
43 | let x = B (((module A), A.make):: modules) in
^^^^^^^
Error: This expression has type ($B_'a x * $B_'a) list
but an expression was expected of type (A.t x * A.t) list
Type $B_'a x = (module Foo with type t = $B_'a)
is not compatible with type A.t x = (module Foo with type t = A.t)
Type $B_'a is not compatible with type A.t
It’s obvious that this can’t work because I could put anything in that list. But does this mean that I can’t update this list dynamically at runtime or am I just missing something?
I was more thinking of:
type 'a elt = Elt of 'a x * 'a
let key_a = Hmap.Key.create ()
let key_b = Hmap.Key.create ()
let map = Hmap.add key_a ([ Elt ((module A), A.make) ]) map
let map = Hmap.add key_b ([ Elt((module B), B.make) ]) map
let _ =
match Hmap.find key_a map with
| Some ( Elt ((module A),_) :: _ as modules) ->
let x = (Elt((module A), A.make)):: modules in
Hmap.add key_a x map
| None | Some [] ->
failwith "TODO"
since from your description I though that you wanted to have only one type of implementation by key.
In other words, the heterogeneous map is already hiding the type of the implementation from the outside, there is no need to hide it a second time with bound.
Note that the definition of elt is only here to avoid few module type annotation.
It seems I’m not explaining my problem well with my examples, sorry for that. I’ll try to start over with the actual problem instead of examples.
I’m trying to implement a library similar to Phoenix Channels (a websocket implementation for elixir https://hexdocs.pm/phoenix/channels.html). So when someone wants to use the library they have to implement 2 things:
- modules that implement some module type, concretely something like this:
module type Channel = sig
type t
type id
type reply = `Reply of string | `ToChannel of id * string
val make : t
val handle_in : t -> string -> reply * t
val filter: t -> id -> bool
end
and 2. a function get_channel: topic:string -> (module Channel)
So on the server you have multiple Channel implementations. For example a ChatChannel and GameChannel. When a browser connects to a websocket, they can join a channel. Joining a channel happens based on a topic (string), so you could do something like this in the browser: ws.join("chat") and then on the server a new Channel would be created with Channel.make and that would keep the state for that connection.
Incoming messages to the Channel are sent to handle_in. This returns a reply * t. If the reply is of type Reply it’s send directly to the browser, but if the reply is of type ToChannel. Each channel that is connected with the same topic:string should receive the message and that Channel can decide to filter it based on the id.
So it’s this last part that is giving me trouble. How to implement the filter functionality?
My library doesn’t know anything about the Channel implementations and I think we can constraint the requirement about string -> (module Channel) (because that mapping is known at compile time) to key -> (module Channel), but I’m still lost on how to implement this.
I hope I explained it a bit better this time and didn’t add to the confusion. Thanks a lot for the answers so far, I already learned a lot.
Does decoupling the implementation/protocol from the various channel instances work?
type ('a,'b) channel = (module Channel with type t = 'a and type id = 'b)
type ('a,'b) topic = {
protocol: ('a,'b) channel;
instances: 'a list
}
let filter (type a b)
{ protocol = ((module P): (a,b) channel) ; instances } id =
List.filter (fun i -> P.filter i id) instances
And you can store them in an ordinary map with just
type dyn_topic = Dyn: ('a,'b) topic -> ('a,'b) topic
Note that since Channel does not contain parametric type constructors, it might be lighter to use a record of function:
type ('a,'b) reply = [ `Reply of string | `ToChannel of id * string ]
type ('t,'id) channel = {
make : 't;
handle_in : 't -> string -> ('t,'id) reply * 't;
filter: 't -> id -> bool
}
I’m not sure that this fixes the issue completely.
So when a web browser sends a message, it goes to a specific channel. That specific channel sends a reply. When that reply is ToChannel I want to send the id * string to the filter function.
The problem is that I can’t seem to find a way to say the type of module that returned this reply is the same type as the one for this topic, because they don’t come from the same place.
But I think I have an idea on how to fix that.
I’m going to try to find some time today or tomorrow to test that out and come back here to let you know if it worked.