open Rnt
open Alcotest
module J = Protocols.Journal

let ok = Helpers.condition_as_failure
let thing () = Rnt.Kernel.Prototype.mixture []

let journal () =
  let handle = Rnt.Kernel.Journal.make ~bindings:["A", thing ()] () in
  handle, ok (J.require handle)

let bound directory name =
  let listing = ok (Protocols.Handle.require Protocols.Directory.from directory) in
  ok (Protocols.Directory.find listing name) |> Option.is_some

let a_registry_update_is_a_commit () =
  let handle, journal = journal () in
  let registry = Protocols.Registry.from handle |> Option.get in
  check bool "bound" true (ok (Protocols.Registry.update registry "B" None (Some (thing ()))));
  let history = J.history journal in
  check (list int) "numbered" [0; 1] (List.map (fun (c : J.commit) -> c.number) history);
  check bool "the first snapshot keeps its past" false (bound (List.hd history).snapshot "B");
  check bool "the head sees it" true (bound (J.head journal).snapshot "B")

let a_commit_binds_together_or_not_at_all () =
  let _, journal = journal () in
  let changes stale =
    J.
      [ {name= "B"; expected= None; replacement= Some (thing ())};
        { name= "C";
          expected= (if stale then Some (thing ()) else None);
          replacement= Some (thing ()) } ]
  in
  check bool "a stale expectation" true (ok (J.commit journal (changes true)) = None);
  check int "nothing landed" 0 (J.head journal).number;
  let commit = ok (J.commit journal (changes false)) |> Option.get in
  check (list string) "both" ["B"; "C"] commit.changed;
  check bool "B" true (bound commit.snapshot "B");
  check bool "C" true (bound commit.snapshot "C")

let a_guard_refuses_and_an_observer_hears () =
  let _, journal = journal () in
  let heard = ref [] in
  J.observe journal "ear" (Some (fun c -> heard := c.number :: !heard));
  J.guard journal "no-B"
    (Some
       (fun {proposed; _} ->
         if List.mem "B" proposed.changed then
           Error Concepts.Condition.(condition "no-B" "B stays unbound" empty)
         else Ok () ) );
  let change name = [J.{name; expected= None; replacement= Some (thing ())}] in
  check bool "refused" true (Result.is_error (J.commit journal (change "B")));
  check bool "allowed" true (Result.is_ok (J.commit journal (change "C")));
  check (list int) "heard only what landed" [1] !heard

let a_snapshot_hands_out_derived_relations_against_itself () =
  let derived =
    Rnt.Kernel.Prototype.mixture
      [ Protocols.Derived.make
          object
            method within directory =
              Ok
                (Rnt.Kernel.Prototype.mixture
                   [Rnt.Kernel.Prototype.Directory.of_properties ["seen", directory]] )
          end ]
  in
  let snapshot = Rnt.Kernel.Journal.snapshot ["D", derived] in
  let read = ok (Rnt.Kernel.Path.lookup snapshot Rnt.Kernel.Path.("D" @/ "seen" @/ this)) in
  check bool "read against the snapshot" true (Protocols.Handle.equal read snapshot)

let suites () =
  [ ( "kernel/journal",
      [ test_case "a registry update is a commit" `Quick a_registry_update_is_a_commit;
        test_case "a commit binds together or not at all" `Quick
          a_commit_binds_together_or_not_at_all;
        test_case "a guard refuses and an observer hears" `Quick
          a_guard_refuses_and_an_observer_hears;
        test_case "a snapshot hands out derived relations against itself" `Quick
          a_snapshot_hands_out_derived_relations_against_itself ] ) ]

let schema = BatMap.String.singleton "N" {Protocols.Schematics.domain= "integer"; provenance= []}

let row n =
  {Concepts.Tuple.type_= "R"; attributes= BatMap.String.singleton "N" (Concepts.Value.Integer n)}

let count relation =
  let _, tuples = ok (Rnt.Kernel.View.read relation) in
  List.length tuples

let rebinding_lands_as_one_commit_or_one_name_at_a_time () =
  let handle, journal = journal () in
  let fixed n = Rnt.Kernel.View.fixed schema (List.init n row) in
  ok (Rnt.Kernel.Journal.rebind handle ["A", Some (fixed 1); "B", Some (fixed 2)]);
  ok (Rnt.Kernel.Journal.rebind handle ["A", Some (fixed 3)]);
  check (list int) "two commits after the first" [0; 1; 2]
    (List.map (fun (c : J.commit) -> c.number) (J.history journal));
  let plain = Rnt.Kernel.Namespace.make () in
  ok (Rnt.Kernel.Journal.rebind plain ["A", Some (fixed 1)]);
  ok (Rnt.Kernel.Journal.rebind plain ["A", Some (fixed 4)]);
  check int "a plain namespace too" 4
    (count (ok (Rnt.Kernel.Path.lookup plain Rnt.Kernel.Path.("A" @/ this))))

(* A computed relation counts the tuples of A in whatever it is read
   against, so the first snapshot still sees one and the head three. *)
let a_computed_relation_reads_as_of_its_snapshot () =
  let ( let* ) = Result.bind in
  let handle, journal = journal () in
  let fixed n = Rnt.Kernel.View.fixed schema (List.init n row) in
  let counting =
    Rnt.Kernel.View.computed schema
      ~current:(fun () -> Ok handle)
      (fun directory ->
        let* a = Rnt.Kernel.Path.lookup directory Rnt.Kernel.Path.("A" @/ this) in
        Ok [row (count a)] )
  in
  ok (Rnt.Kernel.Journal.rebind handle ["A", Some (fixed 1); "C", Some counting]);
  ok (Rnt.Kernel.Journal.rebind handle ["A", Some (fixed 3)]);
  let read snapshot =
    let c = ok (Rnt.Kernel.Path.lookup snapshot Rnt.Kernel.Path.("C" @/ this)) in
    let _, tuples = ok (Rnt.Kernel.View.read c) in
    BatMap.String.find "N" (List.hd tuples).Concepts.Tuple.attributes
  in
  let history = J.history journal in
  check Helpers.value "as it was" (Concepts.Value.Integer 1) (read (List.nth history 1).snapshot);
  check Helpers.value "as it is" (Concepts.Value.Integer 3) (read (J.head journal).snapshot)

let suites () =
  suites ()
  @ [ ( "kernel/view",
        [ test_case "rebinding lands as one commit, or one name at a time" `Quick
            rebinding_lands_as_one_commit_or_one_name_at_a_time;
          test_case "a computed relation reads as of its snapshot" `Quick
            a_computed_relation_reads_as_of_its_snapshot ] ) ]