Some context: I am writing a json schema validator, as a way to properly learn OCaml; I basically forked ocplib-json-typed and working from that.
Now the problem: I would like to have 2 sets of validation functions, the standard ones, and the “debug” ones.
What I have:
(* validator_draft04.ml contains 2 functors *)
module MakePrivate =
functor
(Repr : Json_repr.Repr)
-> struct
... (* the meat of validation logic *)
end
module Make =
functor
(Repr : Json_repr.Repr)
->
struct
include MakePrivate (Repr)
end
(* validator_draft04.mli *)
open Draft04
module Make : functor (Repr : Json_repr.Repr) -> PublicS with type t := Repr.value
module MakePrivate : functor (Repr : Json_repr.Repr) -> PrivateS with type t := Repr.value
(* draft04.ml *)
module type PrivateS = sig
type t
type e = ValidationError of string * t * t
val validate_type : t -> t -> (unit, e) result
val ... (* the signature of every single validator-function *)
end
module type PublicS = sig
type t
type e = ValidationError of string * t * t
(* a very succinct public API *)
val validate : t -> t -> (unit, e) result
end
(* traced_validator_draft04.ml *)
module MakePrivate =
functor
(Repr : Json_repr.Repr)
->
struct
include Validator_draft04.MakePrivate (Repr)
let loggable name (f : Repr.value -> Repr.value -> (unit, e) result) spec instance =
Logger.trace (fun () ->
Printf.sprintf
"%s: \nspec=%s \ninstance=%s"
name
(value_to_string spec)
(value_to_string instance));
f spec instance
;;
let validate = loggable "validate" validate
let ... (* basically enumeration of all the validation functions here, with "loggable" applied over them *)
As you can (I hope) see in my understanding, applying “loggable” over every single validation function would replace their implementation so that the caller in “main.ml” could switch between traceable implementation and the standard one. However, this doesn’t work: only the standard implementation is being called, it doesn’t matter if the caller does this:
(* still not loggable implementaion! *)
let module V = Traced_validator_draft04.Make (JsonRepr) in
match V.validate schema instance with
...
How should i “subclass” (yes i know that’s the wrong terminology) the standard implementation with a “loggable” one?
(Note that I didn’t exactly choose my validator to be a functor, but since the original ocplib-json-typed works over multiple backend JSON parsers, I followed that design)
If I understand your main question correctly, then shadowing each function would indeed create a new module with a different implementation.
It’s hard to tell from the code provided why that is not working. Are you able to share a more complete code sample? Here’s a tiny demo demonstrating what you’re trying to do (I think):
module MakeEqual (M: Map.OrderedType) = struct
include M
let equal a b = compare a b = 0
end
module MakeEqualLog (M: Map.OrderedType) = struct
include MakeEqual(M)
let equal a b =
print_endline "Logging: equal";
equal a b
end
module EqualInt = MakeEqual(Int)
let x = EqualInt.equal 1 2
(* Doesn't print *)
module EqualLogInt = MakeEqualLog(Int)
let x = EqualLogInt.equal 1 2
(* Prints *)
The caller can choose either the logging or non-logging implementation and get the expected result.
Thanks for providing a simpler example. I modified it to make my point clearer:
(* lib.ml *)
module MakeEqual (M: Map.OrderedType) = struct
include M
let child _ _ = print_endline "original child called."
let equal a b = (
child a b;
compare a b = 0
)
end
module MakeEqualLog (M: Map.OrderedType) = struct
include MakeEqual(M)
let loggable name f a b=
print_endline name;
f a b
let equal a b = loggable "equality" equal a b
let child _ _ = loggable "child" child
end
(* main.ml *)
let () =
let module EqualLogInt = Lib.MakeEqualLog(Int) in
let _ = EqualLogInt.equal 1 2 in
(* doesn't print "child"! *)
()
Note how the “equal” implementation is indeed shadowed, but the sub-calls, are not: the original implemetation is still called, so the “child” is never printed, instead we get “original child called”
My question is: how do i redirect sub-calls to the new implementation?
Okay, the problem makes more sense to me now. It looks like you basically want open recursion, where function calls are looked up dynamically and can be replaced by new definitions. Due to the static nature of modules in OCaml, this is not possible. But we have some other ways to solve this.
If you aren’t married to using modules, then dynamic recursion is possible with objects, and is probably one of the main use cases of objects in OCaml.
Using modules, the most basic solution is to simply take the values you want to change and add them to the parameter of your functor. You can then specify what you want child (or whatever else) to be at each functor application.
Here’s the previous example with some modifications:
module type S = sig
include Map.OrderedType
val child: t -> t -> unit
end
module MakeEqual (M: S) = struct
include M
let equal a b = (
child a b;
compare a b = 0
)
end
module MakeEqualLog (M: S) = struct
let loggable name f a b =
print_endline name;
f a b
include MakeEqual(struct
include M
let child = loggable "child" child
end)
let equal a b = loggable "equality" equal a b
end
let () =
let module EqualLogInt = MakeEqualLog(struct
include Int
let child _ _ = print_endline "original child called."
end) in
let _ = EqualLogInt.equal 1 2 in
(* Prints:
equality
child
original child called.
*)
()
Okey this works, but again, only partially. I hence conclude, there is no way to combine modules and such dynamic calls. Consider below:
module type S = sig
include Map.OrderedType
val child: t -> t -> unit
val child2: t -> t -> unit
(* dozens more definitions *)
end
module MakeEqual (M: S) = struct
include M
let equal a b = (
(* only cares about child2, never calls the "child", but mentions it *)
let _ = [child] in
child2 a b;
compare a b = 0
)
end
module StandardImpl = struct
include Int
let rec child _ _ = print_endline "original child."
and child2 a b = print_endline "original child2."; child a b
(* dozens more jointly-recursive functions*)
end
module MakeLogEqual (M: S) = struct
let loggable name f a b =
print_endline name;
f a b
include MakeEqual(struct
include M
(* I want "child" to be logged too! *)
let child = loggable "child" child
let child2 = loggable "child2" child2
end)
let equal a b = loggable "equality" equal a b
end
(* main.ml *)
let () =
let module V = MakeLogEqual(StandardImpl) in
let _ = V.equal 1 2 in
(* Prints:
equality
child2
original child2.
original child.
*)
()
Above, “child” is never printed, because as I understand from your explanation, by the time the new logged implementation is defined, the function call is already bound.
So I truly have no way to reuse the code from one implementation to another, unless I create a module + functor parameter, per override-able function?
I suspect there’s still a way to achieve what you’re trying to do, although I’m not sure if I understand what the goal is now. Is it possible that we’re chasing an XY problem? I may be able to provide more help with a more complete code sample from the original problem.
In your validator/logging interface, what would child, child2, etc. be? I don’t know why they need to call each other and why this example’s equal function only calls child2 even though you want child called at the same time.
For this latest example, the reason why “child” is never printed is is because the StandardImpl version of child2 calls child, but your logging version does not. If you make this change to the logging version:
include MakeEqual(struct
include M
(* I want "child" to be logged too! *)
- let child = loggable "child" child
- let child2 = loggable "child2" child2
+ let rec child = loggable "child" M.child
+ and child2 a b = loggable "child2" M.child2 a b; child a b
end)
It now has the same semantics as your StandardImpl version and “child” prints when equal is called.
Sorry I typed a lengthy response but then deleted it by mistake é_é
child[n] are validator_... functions, one for each keyword defined in jsonschema draft
validators are recursive.
the StandardImpl version of child2 calls child, but your logging version does not.
Yes, I know, that’s the purpose! The StandardImpl knows when and how to call child, I most definitely do not want to reimplement that logic within the logging version! I just want to reuse this knowledge from StandardImpl! If we can reuse another analogy: I want the logging version to be a python-like decorator over the StandardImpl
Perhaps a simpler solution would be to make the logger a parameter of the original functor, and you can just pass it a function that either logs or is a noop.
module type Json = sig
type t
val foo: t -> unit
end
module type Logger = sig
val log: string -> unit
end
module Make (L: Logger) (J: Json) = struct
let child1 x = L.log "calling child1"; J.foo x
let child2 x = L.log "calling child2"; child1 x
(* Etc. *)
let validate x = L.log "calling validate"; child2 x
end
module NoLog = struct
let log = ignore
end
module Log = struct
let log = print_endline
end
module Json = struct
type t = [`Json ]
let foo _ = ()
end
let () =
let module V = Make (NoLog) (Json) in
print_endline "Validating without logging...";
V.validate `Json;
print_endline "Done"
let () =
let module V = Make (Log) (Json) in
print_endline "Validating with logging...";
V.validate `Json;
print_endline "Done"
(* Prints:
Validating without logging...
Done
Validating with logging...
calling validate
calling child2
calling child1
Done
*)
Otherwise, replacing each function with a logging version would indeed require repeating the logic for each one.
Or, if you really want dynamic binding (and it looks like nothing less than that will do for you) and don’t want to pass functions around then it is objects you want.
class person (nm : string) =
object (self)
method identify = Printf.sprintf "I am %s" nm
method greet = Printf.sprintf "Hello, %s" self#identify
end
class logged_person (nm : string) =·
object (self)
inherit person nm as super
method identify = Printf.sprintf "Logged ( %s )" super#identify
method greet = Printf.sprintf "Logged ( %s )" super#greet
end
let () =
let p0 = new person "Adam" in
let lp0 = new logged_person "Adam" in
print_endline p0#greet;
print_endline lp0#greet
Gives:
utop # #use "object_inheritance.ml";;
class person :
string -> object method greet : string method identify : string end
class logged_person :
string -> object method greet : string method identify : string end
Hello, I am Adam
Logged ( Hello, Logged ( I am Adam ) )
Thanks both of you. Indeed, using objects & classes in my case seems like an easier solution, which is interesting, I was never expecting to find a “objects” use-case