open Data_encoding
open Types

type nonrec 'a result = ('a, string) result

let internal_err =
  let open Err in
  union
    [ (let title = "No_msg" in
       case ~title (Tag 0)
         (obj1 (req title unit))
         (function No_msg -> Some () | _ -> None)
         (fun () -> No_msg) )
    ; (let title = "Db" in
       case ~title (Tag 1)
         (obj1 (req title string))
         (function Db s -> Some s | _ -> None)
         (fun s -> Db s) )
    ; (let title = "Db_not_found" in
       case ~title (Tag 2)
         (obj1 (req title string))
         (function Db_not_found s -> Some s | _ -> None)
         (fun s -> Db_not_found s) )
    ; (let title = "Bos" in
       case ~title (Tag 3)
         (obj1 (req title string))
         (function Bos s -> Some s | _ -> None)
         (fun s -> Bos s) )
    ; (let title = "Conan" in
       case ~title (Tag 4)
         (obj1 (req title string))
         (function Conan s -> Some s | _ -> None)
         (fun s -> Conan s) )
    ]

let err =
  let open Err in
  union
    [ (let title = "Internal" in
       case ~title (Tag 0) internal_err
         (function Internal o -> Some o | _ -> None)
         (fun o -> Internal o) )
    ; (let title = "Bad_form" in
       case ~title (Tag 1)
         (obj1 (req title unit))
         (function Bad_form -> Some () | _ -> None)
         (fun () -> Bad_form) )
    ; (let title = "Bad_form_suspicious" in
       case ~title (Tag 2)
         (obj1 (req title unit))
         (function Bad_form_suspicious -> Some () | _ -> None)
         (fun () -> Bad_form_suspicious) )
    ; (let title = "Unauthorized" in
       case ~title (Tag 3)
         (obj1 (req title unit))
         (function Unauthorized -> Some () | _ -> None)
         (fun () -> Unauthorized) )
    ; (let title = "Unauthorized_login" in
       case ~title (Tag 4)
         (obj1 (req title string))
         (function Unauthorized_login s -> Some s | _ -> None)
         (fun s -> Unauthorized_login s) )
    ; (let title = "Forbidden" in
       case ~title (Tag 5)
         (obj1 (req title unit))
         (function Forbidden -> Some () | _ -> None)
         (fun () -> Forbidden) )
    ; (let title = "Not_found" in
       case ~title (Tag 6)
         (obj1 (req title unit))
         (function Not_found -> Some () | _ -> None)
         (fun () -> Not_found) )
    ; (let title = "Not_found_thread" in
       case ~title (Tag 7)
         (obj1 (req title int31))
         (function Not_found_thread s -> Some s | _ -> None)
         (fun s -> Not_found_thread s) )
    ; (let title = "Not_found_post" in
       case ~title (Tag 8)
         (obj1 (req title int31))
         (function Not_found_post s -> Some s | _ -> None)
         (fun s -> Not_found_post s) )
    ; (let title = "Not_found_user" in
       case ~title (Tag 9)
         (obj1 (req title string))
         (function Not_found_user s -> Some s | _ -> None)
         (fun s -> Not_found_user s) )
    ; (let title = "Not_found_image" in
       case ~title (Tag 10)
         (obj1 (req title int31))
         (function Not_found_image s -> Some s | _ -> None)
         (fun s -> Not_found_image s) )
    ; (let title = "Unprocessable" in
       case ~title (Tag 11)
         (obj1 (req title string))
         (function Unprocessable s -> Some s | _ -> None)
         (fun s -> Unprocessable s) )
    ]

let img_info =
  conv
    (fun { md5; mime; w; h; thumb_w; thumb_h; name; alt } ->
      (md5, mime, w, h, thumb_w, thumb_h, name, alt) )
    (fun (md5, mime, w, h, thumb_w, thumb_h, name, alt) ->
      { md5; mime; w; h; thumb_w; thumb_h; name; alt } )
    (obj8 (req "md5" string) (req "mime" string) (req "w" int31) (req "h" int31)
       (req "thumb_w" int31) (req "thumb_h" int31) (req "name" string)
       (req "alt" string) )

