Friend Modules in OCaml

Question

I currently have two "layers" of modules that represent identifier-data relationships in a database.

The first layer defines identifier types, such as IdUser.t or IdPost.t while the second layer defines data types such as User.t or Post.t. I need all the modules of the first layer to be compiled before the modules of the second layer, because a Post.t must hold the IdUser.t of its author and the User.t holds the IdPost.t of the last five posts he visited.

Right now, IdUser.t provides functionality that should only ever be used by User.t, such as the ability to transform an IdUser.t into an IdUser.current: for security reasons, this transform must only ever be performed by the function User.check_password. Since IdUser and User are independent modules, I need to define those features as public functions and rely on conventions to avoid calling them anywhere outside of User, which is rather dirty. A symmetrical situation happens in IdPost.mine:

module IdUser : sig
  type t
  type current
  val current_of_t : t -> current (* <--- Should not be public! *)
end = struct 
  type t = string
  type current = string
  let current_of_t x = x
end

module IdPost : sig
  type t
  type mine
  val mine_of_t   : t -> mine (* <--- Should not be public! *)
end = struct 
  type t = string
  type mine = string
  let mine_of_t   x = x
end

module Post : sig 
 (* Should not "see" IdUser.current_of_t but needs IdPost.mine_of_t *)
  val is_mine : IdUser.current -> IdPost.t -> IdPost.mine
end 

module User : sig
  (* Should not "see" IdPost.mine_of_t but needs IdUser.current_of_t *)
  val check_password : IdUser.t -> password:string -> IdUser.current
end

Is there a way of defining an current_of_t : t -> current function in IdUser that can only be called from within module User ?

EDIT: this was a simplified example of one pair of modules, but there's an obvious solution for a single pair that cannot be generalized to multiple pairs and I need to solve this for multiple pairs — about 18 pairs, actually... So, I've extended it to be an example of two pairs.

Answer 1

So IdUser is in reality an existential type: For User there exists a type IdUser.current such that the public IdUser.t can be lifted to it. There are a couple of ways to encode this: either functorize User as Gasche shows if statically managing the dependence is sufficient, or use first-class modules or objects if you need more dynamism.

I'll work out Gasche's example a bit more, using private type abbreviations for convenience and to show how to leverage translucency to avoid privatizing implementation types too much. First, and this might be a limitation, I want to declare an ADT of persistent IDs:

(* File id.ml *)
module type ID = sig
  type t
  type current = private t
end

module type PERSISTENT_ID = sig
  include ID
  val persist : t -> current
end

With this I can define the type of Posts using concrete types for the IDs but with ADTs to enforce the business rules relating to persistence:

(* File post.ml *)
module Post
  (UID : ID with type t = string)
  (PID : PERSISTENT_ID with type t = int)
: sig 
  val is_mine : UID.current -> PID.t -> PID.current
end = struct
  let is_mine uid pid =
    if (uid : UID.current :> UID.t) = "me" && pid = 0
      then PID.persist pid
      else failwith "is_mine"
end

The same thing with Users:

(* File user.ml *)
module User
  (UID : PERSISTENT_ID with type t = string)
: sig
  val check_password : UID.t -> password:string -> UID.current
end = struct
  let check_password uid ~password =
    if uid = "scott" && password = "tiger"
      then UID.persist uid
      else failwith "check_password"
end

Note that in both cases I make use of the concrete but private ID types. Tying all together is a simple matter of actually defining the ID ADTs with their persistence rules:

module IdUser = struct 
  type t = string
  type current = string
  let persist x = x
end

module IdPost = struct 
  type t = int
  type current = int
  let persist x = x
end

module MyUser = User (IdUser)
module MyPost = Post (IdUser) (IdPost)

At this point and to fully decouple the dependencies you will probably need signatures for USER and POST that can be exported from this module, but it's a simple matter of adding them in.

Answer 2

One way that seems to work at least on your simplified example is to group IdUser and User inside a same module:

module UserAndFriends : sig ... end = struct
 module IdUser : sig
  ...
 end = struct
  ...
 end

 module User = struct
   ...
 end
end

module Post : sig 
  val create : (* <--- Should not "see" IdUser.current_of_t *)
    author:IdUser.current -> title:string -> body:string -> IdPost.t
end

Hiding the dangerous function(s) in the signature of UserAndFriends gives the result you desire. If you do not want to make a big file containing both IdUser and User, you can use option -pack of ocamlc to create UserAndFriends. Note that in this case, you must craft your Makefile carefully so that the .cmi files of IdUser and User are not visible when compiling Post. I am not the Makefile specialist for Frama-C, but I think we use separate directories and position the compiler option -I carefully.

Answer 3

I suggest you parametrize Post (and possibly User for consistency) by a signature for the IdUser module : you would use a signature with current_of_t for User, and one without for Post.

This guarantee that Post doesn't use IdUser private features, but the public interface of IdUser is still too permissive. But with this setup, you have reversed the dependencies, and IdUser (the sensitive part) can control its use directly, give itself (with the private part) to IdUser and restrict the public signature to the public parts.

module type PrivateIdUser = sig
  val secret : unit
end

module type PublicIdUser = sig
end

module type UserSig = sig
  (* ... *)
