(** JSON Feed format parser and serializer. *)

exception Invalid_feed of string

module Author = Author
module Attachment = Attachment
module Hub = Hub
module Item = Item

type t = {
  version : string;
  title : string;
  home_page_url : string option;
  feed_url : string option;
  description : string option;
  user_comment : string option;
  next_url : string option;
  icon : string option;
  favicon : string option;
  authors : Author.t list option;
  language : string option;
  expired : bool option;
  hubs : Hub.t list option;
  items : Item.t list;
}

let create ~title ?home_page_url ?feed_url ?description ?user_comment
    ?next_url ?icon ?favicon ?authors ?language ?expired ?hubs ~items () =
  {
    version = "https://jsonfeed.org/version/1.1";
    title;
    home_page_url;
    feed_url;
    description;
    user_comment;
    next_url;
    icon;
    favicon;
    authors;
    language;
    expired;
    hubs;
    items;
  }

let version t = t.version
let title t = t.title
let home_page_url t = t.home_page_url
let feed_url t = t.feed_url
let description t = t.description
let user_comment t = t.user_comment
let next_url t = t.next_url
let icon t = t.icon
let favicon t = t.favicon
let authors t = t.authors
let language t = t.language
let expired t = t.expired
let hubs t = t.hubs
let items t = t.items

(* RFC3339 date utilities *)

let parse_rfc3339 s =
  match Ptime.of_rfc3339 s with
  | Ok (t, _, _) -> Some t
  | Error _ -> None

let format_rfc3339 t =
  Ptime.to_rfc3339 t

(* JSON parsing and serialization *)

type error = [ `Msg of string ]

let error_msgf fmt = Format.kasprintf (fun s -> Error (`Msg s)) fmt

(* JSON parsing helpers *)

type json_value =
  | Null
  | Bool of bool
  | Float of float
  | String of string
  | Array of json_value list
  | Object of (string * json_value) list

let rec decode_value dec =
  match Jsonm.decode dec with
  | `Lexeme `Null -> Null
  | `Lexeme (`Bool b) -> Bool b
  | `Lexeme (`Float f) -> Float f
  | `Lexeme (`String s) -> String s
  | `Lexeme `Os -> decode_object dec []
  | `Lexeme `As -> decode_array dec []
  | `Lexeme _ -> Null
  | `Error err -> raise (Invalid_feed (Format.asprintf "%a" Jsonm.pp_error err))
  | `End | `Await -> Null

