path: root/lib/management/branch.ml

(** Branch registry: named pointers to database tip hashes, plus HEAD tracking.
    Stored in the Physical backend under reserved key prefixes:
    - "branch:<name>" → serialized { name; tip }
    - "branch_names"  → serialized string list (index for enumeration)
    - "head"          → branch name as raw bytes *)

type t = { name : string; tip : Conventions.Hash.t }
type head = string
type error = string

let branch_key name = "branch:" ^ name
let head_key = "head"
let names_key = "branch_names"

module Make (Storage : Physical.S with type error = string) = struct
  let load_names storage =
    match Storage.load_raw storage names_key with
    | Ok (Some bytes) -> (Marshal.from_bytes bytes 0 : string list)
    | _ -> []

  let store_names storage names =
    let bytes = Marshal.to_bytes names [] in
    ignore (Storage.store_raw storage names_key bytes)

  let create storage ~name ~tip =
    let record = { name; tip } in
    let bytes = Marshal.to_bytes record [] in
    match Storage.store_raw storage (branch_key name) bytes with
    | Error e -> Error e
    | Ok () ->
        let names = load_names storage in
        if not (List.mem name names) then store_names storage (name :: names);
        Ok ()

  let checkout storage branch_name =
    let bytes = Bytes.of_string branch_name in
    Storage.store_raw storage head_key bytes

  let get_head storage =
    match Storage.load_raw storage head_key with
    | Ok (Some bytes) -> Ok (Some (Bytes.to_string bytes))
    | Ok None -> Ok None
    | Error e -> Error e

  let get_tip storage name =
    match Storage.load_raw storage (branch_key name) with
    | Ok (Some bytes) ->
        let record : t = Marshal.from_bytes bytes 0 in
        Ok (Some record.tip)
    | Ok None -> Ok None
    | Error e -> Error e

  let update_tip storage ~name ~tip =
    match Storage.load_raw storage (branch_key name) with
    | Ok (Some _) ->
        let record = { name; tip } in
        let bytes = Marshal.to_bytes record [] in
        Storage.store_raw storage (branch_key name) bytes
    | Ok None -> Error ("Branch not found: " ^ name)
    | Error e -> Error e

  let list storage =
    let names = load_names storage in
    let branches =
      List.filter_map
        (fun name ->
          match get_tip storage name with
          | Ok (Some tip) -> Some (name, tip)
          | _ -> None)
        names
    in
    Ok branches

  let branch_relation storage : Relation.t =
    let schema =
      Schema.empty |> Schema.add "name" "string" |> Schema.add "hash" "string"
    in
    let mk v = { Attribute.value = Obj.repr v } in
    let rec generator position =
      match position with
      | None -> Generator.Error "random access not supported for sakura:branch"
      | Some pos -> (
          match list storage with
          | Error _ -> Generator.Done
          | Ok branches ->
              if pos >= List.length branches then Generator.Done
              else
                let name, tip = List.nth branches pos in
                let short = String.sub tip 0 (min 8 (String.length tip)) in
                let attributes =
                  Tuple.AttributeMap.of_list
                    [ ("name", mk name); ("hash", mk short) ]
                in
                Generator.Value
                  ( Tuple.make_materialized
                      ~relation:Prelude.Catalog.branch_rel_name ~attributes,
                    generator ))
    in
    Relation.make ~hash:None ~name:Prelude.Catalog.branch_rel_name ~schema
      ~tree:None ~constraints:None
      ~cardinality:Conventions.Cardinality.ConstrainedFinite
      ~generator:(Some generator)
      ~membership_criteria:(fun _ -> true)
      ~provenance:(Relation.Provenance.Base Prelude.Catalog.branch_rel_name)
      ~lineage:(Relation.Lineage.Base Prelude.Catalog.branch_rel_name)

  let head_relation storage : Relation.t =
    let schema = Schema.empty |> Schema.add "branch" "string" in
    let mk v = { Attribute.value = Obj.repr v } in
    let generator position =
      match position with
      | None -> Generator.Error "random access not supported for sakura:head"
      | Some 0 -> (
          match get_head storage with
          | Ok None | Error _ -> Generator.Done
          | Ok (Some branch_name) ->
              let attributes =
                Tuple.AttributeMap.of_list [ ("branch", mk branch_name) ]
              in
              Generator.Value
                ( Tuple.make_materialized
                    ~relation:Prelude.Catalog.head_rel_name ~attributes,
                  fun _ -> Generator.Done ))
      | Some _ -> Generator.Done
    in
    Relation.make ~hash:None ~name:Prelude.Catalog.head_rel_name ~schema
      ~tree:None ~constraints:None
      ~cardinality:Conventions.Cardinality.ConstrainedFinite
      ~generator:(Some generator)
      ~membership_criteria:(fun _ -> true)
      ~provenance:(Relation.Provenance.Base Prelude.Catalog.head_rel_name)
      ~lineage:(Relation.Lineage.Base Prelude.Catalog.head_rel_name)
end