type checkout_status =
  | Missing
  | Not_a_repo
  | Dirty
  | Clean of Git.ahead_behind

type subtree_status = Not_added | Present

(** Sync state between monorepo subtree and local checkout *)
type subtree_sync =
  | In_sync  (** Subtree matches checkout HEAD *)
  | Subtree_behind of int
      (** Subtree needs pull from checkout (checkout has new commits) *)
  | Subtree_ahead of int
      (** Subtree has commits not in checkout (need push to checkout) *)
  | Trees_differ  (** Trees differ but can't determine direction/count *)
  | Unknown  (** Can't determine (subtree not added or checkout missing) *)

type t = {
  package : Package.t;
  checkout : checkout_status;
  subtree : subtree_status;
  subtree_sync : subtree_sync;  (** Sync state between monorepo and checkout *)
}

let fs_typed (fs : _ Eio.Path.t) : Eio.Fs.dir_ty Eio.Path.t =
  let dir, _ = fs in
  (dir, "")

let compute ~proc ~fs ~config pkg =
  let checkouts_root = Config.Paths.checkouts config in
  let checkout_dir = Package.checkout_dir ~checkouts_root pkg in
  let monorepo = Config.Paths.monorepo config in
  let prefix = Package.subtree_prefix pkg in
  let fs_t = fs_typed fs in
  let fs_dir =
    let dir, _ = fs in
    (dir, Fpath.to_string checkout_dir)
  in
  let checkout =
    match Eio.Path.kind ~follow:true fs_dir with
    | exception Eio.Io _ -> Missing
    | `Directory -> (
        if not (Git.is_repo ~proc ~fs:fs_t checkout_dir) then Not_a_repo
        else if Git.is_dirty ~proc ~fs:fs_t checkout_dir then Dirty
        else
          match Git.ahead_behind ~proc ~fs:fs_t checkout_dir with
          | Ok ab -> Clean ab
          | Error _ -> Clean { ahead = 0; behind = 0 })
    | _ -> Missing
  in
  let subtree =
    if Git.Subtree.exists ~fs:fs_t ~repo:monorepo ~prefix then Present
    else Not_added
  in
  (* Compute subtree sync state: compare tree content between monorepo subtree and checkout.
     This is more accurate than commit ancestry because it handles both push and pull directions.
     If the trees match, the content is in sync regardless of how it got there. *)
  let subtree_sync =
    match (checkout, subtree) with
    | (Missing | Not_a_repo | Dirty), _ -> Unknown
    | _, Not_added -> Unknown
    | Clean _, Present -> (
        (* Get tree hash of subtree directory in monorepo *)
        let subtree_tree =
          Git.rev_parse ~proc ~fs:fs_t ~rev:("HEAD:" ^ prefix) monorepo
        in
        (* Get tree hash of checkout root *)
        let checkout_tree =
          Git.rev_parse ~proc ~fs:fs_t ~rev:"HEAD^{tree}" checkout_dir
        in
        match (subtree_tree, checkout_tree) with
        | Ok st, Ok ct when st = ct -> In_sync
        | Ok _, Ok _ -> (
            (* Trees differ - check commit ancestry to determine direction *)
            let subtree_commit =
              Git.subtree_last_upstream_commit ~proc ~fs:fs_t ~repo:monorepo
                ~prefix ()
            in
            let checkout_head = Git.head_commit ~proc ~fs:fs_t checkout_dir in
            match (subtree_commit, checkout_head) with
            | Some subtree_sha, Ok checkout_sha ->
                if
                  Git.is_ancestor ~proc ~fs:fs_t ~repo:checkout_dir
                    ~commit1:subtree_sha ~commit2:checkout_sha ()
                then
                  (* Checkout has commits not in subtree - need subtree pull *)
                  let count =
                    Git.count_commits_between ~proc ~fs:fs_t ~repo:checkout_dir
                      ~base:subtree_sha ~head:checkout_sha ()
                  in
                  if count > 0 then Subtree_behind count else Trees_differ
                  (* Same commit but trees differ - monorepo has changes *)
                else if
                  Git.is_ancestor ~proc ~fs:fs_t ~repo:checkout_dir
                    ~commit1:checkout_sha ~commit2:subtree_sha ()
                then
                  (* Subtree has content not in checkout - need push *)
                  let count =
                    Git.count_commits_between ~proc ~fs:fs_t ~repo:checkout_dir
                      ~base:checkout_sha ~head:subtree_sha ()
                  in
                  if count > 0 then Subtree_ahead count else Trees_differ
                else Trees_differ (* Diverged *)
            | _ -> Trees_differ
            (* Trees differ but can't determine ancestry *))
        | _ -> Unknown)
  in
  { package = pkg; checkout; subtree; subtree_sync }

let compute_all ~proc ~fs ~config packages =
  List.map (compute ~proc ~fs ~config) packages

let is_checkout_clean t = match t.checkout with Clean _ -> true | _ -> false
let has_local_changes t = match t.checkout with Dirty -> true | _ -> false

let needs_pull t =
  match t.checkout with Clean ab -> ab.behind > 0 | _ -> false

let needs_push t = match t.checkout with Clean ab -> ab.ahead > 0 | _ -> false

(** Needs local sync: monorepo subtree out of sync with checkout *)
let needs_local_sync t =
  match t.subtree_sync with
  | Subtree_behind _ | Subtree_ahead _ | Trees_differ -> true
  | In_sync | Unknown -> false

(** Needs remote action: checkout ahead/behind of upstream *)
let needs_remote_action t =
  match t.checkout with Clean ab -> ab.ahead > 0 || ab.behind > 0 | _ -> false

let is_fully_synced t =
  match (t.checkout, t.subtree, t.subtree_sync) with
  | Clean ab, Present, In_sync -> ab.ahead = 0 && ab.behind = 0
  | _ -> false

let filter_actionable statuses =
  List.filter
    (fun t ->
      match t.checkout with
      | Missing | Not_a_repo | Dirty -> true
      | Clean ab ->
          ab.ahead > 0 || ab.behind > 0 || t.subtree = Not_added
          || needs_local_sync t)
    statuses

let pp_checkout_status ppf = function
  | Missing -> Fmt.string ppf "missing"
  | Not_a_repo -> Fmt.string ppf "not a repo"
  | Dirty -> Fmt.string ppf "dirty"
  | Clean ab ->
      if ab.ahead = 0 && ab.behind = 0 then Fmt.string ppf "clean"
      else Fmt.pf ppf "ahead %d, behind %d" ab.ahead ab.behind

let pp_subtree_status ppf = function
  | Not_added -> Fmt.string ppf "not added"
  | Present -> Fmt.string ppf "present"

let pp ppf t =
  Fmt.pf ppf "@[<h>%-20s checkout: %a  subtree: %a@]" (Package.name t.package)
    pp_checkout_status t.checkout pp_subtree_status t.subtree

(** Extract handle from a tangled.org URL like "git+https://tangled.org/handle/repo" *)
let extract_handle_from_url url =
  let url = if String.starts_with ~prefix:"git+" url then
    String.sub url 4 (String.length url - 4)
  else url in
  let uri = Uri.of_string url in
  match Uri.host uri with
  | Some "tangled.org" ->
      let path = Uri.path uri in
      (* Path is like "/handle/repo" - extract first component *)
      let path = if String.length path > 0 && path.[0] = '/' then
        String.sub path 1 (String.length path - 1)
      else path in
      (match String.index_opt path '/' with
       | Some i -> Some (String.sub path 0 i)
       | None -> Some path)
  | _ -> None

(** Format origin indicator from sources registry entry *)
let pp_origin_indicator ppf entry =
  match entry with
  | None -> ()
  | Some Sources_registry.{ origin = Some Sources_registry.Fork; _ } ->
      Fmt.pf ppf "  %a" Fmt.(styled `Magenta string) "^"
  | Some Sources_registry.{ origin = Some Sources_registry.Join; upstream = Some url; _ } ->
      (match extract_handle_from_url url with
       | Some handle ->
           (* Abbreviate handle - take first part before dot, max 8 chars *)
           let abbrev = match String.index_opt handle '.' with
             | Some i -> String.sub handle 0 i
             | None -> handle
           in
           let abbrev = if String.length abbrev > 8 then String.sub abbrev 0 8 else abbrev in
           Fmt.pf ppf "  %a" Fmt.(styled `Cyan (fun ppf s -> pf ppf "v:%s" s)) abbrev
       | None -> Fmt.pf ppf "  %a" Fmt.(styled `Cyan string) "v:")
  | Some Sources_registry.{ origin = Some Sources_registry.Join; _ } ->
      Fmt.pf ppf "  %a" Fmt.(styled `Cyan string) "v:"
  | Some _ -> ()

(** Compact status for actionable items with colors *)
let pp_compact ?sources ppf t =
  let name = Package.name t.package in
  let subtree = Package.subtree_prefix t.package in
  let entry = match sources with
    | Some s -> Sources_registry.find s ~subtree
    | None -> None
  in
  (* Helper to print remote sync info *)
  let pp_remote ab =
    if ab.Git.ahead > 0 && ab.behind > 0 then
      Fmt.pf ppf " %a"
        Fmt.(styled `Yellow (fun ppf (a, b) -> pf ppf "remote:+%d/-%d" a b))
        (ab.ahead, ab.behind)
    else if ab.ahead > 0 then
      Fmt.pf ppf " %a"
        Fmt.(styled `Cyan (fun ppf n -> pf ppf "remote:+%d" n))
        ab.ahead
    else if ab.behind > 0 then
      Fmt.pf ppf " %a"
        Fmt.(styled `Red (fun ppf n -> pf ppf "remote:-%d" n))
        ab.behind
  in
  match (t.checkout, t.subtree, t.subtree_sync) with
  (* Local sync issues with count *)
  | Clean ab, Present, Subtree_behind n ->
      Fmt.pf ppf "%-22s %a" name
        Fmt.(styled `Blue (fun ppf n -> pf ppf "local:-%d" n))
        n;
      pp_remote ab;
      pp_origin_indicator ppf entry
  | Clean ab, Present, Subtree_ahead n ->
      Fmt.pf ppf "%-22s %a" name
        Fmt.(styled `Blue (fun ppf n -> pf ppf "local:+%d" n))
        n;
      pp_remote ab;
      pp_origin_indicator ppf entry
  (* Trees differ but can't determine count *)
  | Clean ab, Present, Trees_differ ->
      Fmt.pf ppf "%-22s %a" name Fmt.(styled `Blue string) "local:sync";
      pp_remote ab;
      pp_origin_indicator ppf entry
  (* Remote sync issues only *)
  | Clean ab, Present, (In_sync | Unknown) when ab.ahead > 0 && ab.behind > 0 ->
      Fmt.pf ppf "%-22s %a" name
        Fmt.(styled `Yellow (fun ppf (a, b) -> pf ppf "remote:+%d/-%d" a b))
        (ab.ahead, ab.behind);
      pp_origin_indicator ppf entry
  | Clean ab, Present, (In_sync | Unknown) when ab.ahead > 0 ->
      Fmt.pf ppf "%-22s %a" name
        Fmt.(styled `Cyan (fun ppf n -> pf ppf "remote:+%d" n))
        ab.ahead;
      pp_origin_indicator ppf entry
  | Clean ab, Present, (In_sync | Unknown) when ab.behind > 0 ->
      Fmt.pf ppf "%-22s %a" name
        Fmt.(styled `Red (fun ppf n -> pf ppf "remote:-%d" n))
        ab.behind;
      pp_origin_indicator ppf entry
  (* Other issues *)
  | Clean _, Not_added, _ ->
      Fmt.pf ppf "%-22s %a" name Fmt.(styled `Magenta string) "(no subtree)";
      pp_origin_indicator ppf entry
  | Missing, _, _ ->
      Fmt.pf ppf "%-22s %a" name Fmt.(styled `Red string) "(no checkout)";
      pp_origin_indicator ppf entry
  | Not_a_repo, _, _ ->
      Fmt.pf ppf "%-22s %a" name Fmt.(styled `Red string) "(not a repo)";
      pp_origin_indicator ppf entry
  | Dirty, _, _ ->
      Fmt.pf ppf "%-22s %a" name Fmt.(styled `Yellow string) "(dirty)";
      pp_origin_indicator ppf entry
  | Clean _, Present, (In_sync | Unknown) ->
      Fmt.pf ppf "%-22s %a" name Fmt.(styled `Green string) "ok";
      pp_origin_indicator ppf entry

let pp_summary ?sources ppf statuses =
  let total = List.length statuses in
  let actionable = filter_actionable statuses in
  let synced = List.filter is_fully_synced statuses |> List.length in
  let dirty = List.filter has_local_changes statuses |> List.length in
  let local_sync_needed =
    List.filter needs_local_sync statuses |> List.length
  in
  let remote_needed = List.filter needs_remote_action statuses |> List.length in
  let action_count = List.length actionable in
  (* Header line with colors *)
  if dirty > 0 then
    Fmt.pf ppf "%a %d total, %a synced, %a dirty\n"
      Fmt.(styled `Bold string)
      "Packages:" total
      Fmt.(styled `Green int)
      synced
      Fmt.(styled `Yellow int)
      dirty
  else if action_count > 0 then begin
    Fmt.pf ppf "%a %d total, %a synced"
      Fmt.(styled `Bold string)
      "Packages:" total
      Fmt.(styled `Green int)
      synced;
    if local_sync_needed > 0 then
      Fmt.pf ppf ", %a local sync" Fmt.(styled `Blue int) local_sync_needed;
    if remote_needed > 0 then
      Fmt.pf ppf ", %a remote" Fmt.(styled `Cyan int) remote_needed;
    Fmt.pf ppf "\n"
  end
  else
    Fmt.pf ppf "%a %d total, %a\n"
      Fmt.(styled `Bold string)
      "Packages:" total
      Fmt.(styled `Green string)
      "all synced";
  (* Only show actionable items *)
  if actionable <> [] then
    List.iter (fun t -> Fmt.pf ppf "  %a\n" (pp_compact ?sources) t) actionable