end
module MakeUser (IdUser : PrivateIdUser) : UserSig = struct
  (* ... *)
end

module IdUser : sig
  include PublicIdUser
  module User : UserSig
end
 = struct
   module IdUser = struct
     let secret = ()
   end
   module User = MakeUser(IdUser)
   include IdUser
end

module Post = struct
  (* ... *)
end

Edit : Pascal Cuoq's concurrent -- in the temporal sense -- solution is alos very nice. Actually it's simpler and has less boilerplate. My solution adds an abstraction that allows for slightly more modularity, as you can define User independently of IdUser.

I think which solution is best probably depends on the specific application. If you have a lot of different modules that use PrivateIdUser private information, then using functors to write them separately instead of bundling everyone in the same module can be a good idea. If only User needs to be in the "private zone" and it's not very big, then Pascal's solution is a better choice.

Finally, while being forced to explicit Private and Public interfaces can be seen as an additional burden, it is also a way to make the access properties of different modules more explicit that using the position inside the module hierarchy.

Answer 4

It's possible to achieve fine-grained control over signatures with a combination of recursive modules, first-class modules and GADTs, but the limitation would be that all modules should then be inside the same top-level module and unpackings of first-class modules inside the recursive modules should be done in each function separately (not on the module-level as it would cause runtime exception Undefined_recursive_module):

module rec M1 : sig
  module type M2's_sig = sig
    val a : int
    val c : float
  end

  module type M3's_sig = sig
    val b : string
    val c : float
  end

  type _ accessor =
    | I'm_M2 : M2.wit -> (module M2's_sig) accessor
    | I'm_M3 : M3.wit -> (module M3's_sig) accessor

  val access : 'a accessor -> 'a

  type wit

  val do_it : unit -> unit
end = struct
  module type M2's_sig = sig
    val a : int
    val c : float
  end

  module type M3's_sig = sig
    val b : string
    val c : float
  end

  type _ accessor =
    | I'm_M2 : M2.wit -> (module M2's_sig) accessor
    | I'm_M3 : M3.wit -> (module M3's_sig) accessor

  module M1 = struct
    let a = 1
    let b = "1"
    let c = 1.
  end

  let access : type a. a accessor -> a =
    function
    | I'm_M2 _ -> (module M1)
    | I'm_M3 _ -> (module M1)

  type wit = W

  let do_it () =
    let (module M2) = M2.(access @@ I'm_M1 W) in
    let (module M3) = M3.(access @@ I'm_M1 W) in
      Printf.printf "M1: M2: %d %s M3: %d %s\n" M2.a M2.b M3.a M3.b
end
and M2 : sig
  module type M1's_sig = sig
    val a : int
    val b : string
  end

  module type M3's_sig = sig
    val b : string
    val c : float
  end

  type _ accessor =
    | I'm_M1 : M1.wit -> (module M1's_sig) accessor
    | I'm_M3 : M3.wit -> (module M3's_sig) accessor

  val access : 'a accessor -> 'a

  type wit

  val do_it : unit -> unit
end = struct
  module type M1's_sig = sig
    val a : int
    val b : string
  end

  module type M3's_sig = sig
    val b : string
    val c : float
  end

  type _ accessor =
    | I'm_M1 : M1.wit -> (module M1's_sig) accessor
    | I'm_M3 : M3.wit -> (module M3's_sig) accessor

  module M2 = struct
    let a = 2
    let b = "2"
    let c = 2.
  end

  let access : type a. a accessor -> a =
    function
    | I'm_M1 _ -> (module M2)
    | I'm_M3 _ -> (module M2)

  type wit = W

  let do_it () =
   let (module M1) = M1.(access @@ I'm_M2 W) in
   let (module M3) = M3.(access @@ I'm_M2 W) in
   Printf.printf "M2: M1: %d %f M3: %d %f\n" M1.a M1.c M3.a M3.c
end
and M3 : sig
  module type M1's_sig = sig
    val a : int
    val b : string
  end

  module type M2's_sig = sig
    val a : int
    val c : float
  end

  type _ accessor =
    | I'm_M1 : M1.wit -> (module M1's_sig) accessor
    | I'm_M2 : M2.wit -> (module M2's_sig) accessor

  val access : 'a accessor -> 'a

  type wit

  val do_it : unit -> unit
end = struct
  module type M1's_sig = sig
    val a : int
    val b : string
  end

  module type M2's_sig = sig
    val a : int
    val c : float
  end

  type _ accessor =
    | I'm_M1 : M1.wit -> (module M1's_sig) accessor
    | I'm_M2 : M2.wit -> (module M2's_sig) accessor

  module M3 = struct
    let a = 3
    let b = "3"
    let c = 3.
  end

  let access : type a. a accessor -> a =
    function
    | I'm_M1 _ -> (module M3)
    | I'm_M2 _ -> (module M3)

  type wit = W

  let do_it () =
    let (module M1) = M1.(access @@ I'm_M3 W) in
    let (module M2) = M2.(access @@ I'm_M3 W) in
    Printf.printf "M3: M1: %s %f M2: %s %f\n" M1.b M1.c M2.b M2.c
end

let () =
  M1.do_it ();
  M2.do_it ();
  M3.do_it ()