module Codec = Protobuf_codec
module D = Protobuf_codec.Decoder

module State = struct
  type t = D.t

  let of_bytes = D.of_bytes
end

type tag = int
type 'a t = (State.t -> 'a)

(* Applicative boilerplate *)
module Applicative = struct
  let app f v =
    fun d ->
      let f' = f d in
      let v' = v d in
      f' v'

  let ( <*> ) = app

  let const v = fun _ -> v

  let fmap f v = const f <*> v

  let ( <$> ) = fmap
end

module Encoding = struct
  type typ =
    | Varint
    | Zigzag
    | Bits32
    | Bits64
    | Bytes

  type 'a t = (typ * (D.t -> 'a))

  let varint = (Varint, D.varint)
  let zigzag = (Zigzag, D.zigzag)
  let bits32 = (Bits32, D.bits32)
  let bits64 = (Bits64, D.bits64)
  let bytes = (Bytes, D.bytes)

  let decode (_, decoder) = decoder

  let equal_pk (typ, _) pk =
    match (typ, pk) with
      | (Varint, Codec.Varint) -> true
      | (Zigzag, Codec.Varint) -> true
      | (Bits32, Codec.Bits32) -> true
      | (Bits64, Codec.Bits64) -> true
      | (Bytes, Codec.Bytes) -> true
      | _ -> false
end

let read tag typ d =
  match D.key d with
    | Some (tag', typ') when tag = tag' && Encoding.equal_pk typ typ' ->
      Encoding.decode typ d
    | _ ->
      failwith "bad type or tag"


let run s decoder = decoder s

(* Conversions *)
let enum tag conv d =
  conv (D.int_of_int64 "enum" (read tag Encoding.varint d))

let bool tag d =
  Int64.compare (read tag Encoding.varint d) Int64.zero <> 0

let int32 tag d =
  D.int32_of_int64 "int32" (read tag Encoding.varint d)

let sint32 tag d =
  D.int32_of_int64 "sint32" (read tag Encoding.zigzag d)

let int64 tag d =
  read tag Encoding.varint d

let sint64 tag d =
  read tag Encoding.zigzag d

let float tag d =
  Int32.float_of_bits (read tag Encoding.bits32 d)

let double tag d =
  Int64.float_of_bits (read tag Encoding.bits64 d)

let bytes tag d =
  read tag Encoding.bytes d

let string = bytes

let embd_msg tag conv d =
  let b = read tag Encoding.bytes d in
  let d' = State.of_bytes b in
  run d' conv

type 'a t

module State : sig
  type t

  val of_bytes : bytes -> t
end

module Applicative : sig
  val app : ('a -> 'b) t -> 'a t -> 'b t
  val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t
  val const : 'a -> 'a t
  val fmap : ('a -> 'b) -> 'a t -> 'b t
  val ( <$> ) : ('a -> 'b) -> 'a t -> 'b t
end

type tag = int

val run : State.t -> 'a t -> 'a

val enum         : tag -> (int -> 'a) -> 'a t
val bool         : tag -> bool t
val int32        : tag -> Int32.t t
val sint32       : tag -> Int32.t t
val int64        : tag -> Int64.t t
val sint64       : tag -> Int64.t t
val float        : tag -> float t
val double       : tag -> float t
val string       : tag -> bytes t
val bytes        : tag -> bytes t
val embd_msg     : tag -> 'a t -> 'a t

(* val enum_opt     : tag -> (int -> ('a, error) Result.t) -> 'a option t *)
(* val bool_opt     : tag -> bool option t *)
(* val int32_opt    : tag -> Int32.t option t *)
(* val sint32_opt   : tag -> Int32.t option t *)
(* val int64_opt    : tag -> Int64.t option t *)
(* val sint64_opt   : tag -> Int64.t option t *)
(* val float_opt    : tag -> Float.t option t *)
(* val double_opt   : tag -> Float.t option t *)
(* val string_opt   : tag -> String.t option t *)
(* val bytes_opt    : tag -> String.t option t *)
(* val embd_msg_opt : tag -> 'a t -> 'a option t *)

(* val enum_rep     : tag -> (int -> ('a, error) Result.t) -> 'a list t *)
(* val bool_rep     : tag -> bool list t *)
(* val int32_rep    : tag -> Int32.t list t *)
(* val sint32_rep   : tag -> Int32.t list t *)
(* val int64_rep    : tag -> Int64.t list t *)
(* val sint64_rep   : tag -> Int64.t list t *)
(* val float_rep    : tag -> Float.t list t *)
(* val double_rep   : tag -> Float.t list t *)
(* val string_rep   : tag -> String.t list t *)
(* val bytes_rep    : tag -> String.t list t *)
(* val embd_msg_rep : tag -> 'a t -> 'a list t *)

(* val enum_pkd     : tag -> (int -> ('a, error) Result.t) -> 'a list t *)
(* val bool_pkd     : tag -> bool list t *)
(* val int32_pkd    : tag -> Int32.t list t *)
(* val sint32_pkd   : tag -> Int32.t list t *)
(* val int64_pkd    : tag -> Int64.t list t *)
(* val sint64_pkd   : tag -> Int64.t list t *)
(* val float_pkd    : tag -> Float.t list t *)
(* val double_pkd   : tag -> Float.t list t *)