let post =
  conv_with_guard
    (fun { id
         ; parent_t_id
         ; date
         ; poster_id
         ; poster_nick
         ; comment
         ; image_info
         ; backlinks
         } ->
      ( id
      , parent_t_id
      , date
      , poster_id
      , poster_nick
      , Comment.to_string comment
      , image_info
      , backlinks ) )
    (fun ( id
         , parent_t_id
         , date
         , poster_id
         , poster_nick
         , comment_str
         , image_info
         , backlinks ) ->
      let open Syntax in
      let+ comment = Comment.of_string comment_str in
      { id
      ; parent_t_id
      ; date
      ; poster_id
      ; poster_nick
      ; comment
      ; image_info
      ; backlinks
      } )
    (obj8 (req "id" int31) (req "parent_t_id" int31) (req "date" float)
       (req "poster_id" string) (req "poster_nick" string)
       (req "comment" string)
       (req "image_info" (option img_info))
       (req "replies" (list int31)) )

let bump_status =
  union
    [ case ~title:"Dead" (Tag 0)
        (obj1 (req "dead" empty))
        (function Dead -> Some () | _ -> None)
        (fun () -> Dead)
    ; case ~title:"Locked" (Tag 1)
        (obj1 (req "locked" int31))
        (function Locked c -> Some c | _ -> None)
        (fun c -> Locked c)
    ; case ~title:"Alive" (Tag 2)
        (obj1 (req "alive" int31))
        (function Alive c -> Some c | _ -> None)
        (fun c -> Alive c)
    ]

let thread =
  conv
    (fun { op; subject; lat; lng; bump_status; reply_count } ->
      (op, subject, lat, lng, bump_status, reply_count) )
    (fun (op, subject, lat, lng, bump_status, reply_count) ->
      { op; subject; lat; lng; bump_status; reply_count } )
    (obj6 (req "op" post) (req "subject" string) (req "lat" float)
       (req "lng" float)
       (req "bump_status" bump_status)
       (req "reply_count" int31) )

let thread_w_reply =
  let open Thread_w_reply in
  conv
    (fun { op; subject; lat; lng; bump_status; reply_count; reply_l } ->
      (op, subject, lat, lng, bump_status, reply_count, reply_l) )
    (fun (op, subject, lat, lng, bump_status, reply_count, reply_l) ->
      { op; subject; lat; lng; bump_status; reply_count; reply_l } )
    (obj7 (req "op" post) (req "subject" string) (req "lat" float)
       (req "lng" float)
       (req "bump_status" bump_status)
       (req "reply_count" int31)
       (req "reply_l" (list post)) )

let catalog : thread list encoding =
  conv (fun l -> l) (fun l -> l) (obj1 (req "catalog" (list thread)))

let report =
  conv
    (fun { report_id
         ; report_date
         ; reported_post
         ; reporter_user_id
         ; reporter_nick
         ; reason
         } ->
      ( report_id
      , report_date
      , reported_post
      , reporter_user_id
      , reporter_nick
      , reason ) )
    (fun ( report_id
         , report_date
         , reported_post
         , reporter_user_id
         , reporter_nick
         , reason ) ->
      { report_id
      ; report_date
      ; reported_post
      ; reporter_user_id
      ; reporter_nick
      ; reason
      } )
    (obj6 (req "report_id" string) (req "report_date" float)
       (req "reported_post" post)
       (req "reporter_user_id" string)
       (req "reporter_nick" string)
       (req "reason" string) )

let reports : report list encoding =
  conv (fun o -> o) (fun o -> o) (obj1 (req "reports" (list report)))