and decode_object dec acc =
  match Jsonm.decode dec with
  | `Lexeme `Oe -> Object (List.rev acc)
  | `Lexeme (`Name n) ->
      let v = decode_value dec in
      decode_object dec ((n, v) :: acc)
  | `Error err -> raise (Invalid_feed (Format.asprintf "%a" Jsonm.pp_error err))
  | _ -> Object (List.rev acc)

and decode_array dec acc =
  match Jsonm.decode dec with
  | `Lexeme `Ae -> Array (List.rev acc)
  | `Lexeme `Os ->
      let v = decode_object dec [] in
      decode_array dec (v :: acc)
  | `Lexeme `As ->
      let v = decode_array dec [] in
      decode_array dec (v :: acc)
  | `Lexeme `Null -> decode_array dec (Null :: acc)
  | `Lexeme (`Bool b) -> decode_array dec (Bool b :: acc)
  | `Lexeme (`Float f) -> decode_array dec (Float f :: acc)
  | `Lexeme (`String s) -> decode_array dec (String s :: acc)
  | `Error err -> raise (Invalid_feed (Format.asprintf "%a" Jsonm.pp_error err))
  | _ -> Array (List.rev acc)

(* Helpers to extract values from JSON *)

let get_string = function String s -> Some s | _ -> None
let get_bool = function Bool b -> Some b | _ -> None
let _get_float = function Float f -> Some f | _ -> None
let get_int = function Float f -> Some (int_of_float f) | _ -> None
let get_int64 = function Float f -> Some (Int64.of_float f) | _ -> None
let get_array = function Array arr -> Some arr | _ -> None
let _get_object = function Object obj -> Some obj | _ -> None

let find_field name obj = List.assoc_opt name obj

let require_field name obj =
  match find_field name obj with
  | Some v -> v
  | None -> raise (Invalid_feed (Printf.sprintf "Missing required field: %s" name))

let require_string name obj =
  match require_field name obj |> get_string with
  | Some s -> s
  | None -> raise (Invalid_feed (Printf.sprintf "Field %s must be a string" name))

let optional_string name obj =
  match find_field name obj with Some v -> get_string v | None -> None

let optional_bool name obj =
  match find_field name obj with Some v -> get_bool v | None -> None

let optional_int name obj =
  match find_field name obj with Some v -> get_int v | None -> None

let optional_int64 name obj =
  match find_field name obj with Some v -> get_int64 v | None -> None

let optional_array name obj =
  match find_field name obj with Some v -> get_array v | None -> None

(* Parse Author *)

let parse_author_obj obj =
  let name = optional_string "name" obj in
  let url = optional_string "url" obj in
  let avatar = optional_string "avatar" obj in
  if name = None && url = None && avatar = None then
    raise (Invalid_feed "Author must have at least one field");
  Author.create ?name ?url ?avatar ()

let parse_author = function
  | Object obj -> parse_author_obj obj
  | _ -> raise (Invalid_feed "Author must be an object")

(* Parse Attachment *)

let parse_attachment_obj obj =
  let url = require_string "url" obj in
  let mime_type = require_string "mime_type" obj in
  let title = optional_string "title" obj in
  let size_in_bytes = optional_int64 "size_in_bytes" obj in
  let duration_in_seconds = optional_int "duration_in_seconds" obj in
  Attachment.create ~url ~mime_type ?title ?size_in_bytes ?duration_in_seconds ()

let parse_attachment = function
  | Object obj -> parse_attachment_obj obj
  | _ -> raise (Invalid_feed "Attachment must be an object")

(* Parse Hub *)

let parse_hub_obj obj =
  let type_ = require_string "type" obj in
  let url = require_string "url" obj in
  Hub.create ~type_ ~url ()

let parse_hub = function
  | Object obj -> parse_hub_obj obj
  | _ -> raise (Invalid_feed "Hub must be an object")

(* Parse Item *)

let parse_item_obj obj =
  let id = require_string "id" obj in

  (* Parse content - at least one required *)
  let content_html = optional_string "content_html" obj in
  let content_text = optional_string "content_text" obj in
  let content = match content_html, content_text with
    | Some html, Some text -> `Both (html, text)
    | Some html, None -> `Html html
    | None, Some text -> `Text text
    | None, None ->
        raise (Invalid_feed "Item must have content_html or content_text")
  in

  let url = optional_string "url" obj in
  let external_url = optional_string "external_url" obj in
  let title = optional_string "title" obj in
  let summary = optional_string "summary" obj in
  let image = optional_string "image" obj in
  let banner_image = optional_string "banner_image" obj in

  let date_published =
    match optional_string "date_published" obj with
    | Some s -> parse_rfc3339 s
    | None -> None
  in

  let date_modified =
    match optional_string "date_modified" obj with
    | Some s -> parse_rfc3339 s
    | None -> None
  in

  let authors =
    match optional_array "authors" obj with
    | Some arr ->
        let parsed = List.map parse_author arr in
        if parsed = [] then None else Some parsed
    | None -> None
  in

  let tags =
    match optional_array "tags" obj with
    | Some arr ->
        let parsed = List.filter_map get_string arr in
        if parsed = [] then None else Some parsed
    | None -> None
  in

  let language = optional_string "language" obj in

  let attachments =
    match optional_array "attachments" obj with
    | Some arr ->
        let parsed = List.map parse_attachment arr in
        if parsed = [] then None else Some parsed
    | None -> None
  in

  Item.create ~id ~content ?url ?external_url ?title ?summary ?image
    ?banner_image ?date_published ?date_modified ?authors ?tags ?language
    ?attachments ()

let parse_item = function
  | Object obj -> parse_item_obj obj
  | _ -> raise (Invalid_feed "Item must be an object")

(* Parse Feed *)

let parse_feed_obj obj =
  let version = require_string "version" obj in
  let title = require_string "title" obj in
  let home_page_url = optional_string "home_page_url" obj in
  let feed_url = optional_string "feed_url" obj in
  let description = optional_string "description" obj in
  let user_comment = optional_string "user_comment" obj in
  let next_url = optional_string "next_url" obj in
  let icon = optional_string "icon" obj in
  let favicon = optional_string "favicon" obj in
  let language = optional_string "language" obj in
  let expired = optional_bool "expired" obj in

  let authors =
    match optional_array "authors" obj with
    | Some arr ->
        let parsed = List.map parse_author arr in
        if parsed = [] then None else Some parsed
    | None -> None
  in

  let hubs =
    match optional_array "hubs" obj with
    | Some arr ->
        let parsed = List.map parse_hub arr in
        if parsed = [] then None else Some parsed
    | None -> None
  in

  let items =
    match optional_array "items" obj with
    | Some arr -> List.map parse_item arr
    | None -> []
  in

  {
    version;
    title;
    home_page_url;
    feed_url;
    description;
    user_comment;
    next_url;
    icon;
    favicon;
    authors;
    language;
    expired;
    hubs;
    items;
  }

let of_jsonm dec =
  try
    let json = decode_value dec in
    match json with
    | Object obj -> Ok (parse_feed_obj obj)
    | _ -> error_msgf "Feed must be a JSON object"
  with
  | Invalid_feed msg -> error_msgf "%s" msg

(* JSON serialization *)

let to_jsonm enc feed =
  (* Simplified serialization using Jsonm *)
  let enc_field name value_fn =
    ignore (Jsonm.encode enc (`Lexeme (`Name name)));
    value_fn ()
  in

  let enc_string s =
    ignore (Jsonm.encode enc (`Lexeme (`String s)))
  in

  let enc_bool b =
    ignore (Jsonm.encode enc (`Lexeme (`Bool b)))
  in

  let enc_opt enc_fn = function
    | None -> ()
    | Some v -> enc_fn v
  in

  let enc_list enc_fn lst =
    ignore (Jsonm.encode enc (`Lexeme `As));
    List.iter enc_fn lst;
    ignore (Jsonm.encode enc (`Lexeme `Ae))
  in

  let enc_author author =
    ignore (Jsonm.encode enc (`Lexeme `Os));
    (match Author.name author with
     | Some name -> enc_field "name" (fun () -> enc_string name)
     | None -> ());
    (match Author.url author with
     | Some url -> enc_field "url" (fun () -> enc_string url)
     | None -> ());
    (match Author.avatar author with
     | Some avatar -> enc_field "avatar" (fun () -> enc_string avatar)
     | None -> ());
    ignore (Jsonm.encode enc (`Lexeme `Oe))
  in

  let enc_attachment att =
    ignore (Jsonm.encode enc (`Lexeme `Os));
    enc_field "url" (fun () -> enc_string (Attachment.url att));
    enc_field "mime_type" (fun () -> enc_string (Attachment.mime_type att));
    enc_opt (fun title -> enc_field "title" (fun () -> enc_string title))
      (Attachment.title att);
    enc_opt (fun size ->
      enc_field "size_in_bytes" (fun () ->
        ignore (Jsonm.encode enc (`Lexeme (`Float (Int64.to_float size))))))
      (Attachment.size_in_bytes att);
    enc_opt (fun dur ->
      enc_field "duration_in_seconds" (fun () ->
        ignore (Jsonm.encode enc (`Lexeme (`Float (float_of_int dur))))))
      (Attachment.duration_in_seconds att);
    ignore (Jsonm.encode enc (`Lexeme `Oe))
  in

  let enc_hub hub =
    ignore (Jsonm.encode enc (`Lexeme `Os));
    enc_field "type" (fun () -> enc_string (Hub.type_ hub));
    enc_field "url" (fun () -> enc_string (Hub.url hub));
    ignore (Jsonm.encode enc (`Lexeme `Oe))
  in

  let enc_item item =
    ignore (Jsonm.encode enc (`Lexeme `Os));
    enc_field "id" (fun () -> enc_string (Item.id item));

    (* Encode content *)
    (match Item.content item with
     | `Html html ->
         enc_field "content_html" (fun () -> enc_string html)
     | `Text text ->
         enc_field "content_text" (fun () -> enc_string text)
     | `Both (html, text) ->
         enc_field "content_html" (fun () -> enc_string html);
         enc_field "content_text" (fun () -> enc_string text));

    enc_opt (fun url -> enc_field "url" (fun () -> enc_string url))
      (Item.url item);
    enc_opt (fun url -> enc_field "external_url" (fun () -> enc_string url))
      (Item.external_url item);
    enc_opt (fun title -> enc_field "title" (fun () -> enc_string title))
      (Item.title item);
    enc_opt (fun summary -> enc_field "summary" (fun () -> enc_string summary))
      (Item.summary item);
    enc_opt (fun img -> enc_field "image" (fun () -> enc_string img))
      (Item.image item);
    enc_opt (fun img -> enc_field "banner_image" (fun () -> enc_string img))
      (Item.banner_image item);
    enc_opt (fun date -> enc_field "date_published" (fun () -> enc_string (format_rfc3339 date)))
      (Item.date_published item);
    enc_opt (fun date -> enc_field "date_modified" (fun () -> enc_string (format_rfc3339 date)))
      (Item.date_modified item);
    enc_opt (fun authors ->
      enc_field "authors" (fun () -> enc_list enc_author authors))
      (Item.authors item);
    enc_opt (fun tags ->
      enc_field "tags" (fun () -> enc_list enc_string tags))
      (Item.tags item);
    enc_opt (fun lang -> enc_field "language" (fun () -> enc_string lang))
      (Item.language item);
    enc_opt (fun atts ->
      enc_field "attachments" (fun () -> enc_list enc_attachment atts))
      (Item.attachments item);

    ignore (Jsonm.encode enc (`Lexeme `Oe))
  in

  (* Encode the feed *)
  ignore (Jsonm.encode enc (`Lexeme `Os));
  enc_field "version" (fun () -> enc_string feed.version);
  enc_field "title" (fun () -> enc_string feed.title);
  enc_opt (fun url -> enc_field "home_page_url" (fun () -> enc_string url))
    feed.home_page_url;
  enc_opt (fun url -> enc_field "feed_url" (fun () -> enc_string url))
    feed.feed_url;
  enc_opt (fun desc -> enc_field "description" (fun () -> enc_string desc))
    feed.description;
  enc_opt (fun comment -> enc_field "user_comment" (fun () -> enc_string comment))
    feed.user_comment;
  enc_opt (fun url -> enc_field "next_url" (fun () -> enc_string url))
    feed.next_url;
  enc_opt (fun icon -> enc_field "icon" (fun () -> enc_string icon))
    feed.icon;
  enc_opt (fun favicon -> enc_field "favicon" (fun () -> enc_string favicon))
    feed.favicon;
  enc_opt (fun authors ->
    enc_field "authors" (fun () -> enc_list enc_author authors))
    feed.authors;
  enc_opt (fun lang -> enc_field "language" (fun () -> enc_string lang))
    feed.language;
  enc_opt (fun expired -> enc_field "expired" (fun () -> enc_bool expired))
    feed.expired;
  enc_opt (fun hubs ->
    enc_field "hubs" (fun () -> enc_list enc_hub hubs))
    feed.hubs;
  enc_field "items" (fun () -> enc_list enc_item feed.items);
  ignore (Jsonm.encode enc (`Lexeme `Oe));
  ignore (Jsonm.encode enc `End)

let of_string s =
  let dec = Jsonm.decoder (`String s) in
  of_jsonm dec

let to_string ?(minify=false) feed =
  let buf = Buffer.create 1024 in
  let enc = Jsonm.encoder ~minify (`Buffer buf) in
  to_jsonm enc feed;
  Buffer.contents buf

(* Validation *)

let validate feed =
  let errors = ref [] in
  let add_error msg = errors := msg :: !errors in

  (* Check required fields *)
  if feed.title = "" then
    add_error "title is required and cannot be empty";

  (* Check items have unique IDs *)
  let ids = List.map Item.id feed.items in
  let unique_ids = List.sort_uniq String.compare ids in
  if List.length ids <> List.length unique_ids then
    add_error "items must have unique IDs";

  (* Validate authors *)
  (match feed.authors with
   | Some authors ->
       List.iteri (fun i author ->
         if not (Author.is_valid author) then
           add_error (Printf.sprintf "feed author %d is invalid (needs at least one field)" i)
       ) authors
   | None -> ());

  (* Validate items *)
  List.iteri (fun i item ->
    if Item.id item = "" then
      add_error (Printf.sprintf "item %d has empty ID" i);

    (* Validate item authors *)
    (match Item.authors item with
     | Some authors ->
         List.iteri (fun j author ->
           if not (Author.is_valid author) then
             add_error (Printf.sprintf "item %d author %d is invalid" i j)
         ) authors
     | None -> ())
  ) feed.items;

  if !errors = [] then Ok ()
  else Error (List.rev !errors)

(* Comparison *)

let equal a b =
  a.version = b.version &&
  a.title = b.title &&
  a.home_page_url = b.home_page_url &&
  a.feed_url = b.feed_url &&
  a.description = b.description &&
  a.user_comment = b.user_comment &&
  a.next_url = b.next_url &&
  a.icon = b.icon &&
  a.favicon = b.favicon &&
  a.language = b.language &&
  a.expired = b.expired &&
  (* Note: We're doing structural equality on items *)
  List.length a.items = List.length b.items

(* Pretty printing *)

let pp_summary ppf feed =
  Format.fprintf ppf "%s (%d items)" feed.title (List.length feed.items)

let pp ppf feed =
  Format.fprintf ppf "Feed: %s" feed.title;
  (match feed.home_page_url with
   | Some url -> Format.fprintf ppf " (%s)" url
   | None -> ());
  Format.fprintf ppf "@\n";

  Format.fprintf ppf "  Items: %d@\n" (List.length feed.items);

  (match feed.authors with
   | Some authors when authors <> [] ->
       Format.fprintf ppf "  Authors: ";
       List.iteri (fun i author ->
         if i > 0 then Format.fprintf ppf ", ";
         Format.fprintf ppf "%a" Author.pp author
       ) authors;
       Format.fprintf ppf "@\n"
   | _ -> ());

  (match feed.language with
   | Some lang -> Format.fprintf ppf "  Language: %s@\n" lang
   | None -> ())