(*---------------------------------------------------------------------------
   Copyright (c) 2016 Daniel C. Bünzli. All rights reserved.
   SPDX-License-Identifier: ISC
  ---------------------------------------------------------------------------*)

open Topkg_result

(* Decode errors *)

type error = Corrupted of (string * string) | Version of int * int

let pp_error ppf = function
| Corrupted (kind, v) ->
    Format.fprintf ppf "corrupted %s in %S" kind v
| Version (exp, fnd) ->
    Format.fprintf ppf "version mismatch, expected %d found %d" exp fnd

exception Error of error

let err ~kind v = raise (Error (Corrupted (kind, v)))
let err_version ~exp ~fnd = raise (Error (Version (exp, fnd)))

(* Codecs *)

type 'a t =
  { kind : string;
    enc : 'a -> string;
    dec : string -> 'a; }

let v ~kind ~enc ~dec = { kind; enc; dec }
let kind c = c.kind
let enc c = c.enc
let dec c = c.dec
let with_kind kind c = { c with kind }

let dec_result c s = try Ok (dec c s) with
| Error err ->
    R.error_msgf "Decode %s: %a Input data: %S" (kind c) pp_error err s

let write file c v =
  Topkg_os.File.write file (enc c v)
  |> R.reword_error_msg ~replace:true
    (fun err -> R.msgf "Encode %s to %s: %s" (kind c) file err)

let read file c =
  Topkg_os.File.read file >>= fun s ->
  try Ok (dec c s) with
  | Error e -> R.error_msgf "Decode %s from %s: %a" (kind c) file pp_error e

(* Base type codecs *)

let tail s = Topkg_string.with_index_range ~first:1 s

let unit =
  let kind = "unit" in
  let enc = function () -> "\x00" in
  let dec = function "\x00" -> () | s -> err ~kind s in
  v ~kind ~enc ~dec

let const c =
  let kind = "const" in
  let enc = function _ -> "" in
  let dec = function "" -> c | s -> err ~kind s in
  v ~kind ~enc ~dec

let bool =
  let kind = "bool" in
  let enc = function false -> "\x00" | true -> "\x01" in
  let dec = function "\x00" -> false | "\x01" -> true | s -> err ~kind s in
  v ~kind ~enc ~dec

let int =
  let kind = "int" in
  let enc = string_of_int (* will do for now *) in
  let dec s = try int_of_string s with Failure _ -> err ~kind s in
  v ~kind ~enc ~dec

let string =
  let kind = "string" in
  let enc s = s in
  let dec s = s in
  v ~kind ~enc ~dec

let option some =
  let kind = Printf.sprintf "(%s) option" (kind some) in
  let enc = function None -> "\x00" | Some v -> "\x01" ^ (enc some v) in
  let dec s = match Topkg_string.head s with
  | Some '\x00' -> None
  | Some '\x01' -> Some (dec some (tail s))
  | _ -> err ~kind s
  in
  v ~kind ~enc ~dec

let result ~ok ~error =
  let kind = Printf.sprintf "(%s, %s) result" (kind ok) (kind error) in
  let enc = function
  | Ok v -> "\x00" ^ (enc ok v)
  | Error e -> "\x01" ^ (enc error e)
  in
  let dec s = match Topkg_string.head s with
  | Some '\x00' -> Ok (dec ok (tail s))
  | Some '\x01' -> Error (dec error (tail s))
  | _ -> err ~kind s
  in
  v ~kind ~enc ~dec

let list el =
  let kind = Printf.sprintf "(%s) list" (kind el) in
  let enc vs =
    let b = Buffer.create 255 in
    let rec loop = function
    | [] -> Buffer.add_char b '\x00'
    | v :: vs ->
      let venc = (enc el) v in
      let venc_len = String.length venc in
      Buffer.add_char b '\x01';
      Buffer.add_string b (string_of_int venc_len) (* will do for now *);
      Buffer.add_char b '\x01';
      Buffer.add_string b venc;
      loop vs
    in
    loop vs; Buffer.contents b
  in
  let dec s =
    let rec loop acc s = match Topkg_string.head s with
    | Some '\x00' -> acc
    | Some '\x01' ->
      begin match Topkg_string.find_byte ~start:1 '\x01' s with
      | None -> err ~kind s
      | Some one ->
          try
            let last = one - 1 in
            let len = Topkg_string.with_index_range ~first:1 ~last s in
            let len = int_of_string len in
            let first = one + 1 in
            let last = first + len - 1 in
            let venc = Topkg_string.with_index_range ~first ~last s in
            let rest = Topkg_string.with_index_range ~first:(last + 1) s in
            loop ((dec el venc) :: acc) rest
          with Failure _ (* of int_of_string *) -> err ~kind s
      end
    | _ -> err ~kind s
    in
    List.rev (loop [] s)
  in
  v ~kind ~enc ~dec

let seq = list string

let pair c0 c1 =
  let kind = Printf.sprintf "%s * %s" (kind c0) (kind c1) in
  let enc (v0, v1) = enc seq [enc c0 v0; enc c1 v1] in
  let dec s = match dec seq s with
  | [lenc; renc] -> (dec c0 lenc), (dec c1 renc)
  | _ -> err ~kind s
  in
  v ~kind ~enc ~dec

let t2 = pair

let t3 c0 c1 c2 =
  let kind = Printf.sprintf "%s * %s * %s" (kind c0) (kind c1) (kind c2) in
  let seq = list string in
  let enc (v0, v1, v2) = enc seq [enc c0 v0; enc c1 v1; enc c2 v2] in
  let dec s = match (dec seq) s with
  | [v0; v1; v2] -> (dec c0 v0), (dec c1 v1), (dec c2 v2)
  | _ -> err ~kind s
  in
  v ~kind ~enc ~dec

let t4 c0 c1 c2 c3 =
  let kind =
    Printf.sprintf "%s * %s * %s * %s" (kind c0) (kind c1) (kind c2) (kind c3)
  in
  let seq = list string in
  let enc (v0, v1, v2, v3) =
    enc seq [enc c0 v0; enc c1 v1; enc c2 v2; enc c3 v3]
  in
  let dec s = match (dec seq) s with
  | [v0; v1; v2; v3] -> (dec c0 v0), (dec c1 v1), (dec c2 v2), (dec c3 v3)
  | _ -> err ~kind s
  in
  v ~kind ~enc ~dec

let t5 c0 c1 c2 c3 c4 =
  let kind =
    Printf.sprintf "%s * %s * %s * %s * %s"
      (kind c0) (kind c1) (kind c2) (kind c3) (kind c4)
  in
  let seq = list string in
  let enc (v0, v1, v2, v3, v4) =
    enc seq [enc c0 v0; enc c1 v1; enc c2 v2; enc c3 v3; enc c4 v4]
  in
  let dec s = match (dec seq) s with
  | [v0; v1; v2; v3; v4] ->
      (dec c0 v0), (dec c1 v1), (dec c2 v2), (dec c3 v3), (dec c4 v4)
  | _ -> err ~kind s
  in
  v ~kind ~enc ~dec

let alt ~kind tag cs =
  let l = Array.length cs in
  if l > 256 then invalid_arg @@ Topkg_string.strf "too many codecs (%d)" l;
  let enc v =
    let tag = tag v in
    Printf.sprintf "%c%s" (Char.chr tag) (enc cs.(tag) v)
  in
  let dec s = match Topkg_string.head s with
  | None -> err ~kind s
  | Some tag ->
      let tag = Char.code tag in
      if tag < Array.length cs then dec cs.(tag) (tail s) else
      err ~kind s
  in
  v ~kind ~enc ~dec

let version version =
   let enc_version = string_of_int version in
   fun c ->
     let kind = Printf.sprintf "(%s) v%s" (kind c) enc_version in
     let enc v = String.concat "\x00" [enc_version; enc c v] in
     let dec s = match Topkg_string.cut ~sep:'\x00' s with
     | None -> err ~kind s
     | Some (fnd_version, s) ->
         try
           let fnd = int_of_string fnd_version in
           if fnd <> version then err_version ~exp:version ~fnd else
           dec c s
         with
         | Failure _ (* of int_of_string *) -> err ~kind s
     in
     v ~kind ~enc ~dec

let view ?kind:k (inj, proj) c =
  let kind = match k with None -> kind c | Some k -> k in
  let enc v = enc c (inj v) in
  let dec s = proj (dec c s) in
  v ~kind ~enc ~dec

let msg =
  let msg = (fun (`Msg m) -> m), (fun m -> `Msg m) in
  view msg string

let result_error_msg ok = result ~ok ~error:msg
let fpath = string
let cmd =
  let cmd =
    (fun cmd -> Topkg_cmd.to_list cmd),
    (fun l -> Topkg_cmd.of_list l)
  in
  view cmd (list string)