let user =
  conv
    (fun { user_id; user_nick; user_is_admin; bio; avatar_info } ->
      (user_id, user_nick, user_is_admin, bio, avatar_info) )
    (fun (user_id, user_nick, user_is_admin, bio, avatar_info) ->
      { user_id; user_nick; user_is_admin; bio; avatar_info } )
    (obj5 (req "user_id" string) (req "user_nick" string)
       (req "user_is_admin" bool) (req "bio" string)
       (req "avatar_info" (option img_info)) )

let user_private =
  let open User_private in
  conv
    (fun { user_id; user_nick; user_is_admin; bio; avatar_info; email } ->
      (user_id, user_nick, user_is_admin, bio, avatar_info, email) )
    (fun (user_id, user_nick, user_is_admin, bio, avatar_info, email) ->
      { user_id; user_nick; user_is_admin; bio; avatar_info; email } )
    (obj6 (req "user_id" string) (req "user_nick" string)
       (req "user_is_admin" bool) (req "bio" string)
       (req "avatar_info" (option img_info))
       (req "email" string) )

let geojson_marker : (float * float * post_id) encoding =
  let geometry =
    conv
      (* !! geojson coordinates are lng first then lat *)
      (fun (lat, lng) -> ((), [ lng; lat ]) )
      (fun ((), coordinates) ->
        match coordinates with [ lng; lat ] -> (lat, lng) | _ -> assert false )
      (obj2
         (req "type" (constant "Point"))
         (req "coordinates" (Fixed.list 2 float)) )
  in
  let properties = conv (fun id -> id) (fun id -> id) (obj1 (req "id" int31)) in
  conv
    (fun (lat, lng, id) -> ((), (lat, lng), id))
    (fun ((), (lat, lng), id) -> (lat, lng, id))
    (obj3
       (req "type" (constant "Feature"))
       (req "geometry" geometry)
       (req "properties" properties) )

let geojson_markers : (float * float * post_id) list encoding =
  conv
    (fun l -> ((), l))
    (fun ((), l) -> l)
    (obj2
       (req "type" (constant "FeatureCollection"))
       (req "features" (list geojson_marker)) )

let session : session encoding =
  conv
    (fun { user_private; csrf_token; csrf_time_limit } ->
      (user_private, csrf_token, csrf_time_limit) )
    (fun (user_private, csrf_token, csrf_time_limit) ->
      { user_private; csrf_token; csrf_time_limit } )
    (obj3
       (req "user_private" (option user_private))
       (req "csrf_token" string)
       (req "csrf_time_limit" float) )

let unit : unit encoding =
  conv (fun o -> o) (fun o -> o) (obj1 (req "unit" unit))

let to_string enc =
  let json = Data_encoding.Json.construct enc in
  fun v -> Data_encoding.Json.to_string (json v)

let of_string enc =
  let destruct = Data_encoding.Json.destruct enc in
  fun s -> Data_encoding.Json.from_string s |> Result.map destruct

module Read = struct
  let err = of_string err

  let session = of_string session

  let img_info = of_string img_info

  let post = of_string post

  let bump_status = of_string bump_status

  let thread = of_string thread

  let thread_w_reply = of_string thread_w_reply

  let catalog = of_string catalog

  let reports = of_string reports

  let user = of_string user

  let user_private = of_string user_private

  let geojson_marker = of_string geojson_marker

  let geojson_markers = of_string geojson_markers

  let unit = of_string unit
end

module Write = struct
  let err = to_string err

  let session = to_string session

  let img_info = to_string img_info

  let post = to_string post

  let bump_status = to_string bump_status

  let thread = to_string thread

  let thread_w_reply = to_string thread_w_reply

  let catalog = to_string catalog

  let reports = to_string reports

  let user = to_string user

  let user_private = to_string user_private

  let geojson_marker = to_string geojson_marker

  let geojson_markers = to_string geojson_markers

  let unit = to_string unit
end