(** TP1, exo bonus: printf typé, sans hack. *)

module type PRINTF = sig
  type ('a,'r) fmt
  (** On va garantir que 'a = T1 -> ... -> Tn -> 'r
    * où les Ti sont soit int soit string. *)

  val fmt_i : (int -> 'r, 'r) fmt
  val fmt_lit : string -> ('r,'r) fmt
  val fmt_concat : ('a,'b) fmt -> ('b,'r) fmt -> ('a,'r) fmt

  val print : ('a,unit) fmt -> 'a
end

(** Test d'une implémentation de PRINTF. *)
module T (P:PRINTF) = struct
  open P
  let (^) = fmt_concat
  let () =
    print fmt_i 12 ;
    print (fmt_lit "\nfoo\n") ;
    print (fmt_i ^ fmt_lit "..." ^ fmt_i ^ fmt_lit "\n") 42 24
end

(** Une solution. *)
module Printf : PRINTF = struct

  type ('a,'r) fmt = (unit -> 'r) -> 'a

  let print fmt = fmt (fun x -> x)

  let fmt_i k n = print_int n ; k ()
  let fmt_lit s k = print_string s ; k ()
  let fmt_concat f1 f2 k = f1 (fun () -> f2 k)

end

(** Testons notre solution. *)
module TP = T(Printf)


(** Bonus dans le bonus: la même chose avec Scanf. *)

module type SCANF = sig
  type ('a,'r) fmt
  (** On va garantir que 'a = T1 -> ... -> Tn -> 'r
    * où les Ti sont soit int soit string. *)

  val fmt_i : (int -> 'r, 'r) fmt
  val fmt_lit : string -> ('r,'r) fmt
  val fmt_concat : ('a,'b) fmt -> ('b,'r) fmt -> ('a,'r) fmt

  val scan : ('a,unit) fmt -> 'a -> unit
end

module Scanf : SCANF = struct

  type ('a,'r) fmt = ('r -> unit) -> 'a -> unit

  let scan fmt = fmt (fun () -> ())

  (** Comme avant, on va garantir 'a = T1 -> .. -> Tn -> 'r.
    * La fonction scan prend un ('a,unit) fmt puis un 'a.
    * Par exemple sur le formatteur fmt_i de type (int->unit,unit) fmt
    * on a (scan fmt_i) : (int -> unit) -> unit. *)

  let fmt_i k f =
    let n = read_int () in
      k (f n)

  let fmt_lit s k f =
    for i = 1 to String.length s do
      ignore (input_char stdin)
    done ;
    k f

  let fmt_concat f1 f2 k f = f1 (f2 k) f

end

(** Pour le même prix, printf et scanf sur les mêmes formatteurs...
  * même si c'est un peu artificiel. *)

module type FMT = sig
  (* On utilise with .. := .. pour fusionner deux signatures en partageant un type. *)
  type ('a,'b) fmt
  include (PRINTF with type ('a,'b) fmt := ('a,'b) fmt)
  include (SCANF with type ('a,'b) fmt := ('a,'b) fmt)
end

module Fmt : FMT = struct
  type ('a,'b) fmt = ('a,'b) Printf.fmt * ('a,'b) Scanf.fmt
  let scan (_,fmt) = Scanf.scan fmt
  let print (fmt,_) = Printf.print fmt
  let fmt_i = Printf.fmt_i, Scanf.fmt_i
  let fmt_lit s = Printf.fmt_lit s, Scanf.fmt_lit s
  let fmt_concat (a,b) (x,y) = Printf.fmt_concat a x, Scanf.fmt_concat b y
end

module S (P:FMT) = struct
  open P
  let (^) = fmt_concat
  let () =
    print (fmt_lit "Please input <int>\n+<int>\n:\n") ;
    scan (fmt_i ^ fmt_lit "+" ^ fmt_i)
      (fun x y ->
         print (fmt_i ^ fmt_lit "*" ^ fmt_i ^ fmt_lit "\n") x y)
end

module SF = S(Fmt)