(* Implementation of the site building blocks. The API and its rationale are
   documented in ui.mli; comments here cover implementation choices only.

   Attribute order is deliberate and load-bearing for readability of the
   rendered HTML: id, then href, then class, then ARIA. Keeping it uniform means
   a page's markup diffs cleanly when a block changes. *)

open Dream_html

type node = Dream_html.node

let classes parts =
  parts |> List.filter (fun part -> part <> "") |> String.concat " "

(* Optional attributes collapse to the empty list so they can be concatenated
   unconditionally at each call site. *)
let opt_id = function None -> [] | Some value -> [ HTML.id "%s" value ]
let opt_class = function None -> [] | Some value -> [ HTML.class_ "%s" value ]
let opt_aria_label = function None -> [] | Some v -> [ Aria.label "%s" v ]
let flag_current = function false -> [] | true -> [ Aria.current `page ]
let flag_open = function false -> [] | true -> HTML.[ open_ ]

(* Text and grouping *)

let nothing = HTML.null []
let text value = txt "%s" value
let group nodes = HTML.null nodes

(* Inline *)

let inline ?class_ ?(decorative = false) children =
  let hidden = if decorative then [ Aria.hidden true ] else [] in
  HTML.span (opt_class class_ @ hidden) children

let inline_text ?class_ ?decorative value =
  inline ?class_ ?decorative [ text value ]

(* Links *)

let link ?id ?class_ ?label ~href children =
  HTML.a
    (opt_id id
    @ [ HTML.href "%s" href ]
    @ opt_class class_ @ opt_aria_label label)
    children

let text_link ?id ?class_ ?label ~href value =
  link ?id ?class_ ?label ~href [ text value ]

(* Images *)

let image ?class_ ?alt ~src () =
  let describe =
    match alt with
    | Some value -> [ HTML.alt "%s" value ]
    (* An empty alt alone is enough for most readers, but the explicit
       presentation role removes any doubt. *)
    | None -> [ HTML.alt ""; HTML.role `presentation ]
  in
  HTML.img ((HTML.src "%s" src :: describe) @ opt_class class_)

(* Blocks *)

let block ?id ?class_ children =
  HTML.div (opt_id id @ opt_class class_) children

let region ?id ?class_ children =
  HTML.section (opt_id id @ opt_class class_) children

let paragraph ?class_ children = HTML.p (opt_class class_) children
let paragraph_text ?class_ value = paragraph ?class_ [ text value ]

let heading ?id ?(level = 1) ?class_ children =
  let element =
    match level with
    | 1 -> HTML.h1
    | 2 -> HTML.h2
    | 3 -> HTML.h3
    | 4 -> HTML.h4
    | 5 -> HTML.h5
    | _ -> HTML.h6
  in
  element (opt_id id @ opt_class class_) children

let code_block ?class_ children =
  (* Pre-serialize the entire <code> block into a single raw text node placed
     directly inside <pre>. This prevents the pretty-printer from injecting
     visible whitespace between the <pre> open tag and the code content.
     Dream_html.to_string appends a newline after each element; strip those to
     avoid spurious line breaks between inline spans. *)
  let raw_content =
    children
    |> List.map (fun node ->
        let s = Dream_html.to_string node in
        if String.length s > 0 && s.[String.length s - 1] = '\n' then
          String.sub s 0 (String.length s - 1)
        else s)
    |> String.concat ""
  in
  HTML.pre (opt_class class_) [ txt ~raw:true "<code>%s</code>" raw_content ]

(* Lists *)

let items ?id ?class_ children = HTML.ul (opt_id id @ opt_class class_) children

let ordered_items ?id ?class_ children =
  HTML.ol (opt_id id @ opt_class class_) children

let item ?class_ ?(current = false) children =
  HTML.li (opt_class class_ @ flag_current current) children

let items_of ?id ?class_ render values =
  items ?id ?class_ (List.map render values)

let code_inline ?class_ value = HTML.code (opt_class class_) [ text value ]

(* Badges *)

let badge ?(base_class = "badge") ?variant ?href value =
  let classes =
    match variant with
    | None -> base_class
    | Some variant -> Printf.sprintf "%s %s-%s" base_class base_class variant
  in
  (* Only the text is linked: a link wrapping the whole badge would make its
     padding clickable, which reads as a button rather than a label. *)
  let body =
    match href with
    | None -> [ text value ]
    | Some href -> [ link ~href [ text value ] ]
  in
  inline ~class_:classes body

(* Time *)

let timestamp ~machine display =
  HTML.time [ HTML.datetime "%s" machine ] [ text display ]

(* Definition lists *)

let definitions ?class_ pairs =
  (* dt and dd are siblings, not nested, so each pair becomes a flat group. *)
  let entry (term, description) =
    group [ HTML.dt [] [ text term ]; HTML.dd [] description ]
  in
  HTML.dl (opt_class class_) (List.map entry pairs)

(* Disclosure *)

let chevron ?(class_ = "tree-chevron") () =
  inline ~class_ ~decorative:true [ text "\xe2\x80\xba" ]

let disclosure ?id ?class_ ?(expanded = false) ?summary_class ~summary children
    =
  HTML.details
    (opt_id id @ opt_class class_ @ flag_open expanded)
    (HTML.summary (opt_class summary_class) summary :: children)

let css_toggle ~id:toggle_id ~toggle_class ~control_class ~label:control_label
    ~glyph () =
  group
    [
      HTML.input
        [
          HTML.type_ "checkbox";
          HTML.id "%s" toggle_id;
          HTML.class_ "%s" toggle_class;
        ];
      HTML.label
        [
          HTML.for_ "%s" toggle_id;
          HTML.class_ "%s" control_class;
          Aria.label "%s" control_label;
        ]
        [ text glyph ];
    ]

(* Table of contents *)

type toc_entry = {
  toc_href : string;
  toc_label : string;
  toc_children : toc_entry list;
}

let toc_entry ?(children = []) ~href label =
  { toc_href = href; toc_label = label; toc_children = children }

let rec toc_items entries =
  items ~class_:"toc-list"
    (List.map
       (fun { toc_href; toc_label; toc_children } ->
         let nested =
           match toc_children with [] -> [] | kids -> [ toc_items kids ]
         in
         item (text_link ~href:toc_href toc_label :: nested))
       entries)

let toc ?class_ ~title entries =
  let rec count = function
    | [] -> 0
    | e :: rest -> 1 + count e.toc_children + count rest
  in
  match entries with
  | [] -> nothing
  | _ when count entries < 2 -> nothing
  | _ ->
      let outer_class = classes [ "toc"; Option.value class_ ~default:"" ] in
      disclosure ~class_:outer_class ~summary_class:"toc-summary"
        ~summary:[ text title ]
        [ toc_items entries ]

(* Trees *)

let tree_leaf ?(modifier = "") ~href label =
  item ~class_:(classes [ "tree-file"; modifier ]) [ text_link ~href label ]

let tree_branch ?(modifier = "") ?(expanded = false) ~href label children =
  item
    ~class_:(classes [ "tree-dir"; modifier ])
    [
      disclosure ~expanded ~summary_class:"tree-toggle"
        ~summary:[ chevron (); text_link ~class_:"tree-link" ~href label ]
        [ items ~class_:"tree-nested" children ];
    ]

let tree_overflow ?(class_ = "tree-overflow") ~href label =
  item ~class_ [ text_link ~href label ]

(* Breadcrumbs *)

type crumb = { crumb_text : string; crumb_href : string option }

let crumb ?href text = { crumb_text = text; crumb_href = href }

let breadcrumb ?id ?class_ ?link_class ?separator_class
    ?(separator_decorative = false) ~separator crumbs =
  (* The separator precedes every crumb but the first, so the trail has no
     leading or trailing delimiter. *)
  let render index { crumb_text; crumb_href } =
    let body =
      match crumb_href with
      | Some href -> text_link ?class_:link_class ~href crumb_text
      | None -> inline_text ?class_:link_class crumb_text
    in
    if index = 0 then body
    else
      group
        [
          inline_text ?class_:separator_class ~decorative:separator_decorative
            separator;
          body;
        ]
  in
  HTML.span (opt_id id @ opt_class class_) (List.mapi render crumbs)

(* Navigation *)

type nav_link = { nav_href : string; nav_text : string; nav_current : bool }

let nav_link ?(current = false) ~href text =
  { nav_href = href; nav_text = text; nav_current = current }

let navigation ?id ?class_ ~label children =
  HTML.nav (opt_id id @ opt_class class_ @ [ Aria.label "%s" label ]) children

let nav_links ?id ?class_ ?item_class links =
  (* aria-current goes on the list item rather than the link so the marker
     survives styling the item as the highlighted row. *)
  let render { nav_href; nav_text; nav_current } =
    item ?class_:item_class ~current:nav_current
      [ text_link ~href:nav_href nav_text ]
  in
  items ?id ?class_ (List.map render links)

(* Toolbars *)

let toolbar ?id ?class_ ?label children =
  match children with
  | [] -> nothing
  | _ ->
      HTML.div
        (opt_id id @ opt_class class_
        @ [ HTML.role `toolbar ]
        @ opt_aria_label label)
        children

let button_link ?(class_ = "toolbar-button") ?label ~href text =
  text_link ~class_ ?label ~href text

let dismissible ?(class_ = "toolbar-filter")
    ?(dismiss_class = "toolbar-dismiss") ~value_class ~dismiss_href
    ~dismiss_label value =
  inline ~class_
    [
      inline_text ~class_:value_class value;
      text_link ~class_:dismiss_class ~label:dismiss_label ~href:dismiss_href
        "\xc3\x97";
    ]

(* Pagination *)

let pagination ?(label = "Pagination") ?(previous_text = "<") ?(next_text = ">")
    ?(previous_label = "Previous page") ?(next_label = "Next page")
    ?previous_href ?next_href page_number =
  (* An unavailable neighbour still occupies its slot, so the page number does
     not shift horizontally as the reader moves through the list. *)
  let control href_opt glyph control_label =
    match href_opt with
    | Some href ->
        text_link ~class_:"pagination-btn" ~label:control_label ~href glyph
    | None ->
        inline_text ~class_:"pagination-btn pagination-disabled"
          ~decorative:true glyph
  in
  navigation ~class_:"toolbar-pagination" ~label
    [
      control previous_href previous_text previous_label;
      HTML.span
        [ HTML.class_ "pagination-page"; Aria.current `page ]
        [ text (string_of_int page_number) ];
      control next_href next_text next_label;
    ]

(* Code *)

let numbered_lines ?id ?class_ ?(anchor_prefix = "") render_line lines =
  let numbered_line index line =
    let number = index + 1 in
    let name = Printf.sprintf "%s%d" anchor_prefix number in
    [
      HTML.a
        [
          HTML.id "%s" name;
          HTML.class_ "line-anchor";
          HTML.href "#%s" name;
          Aria.label "Line %d" number;
        ]
        [ text (string_of_int number) ];
      HTML.span [ HTML.class_ "line" ] (render_line line);
    ]
  in
  block ?id ?class_ (List.mapi numbered_line lines |> List.concat)

let code_listing ?id ?class_ ?anchor_prefix content =
  (* Anchor and text alternate as siblings of one grid container, so the
     stylesheet can align numbers against wrapping lines without a table. The
     leading tab and trailing newline preserve the source's shape when the
     listing is copied. *)
  numbered_lines ?id ?class_ ?anchor_prefix
    (fun line -> [ txt "\t%s\n" line ])
    (String.split_on_char '\n' content)

let highlighted_code_listing ?id ?class_ ?anchor_prefix lines =
  (* Same grid layout as code_listing, but each line is a list of pre-rendered
     nodes (highlighted spans) rather than plain text.  The tab/newline framing
     is identical so copy-paste behaviour is preserved. *)
  numbered_lines ?id ?class_ ?anchor_prefix
    (fun line_nodes -> txt "\t" :: line_nodes)
    lines

(* Diffs *)

module Diff = struct
  type change = Unchanged | Added | Removed

  type line = {
    before : string;
    after : string;
    change : change;
    content : string;
  }

  type section = { section_heading : string; lines : line list }

  type file = {
    path : string;
    detail : string;
    sections : section list;
    note : string option;
  }

  let line_node { before; after; change; content } =
    let variant, marker, announcement =
      match change with
      | Unchanged -> ("context", " ", "")
      | Added -> ("addition", "+", "Added: ")
      | Removed -> ("deletion", "-", "Removed: ")
    in
    block ~class_:("diff-line " ^ variant)
      [
        inline_text ~class_:"line-number" before;
        inline_text ~class_:"line-number" after;
        inline_text ~class_:"diff-marker" ~decorative:true marker;
        (* Restores, for screen readers, the meaning the marker conveys
           visually. *)
        inline_text ~class_:"sr-only" announcement;
        inline_text ~class_:"diff-text" content;
      ]

  let section_node { section_heading; lines } =
    disclosure ~class_:"diff-hunk" ~expanded:true ~summary_class:"hunk-header"
      ~summary:[ text section_heading ]
      [
        (* The inner scroll container keeps long lines from widening the page. *)
        block ~class_:"diff-lines-scroll"
          [ block ~class_:"diff-lines" (List.map line_node lines) ];
      ]

  let file_id index = Printf.sprintf "file-%d" (index + 1)

  let file_node index { path; detail; sections; note } =
    let body =
      match note with
      | Some note -> [ paragraph_text ~class_:"binary-diff" note ]
      | None -> List.map section_node sections
    in
    disclosure ~class_:"diff-file" ~expanded:true
      ~summary_class:"diff-file-header"
      ~summary:[ text path ]
      ~id:(file_id index)
      (block ~class_:"diff-meta" [ text detail ] :: body)

  let file_toc files =
    toc ~class_:"diff-toc" ~title:"Changed files"
      (List.mapi
         (fun index { path; _ } -> toc_entry ~href:("#" ^ file_id index) path)
         files)

  let view ~empty_message = function
    | [] -> [ paragraph_text empty_message ]
    | files -> file_toc files :: List.mapi file_node files
end

(* Document scaffolding *)

let meta_viewport =
  HTML.meta
    [ HTML.name "viewport"; HTML.content "width=device-width, initial-scale=1" ]

let stylesheet href = HTML.link [ HTML.rel "stylesheet"; HTML.href "%s" href ]

let icon ?(media_type = "image/x-icon") href =
  HTML.link [ HTML.rel "icon"; HTML.type_ "%s" media_type; HTML.href "%s" href ]

let deferred_script src = HTML.script [ HTML.src "%s" src; HTML.defer ] ""
let inline_script source = HTML.script [] "%s" source

let document_head ~title:document_title extra =
  HTML.head [] (HTML.title [] "%s" document_title :: extra)

let skip_link ~href label = text_link ~class_:"skip-link" ~href label

let page_banner ?id ?class_ children =
  HTML.header (opt_id id @ opt_class class_) children

let page_content ?id ?class_ children =
  HTML.main (opt_id id @ opt_class class_) children

let page_footer ?class_ children = HTML.footer (opt_class class_) children
let document_body ?class_ children = HTML.body (opt_class class_) children

let document ?(lang = "en") ~head ~body () =
  HTML.html [ HTML.lang "%s" lang ] [ head; body ]

(* Responses *)

let respond ?status page =
  match status with
  | None -> Dream_html.respond page
  | Some status -> Dream_html.respond ~status page