Signature mismatch with polymorphic variant

Learning
1

I am seeing a module signature mismatch when using a polymorphic variant type as a function parameter:

module Log : sig
  type level = [`INFO | `DEBUG | `WARN | `ERROR]
               
  val curr_level : level ref
  val log : level:level -> ('a, out_channel, unit) format -> 'a
end = struct
  type level = [`INFO | `DEBUG | `WARN | `ERROR]
  
  let string_of_level = function
    | `INFO -> "INFO"
    | `WARN -> "WARN"
    | `DEBUG -> "DEBUG"
    | `ERROR -> "ERROR"
      
  let (<=) level1 level2 = match level2, level2 with
    | `DEBUG, _ -> true                                                    
    | `INFO, (`INFO | `WARN | `ERROR) -> true                              
    | `WARN, (`WARN | `ERROR) -> true                                      
    | `ERROR, `ERROR -> true                                               
    | _ -> false
  
  let curr_level = ref `INFO
      
  let log ~level fmt =
    if !curr_level <= (level : level) then
      Printf.printf ("[%s] " ^^ fmt ^^ "\n") (string_of_level level)
end

let name = "Bob"
let () = Log.log ~level:`INFO "Hello, %s" name

In short, the error:

Values do not match:
  val log :
    level:level ->
    (unit, out_channel, unit, unit, unit, unit) format6 -> unit
is not included in
  val log : level:level -> ('a, out_channel, unit) format -> 'a

Puzzled by why the types don’t match, since from what I can tell ('a, out_channel, unit) format -> 'a should expand out to (unit, out_channel, unit, unit, unit, unit) format6 -> unit.

Is this a variance issue I’m not seeing?

2

The problem is unrelated to polymorphic variants. Constructing a function that takes a printf style format parameter requires some extra care:

let log fmt = Printf.ksprintf (fun str -> "log: " ^ str ^ "\n") fmt

utop # log "%d %b" 200 true;;
- : string = "log: 200 true\n"

Here ksprintf does all the hard work and delivers the resulting string str which you then can use again like any other string.

3

OK, I modified my function to:

let log ~level fmt =
    if !curr_level <= (level : level) then
      let level_s = string_of_level level in
      Printf.ksprintf (fun str -> "[" ^ level_s ^ "] " ^ str ^ "\n") fmt

Now getting:

Values do not match:
  val log : level:level -> (unit, unit, string, string) format4 -> unit
is not included in
  val log : level:level -> ('a, out_channel, unit) format -> 'a

Looks like I need to keep digging :slight_smile:

4

Printf.ksprintf produces a string but I believe you want log to emit the string - so you can use Printf.kprintf. This still gives you not the exact type as in the signature. I am not familiar enough with the different format types to say how to best achieve that.

5

You are missing the else branch, thus in

  let log ~level fmt =
    if !curr_level <= (level : level) then
      Printf.printf ("[%s] " ^^ fmt ^^ "\n") (string_of_level level)

the formatting string cannot have an hole because

      Printf.printf ("[%s] " ^^ fmt ^^ "\n") (string_of_level level)

must be unit to match the implicit else () branch.

This is the use case for the if*printf functions:

let log ~level fmt =
  if !curr_level <= (level : level) then
    Printf.printf ("[%s] " ^^ fmt ^^ "\n") (string_of_level level)
  else
    Printf.ifprintf stdout ("[%s] " ^^ fmt ^^ "\n") (string_of_level level)
1 Like
6

Fantastic, thank you! Got bitten by the implicit else branch! :man_facepalming:

So I have it now as:

module Log : sig
  ...
  val log : level:level -> ('a, out_channel, unit) format -> 'a
end = struct
  ...    
  let log ~level fmt =
    let fmt = "[%s] " ^^ fmt ^^ "\n" in
    let level_s = string_of_level level in
    let p = if !curr_level <= level then Printf.fprintf else Printf.ifprintf in
    p stdout fmt level_s
end