diff --git a/app/application.ml b/app/application.ml index b80162b..e57a57a 100644 --- a/app/application.ml +++ b/app/application.ml @@ -1643,8 +1643,7 @@ type command = | Capture_asset of Journal_asset_import.event | Timeline_retry of string | Detail_open of string - | Detail_expand of string - | Detail_collapse of string + | Detail_visible_range of int64 * int64 | Detail_more of string | Detail_task_intent of string | Detail_submit of string @@ -2827,7 +2826,7 @@ module Detail_list = struct match row with | Journal_detail.More _ -> V.Native_list.row ~key:row_key ~separator:Hidden label - | Block { block; expanded; leaf; _ } -> + | Block { block; _ } -> let id = Journal_model.id block in let delete = bind_action on_action (Detail_delete id) in let open_block = bind_action on_action (Detail_open id) in @@ -2855,15 +2854,7 @@ module Detail_list = struct ~symbol:"doc.on.doc" ~on_press:(bind_action on_action (Copy_block id)) () - ] - |> fun actions -> - if leaf then actions else - V.Context_menu.action - ~key:(Ui.Key.string (if expanded then "collapse" else "expand")) - ~title:(if expanded then "Hide children" else "Show children") - ~on_press:(bind_action on_action - (if expanded then Detail_collapse id else Detail_expand id)) - () :: actions) + ]) () in V.Native_list.row ~key:row_key ~separator:Hidden ~context_menu label @@ -2921,29 +2912,25 @@ let detail_page { dispatch with send = (fun action -> dispatch.send (Detail_action (scope, action))) } in let on_action action = bind_action local action in - let button ~id ~command ~symbol title = - V.buttons - ~actions: - [ V.buttons_action - ~label:title - ~icon:symbol - ~text:title - ~on_press:(on_action command) - () - ] + let button ?(enabled = true) ~id ~command ~symbol title = + V.button + ~enabled + ~on_press:(on_action command) + ~child:(V.label ~title:(V.text title) ~icon:(V.symbol ~name:symbol ()) ()) () |> V.with_test_id (Ui.Test_id.string id) in let rows detail = List.map (function - | Journal_detail.More { parent_id; loading; error; _ } -> + | Journal_detail.More { parent_id; loading; enabled; error; _ } -> if loading then V.loading ~message:"Loading children" () else V.column (Option.to_list (Option.map live_region_text error) @ [ button + ~enabled ~id:("detail-more:" ^ parent_id) ~command:(Detail_more parent_id) ~symbol: @@ -2951,7 +2938,10 @@ let detail_page (if Option.is_some error then "Retry loading children" else "Load more") - ]) + ] + @ if enabled + then [] + else [ V.text "Waiting for another branch to finish" ]) | Block { block; depth; _ } -> let source = if Journal_model.task_state block = No_status @@ -2994,6 +2984,7 @@ let detail_page ~on_visible_range: (Ui.Event.Handler.create (function | Ui.Event.Payload.Visible_range range -> + local.send (Detail_visible_range (range.first_index, range.last_exclusive)); dispatch.send (Media_range ( media_presentation_scope state ~detail:true @@ -4932,6 +4923,28 @@ let start } | _ -> state))) in + let detail_drain_key state = + if not state.graph_ready + then None + else + Option.bind (Journal_routes.detail state.routes) (fun detail -> + Option.map + (fun block_id -> Journal_detail.session_id detail, block_id) + (Journal_detail.next_automatic_load detail)) + in + let prev_detail_drain_key = ref (detail_drain_key initial_state) in + let detail_drain_callback = function + | None -> Effect.ignore + | Some (session, block_id) -> + set_state_and_effect (fun state -> + match Journal_routes.detail state.routes with + | Some detail when state.graph_ready && Journal_detail.session_id detail = session + && Journal_detail.next_automatic_load detail = Some block_id -> + let detail, requests = Journal_detail.step detail Load_next in + { state with routes = Journal_routes.update_detail state.routes detail }, + Effect.many (List.map send requests) + | _ -> state, Effect.ignore) + in let prev_capture_imports_key = ref initial_state.capture_imports in let rec drain_imports () = if Hashtbl.length capture_staged_items > 0 || Queue.is_empty capture_import_queue @@ -5138,9 +5151,11 @@ let start let detail_event event = match Journal_routes.detail snapshot.routes with | None -> Effect.ignore - | Some detail -> - let detail, requests = Journal_detail.step detail event in - Effect.bind + | Some previous -> + let detail, requests = Journal_detail.step previous event in + if detail == previous && requests = [] + then Effect.ignore + else Effect.bind (update (fun state -> { state with routes = Journal_routes.update_detail state.routes detail })) ~f:(fun () -> Effect.many (List.map send requests)) @@ -5755,8 +5770,8 @@ let start update (fun state -> { state with timeline = Journal_timeline_state.retry_day state.timeline ~day })) | Detail_open value -> open_block value - | Detail_expand value -> detail_event (Set_branch_expanded (value, true)) - | Detail_collapse value -> detail_event (Set_branch_expanded (value, false)) + | Detail_visible_range (first, last) -> + detail_event (Observe_visible_range (first, last)) | Detail_more value -> detail_event (Load_more value) | Detail_task_intent value -> update_draft ~toggle:true value | Detail_retry -> @@ -6060,6 +6075,11 @@ let start then ( prev_timeline_drain_key := key; Effect.run (timeline_drain_callback key))); + (let key = detail_drain_key model in + if not (!prev_detail_drain_key = key) + then ( + prev_detail_drain_key := key; + Effect.run (detail_drain_callback key))); (let key = upload_context model in if not (!prev_upload_key = key) then ( @@ -7060,7 +7080,6 @@ module For_testing = struct | Attach_file | Open_block of string | Delete_block of string - | Set_expanded of string * bool | Load_more of string | Retry | Submit of string @@ -7090,8 +7109,6 @@ module For_testing = struct | Detail_action (_, Open_append) -> on_action Append | Detail_action (_, Detail_open id) -> on_action (Open_block id) | Detail_action (_, Detail_delete id) -> on_action (Delete_block id) - | Detail_action (_, Detail_expand id) -> on_action (Set_expanded (id, true)) - | Detail_action (_, Detail_collapse id) -> on_action (Set_expanded (id, false)) | Detail_action (_, Detail_more id) -> on_action (Load_more id) | Detail_action (_, Detail_retry) -> on_action Retry | Detail_action (_, Detail_submit source) -> on_action (Submit source) diff --git a/app/application.mli b/app/application.mli index d688ba0..ac854e5 100644 --- a/app/application.mli +++ b/app/application.mli @@ -52,7 +52,6 @@ module For_testing : sig | Attach_file | Open_block of string | Delete_block of string - | Set_expanded of string * bool | Load_more of string | Retry | Submit of string diff --git a/app/journal_detail.ml b/app/journal_detail.ml index 04aeb76..f520385 100644 --- a/app/journal_detail.ml +++ b/app/journal_detail.ml @@ -12,17 +12,42 @@ type branch = ; appended : string list ; continuation : Journal_graph_projection.block_cursor option ; loaded : bool - ; expanded : bool ; pending : (int64 * Journal_graph_projection.block_cursor option) option ; error : string option } +type row = + | Block of + { block : Journal_model.t + ; depth : int + } + | More of + { parent_id : string + ; depth : int + ; loading : bool + ; enabled : bool + ; error : string option + } + +type row_snapshot = + { snapshot_blocks : Journal_model.t Blocks.t + ; snapshot_branches : branch Blocks.t + ; snapshot_session : int64 + ; values : row list + ; indexed : row array + ; reading : bool + } + type t = { root_id : string ; blocks : Journal_model.t Blocks.t ; branches : branch Blocks.t ; session_number : int64 ; next_request : int64 + ; automatic_reads : int + ; materialized_blocks : int + ; visible_range : (int64 * int64) option + ; row_snapshot : row_snapshot option ref ; mode : mode ; pending : Journal_graph_request.t option ; child_capture : Journal_capture.t option @@ -39,22 +64,9 @@ type staged_delete = ; was_appended : bool } -type row = - | Block of - { block : Journal_model.t - ; depth : int - ; expanded : bool - ; leaf : bool - } - | More of - { parent_id : string - ; depth : int - ; loading : bool - ; error : string option - } - type event = - | Set_branch_expanded of string * bool + | Observe_visible_range of int64 * int64 + | Load_next | Load_more of string | Loaded of int64 * Journal_graph_projection.detail | Load_failed of int64 * bool * string @@ -67,6 +79,8 @@ type retained_composer = ; draft_pending : Journal_graph_request.t option } +let invalidate_rows (t : t) = { t with row_snapshot = ref None } + let equal_presentation (left : t) (right : t) = left == right || (left.root_id = right.root_id @@ -112,13 +126,14 @@ let restore_composer (t : t) draft = let capture = Journal_capture.rebind draft.draft_capture ~session_number:t.session_number in - { t with - child_capture = Some capture - ; session_number = - ID.Text_input.Session_id.to_int64 (Journal_capture.session_id capture) - ; mode = draft.draft_mode - ; pending = draft.draft_pending - }) + invalidate_rows + { t with + child_capture = Some capture + ; session_number = + ID.Text_input.Session_id.to_int64 (Journal_capture.session_id capture) + ; mode = draft.draft_mode + ; pending = draft.draft_pending + }) ;; let complete_retained_composer draft ~child ~parent = @@ -147,7 +162,6 @@ let empty_branch = ; appended = [] ; continuation = None ; loaded = false - ; expanded = false ; pending = None ; error = None } @@ -173,10 +187,13 @@ let create ~session_number (detail : Journal_graph_projection.detail) = children = List.map Journal_model.id detail.children.blocks ; continuation = detail.children.continuation ; loaded = true - ; expanded = true } ; session_number ; next_request = Int64.mul session_number 1_000_000L + ; automatic_reads = 0 + ; materialized_blocks = 1 + List.length detail.children.blocks + ; visible_range = None + ; row_snapshot = ref None ; mode = Reading ; pending = None ; child_capture = None @@ -248,58 +265,170 @@ let map_retained_capture draft ~f = { draft with draft_capture = capture; draft_mode = Reading; draft_pending = None }) ;; -let expanded (t : t) ~block_id = (branch t block_id).expanded let continuation (t : t) ~parent_id = (branch t parent_id).continuation let request_back _ = `Close -let load (t : t) id = - match Blocks.find_opt id t.blocks with - | None -> t, [] - | Some _ -> +(* Root is level one; typography independently caps at three levels. *) +let maximum_depth = 9 +let maximum_automatic_reads = 128 +let page_limit = 128 +let maximum_materialized_blocks = 384 + +(* Zero descendant count is unknown until a branch returns its own page. *) +let needs_children current = not current.loaded + +(* The snapshot belongs to this outline owner. Structural transitions allocate + a fresh cell; draft/range/budget changes share the existing pure snapshot. *) +let snapshot (t : t) = + match !(t.row_snapshot) with + | Some cached + when cached.snapshot_blocks == t.blocks + && cached.snapshot_branches == t.branches + && cached.snapshot_session = t.session_number -> cached + | _ -> + let reading = + Blocks.exists (fun _ (branch : branch) -> branch.pending <> None) t.branches + in + let rec visit ancestors depth id rows = + if depth > maximum_depth || List.mem id ancestors + then rows + else ( + match Blocks.find_opt id t.blocks with + | None -> rows + | Some block -> + let current = branch t id in + let rows = Block { block; depth } :: rows in + if depth = maximum_depth + then rows + else ( + let rows = + List.fold_left + (fun rows child -> visit (id :: ancestors) (depth + 1) child rows) + rows + current.children + in + if + needs_children current + || current.error <> None + || current.continuation <> None + then + More + { parent_id = id + ; depth = depth + 1 + ; loading = current.pending <> None + ; enabled = not reading + ; error = current.error + } + :: rows + else rows)) + in + let values = List.rev (visit [] 0 t.root_id []) in + let cached = + { snapshot_blocks = t.blocks + ; snapshot_branches = t.branches + ; snapshot_session = t.session_number + ; values + ; indexed = Array.of_list values + ; reading + } + in + t.row_snapshot := Some cached; + cached +;; + +let rows (t : t) = (snapshot t).values +let read_pending (t : t) = (snapshot t).reading + +let next_automatic_load (t : t) = + if + t.automatic_reads >= maximum_automatic_reads + || t.materialized_blocks + page_limit > maximum_materialized_blocks + then None + else ( + match t.visible_range with + | None -> None + | Some (first, last) -> + let current_rows = snapshot t in + if current_rows.reading + then None + else ( + let bounded index = + Int64.to_int + (Int64.min (Int64.of_int (Array.length current_rows.indexed)) index) + in + let last = bounded last in + let rec find index = + if index >= last + then None + else ( + let id, depth = + match current_rows.indexed.(index) with + | Block { block; depth } -> Journal_model.id block, depth + | More { parent_id; depth; _ } -> parent_id, depth - 1 + in + let current = branch t id in + if depth < maximum_depth && needs_children current && current.error = None + then Some id + else find (index + 1)) + in + find (bounded first))) +;; + +let load ?(automatic = false) (t : t) id = + if + read_pending t + || ((not automatic) + && not + (List.exists + (function + | More { parent_id; _ } -> parent_id = id + | Block _ -> false) + (rows t))) + then t, [] + else ( let current = branch t id in - if - Option.is_some current.pending - || (current.loaded && current.continuation = None && current.error = None) - then t, [] - else ( - let generation = t.next_request in - let request = - Journal_graph_request.Load_detail - { block_id = id - ; after = current.continuation - ; limit = 128 - ; request_generation = generation - } - in - ( { t with + let generation = t.next_request in + let request = + Journal_graph_request.Load_detail + { block_id = id + ; after = current.continuation + ; limit = page_limit + ; request_generation = generation + } + in + ( invalidate_rows + { t with next_request = Int64.succ generation ; branches = Blocks.add id { current with - expanded = true - ; pending = Some (generation, current.continuation) + pending = Some (generation, current.continuation) ; error = None } t.branches } - , [ request ] )) + , [ request ] )) ;; let step (t : t) = function + | Observe_visible_range (first, last) -> + let first = Int64.max 0L first in + let range = Some (first, Int64.max first last) in + (if range = t.visible_range then t else { t with visible_range = range }), [] | Append_failed (block_id, message) -> (if pending_child t.pending block_id then { t with mode = Failed message } else t), [] - | Set_branch_expanded (id, expanded) -> - if not (Blocks.mem id t.blocks) - then t, [] - else ( - let current = branch t id in - if current.expanded = expanded - then t, [] - else if (not expanded) || current.loaded || current.pending <> None - then { t with branches = Blocks.add id { current with expanded } t.branches }, [] - else load t id) - | Load_more id -> load t id + | Load_next -> + (match next_automatic_load t with + | None -> t, [] + | Some id -> + load ~automatic:true { t with automatic_reads = t.automatic_reads + 1 } id) + | Load_more id -> + let next, requests = load t id in + ( (if requests = [] + then next + else { next with automatic_reads = 0; materialized_blocks = 0 }) + , requests ) | Loaded (generation, detail) -> let id = Journal_model.id detail.Journal_graph_projection.root in let current = branch t id in @@ -341,68 +470,42 @@ let step (t : t) = function (max (List.length children) (Journal_model.child_count detail.root)) |> Result.get_ok in - ( { t with - blocks = Blocks.add id root blocks - ; branches = Blocks.add id next t.branches - } + ( invalidate_rows + { t with + materialized_blocks = + t.materialized_blocks + List.length detail.children.blocks + ; blocks = Blocks.add id root blocks + ; branches = Blocks.add id next t.branches + } , [] ) | _ -> t, []) | Load_failed (generation, stale_cursor, message) -> - let branches = - Blocks.map - (fun (current : branch) -> + let matches = + Blocks.exists + (fun _ (current : branch) -> match current.pending with - | Some (expected, _) when generation = expected -> - { current with - pending = None - ; error = Some message - ; continuation = (if stale_cursor then None else current.continuation) - ; loaded = current.loaded && not stale_cursor - } - | _ -> current) + | Some (expected, _) -> expected = generation + | None -> false) t.branches in - { t with branches }, [] -;; - -let rows (t : t) = - let rec visit seen depth id = - if List.mem id seen - then [] + if not matches + then t, [] else ( - match Blocks.find_opt id t.blocks with - | None -> [] - | Some block -> - let current = branch t id in - let leaf = - current.loaded && current.children = [] && current.continuation = None - in - let row = Block { block; depth; expanded = current.expanded; leaf } in - if not current.expanded - then [ row ] - else ( - let children = - List.concat_map (visit (id :: seen) (depth + 1)) current.children - in - let more = - if - (not current.loaded) - || current.pending <> None - || current.error <> None - || current.continuation <> None - then - [ More - { parent_id = id - ; depth = depth + 1 - ; loading = current.pending <> None - ; error = current.error - } - ] - else [] - in - row :: (children @ more))) - in - visit [] 0 t.root_id + let branches = + Blocks.map + (fun (current : branch) -> + match current.pending with + | Some (expected, _) when generation = expected -> + { current with + pending = None + ; error = Some message + ; continuation = (if stale_cursor then None else current.continuation) + ; loaded = current.loaded && not stale_cursor + } + | _ -> current) + t.branches + in + invalidate_rows { t with branches }, []) ;; let row_key = function @@ -488,7 +591,9 @@ let retry (t : t) = let apply_block (t : t) block = let id = Journal_model.id block in - if Blocks.mem id t.blocks then { t with blocks = Blocks.add id block t.blocks } else t + if Blocks.mem id t.blocks + then invalidate_rows { t with blocks = Blocks.add id block t.blocks } + else t ;; let reconcile_children (t : t) (detail : Journal_graph_projection.detail) = @@ -521,20 +626,21 @@ let reconcile_children (t : t) (detail : Journal_graph_projection.detail) = | _ -> false) current.children in - { t with - blocks = add_blocks t.blocks (detail.root :: detail.children.blocks) - ; branches = - Blocks.add - id - { current with - children - ; loaded = true - ; continuation = detail.children.continuation - ; pending = None - ; error = None - } - t.branches - }) + invalidate_rows + { t with + blocks = add_blocks t.blocks (detail.root :: detail.children.blocks) + ; branches = + Blocks.add + id + { current with + children + ; loaded = true + ; continuation = detail.children.continuation + ; pending = None + ; error = None + } + t.branches + }) ;; let apply_child_created (t : t) ~child ~parent = @@ -542,35 +648,37 @@ let apply_child_created (t : t) ~child ~parent = then ( let current = branch t t.root_id in let id = Journal_model.id child in - { t with - blocks = add_blocks t.blocks [ child; parent ] - ; branches = - Blocks.add - t.root_id - { expanded = true - ; appended = id :: current.appended - ; children = List.filter (( <> ) id) current.children @ [ id ] - ; loaded = - current.loaded && current.continuation = None && current.pending = None - ; continuation = None - ; pending = None - ; error = None - } - t.branches - ; mode = Reading - ; pending = None - ; session_number = - Int64.succ - (Option.fold - ~none:t.session_number - ~some:(fun capture -> - ID.Text_input.Session_id.to_int64 (Journal_capture.session_id capture)) - t.child_capture) - ; child_capture = None - ; composer_revision = Int64.succ t.composer_revision - ; reveal_id = Some id - ; reveal_outcome = None - }) + invalidate_rows + { t with + blocks = add_blocks t.blocks [ child; parent ] + ; branches = + Blocks.add + t.root_id + { appended = id :: current.appended + ; children = List.filter (( <> ) id) current.children @ [ id ] + ; loaded = + current.loaded && current.continuation = None && current.pending = None + ; continuation = None + ; pending = None + ; error = None + } + t.branches + ; mode = Reading + ; pending = None + ; automatic_reads = 0 + ; materialized_blocks = 0 + ; session_number = + Int64.succ + (Option.fold + ~none:t.session_number + ~some:(fun capture -> + ID.Text_input.Session_id.to_int64 (Journal_capture.session_id capture)) + t.child_capture) + ; child_capture = None + ; composer_revision = Int64.succ t.composer_revision + ; reveal_id = Some id + ; reveal_outcome = None + }) else t ;; @@ -624,7 +732,7 @@ let stage_delete (t : t) ~block_id = | None -> blocks in Some - ( { t with blocks; branches } + ( invalidate_rows { t with blocks; branches } , { root_id = block_id ; blocks = removed ; branches = removed_branches @@ -679,7 +787,7 @@ let undo_delete (t : t) (staged : staged_delete) = |> Result.get_ok)) blocks )) in - { t with blocks; branches } + invalidate_rows { t with blocks; branches } ;; let reveal_outcome t = t.reveal_outcome diff --git a/app/journal_detail.mli b/app/journal_detail.mli index e94b35a..a6d7dc6 100644 --- a/app/journal_detail.mli +++ b/app/journal_detail.mli @@ -12,18 +12,18 @@ type row = | Block of { block : Journal_model.t ; depth : int - ; expanded : bool - ; leaf : bool } | More of { parent_id : string ; depth : int ; loading : bool + ; enabled : bool ; error : string option } type event = - | Set_branch_expanded of string * bool + | Observe_visible_range of int64 * int64 + | Load_next | Load_more of string | Loaded of int64 * Journal_graph_projection.detail | Load_failed of int64 * bool * string @@ -39,10 +39,21 @@ val root : t -> Journal_model.t val find_block : t -> block_id:string -> Journal_model.t option val children : t -> Journal_model.t list val children_of : t -> parent_id:string -> Journal_model.t list -val expanded : t -> block_id:string -> bool val continuation : t -> parent_id:string -> Journal_graph_projection.block_cursor option val rows : t -> row list val row_key : row -> string + +(** Next bounded first-page read demanded by the native visible index range. + Before the first observation no automatic read is admitted. Each round + reserves complete 128-item pages against a conservative 384-block counter + and at most 128 reads. Initially the counter includes the root and its + projection page. A successfully admitted explicit action starts a new + round counting returned pages; earlier explicit rows and external updates + remain available and are not globally truncated. + Continuations and + failed reads remain explicit Load more actions. *) +val next_automatic_load : t -> string option + val step : t -> event -> t * Journal_graph_request.t list val mode : t -> mode val session_id : t -> ID.Text_input.session_id diff --git a/swift/JournalChrome.swift b/swift/JournalChrome.swift index 21e8cc2..468b7eb 100644 --- a/swift/JournalChrome.swift +++ b/swift/JournalChrome.swift @@ -52,7 +52,7 @@ struct JournalSheetDismissButton: SwiftUI.View { self.text = text self.id = id let tier = min(2, max(0, level)) - _size = ScaledMetric(wrappedValue: [26, 21, 17][tier], relativeTo: .body) + _size = ScaledMetric(wrappedValue: [24, 19, 15][tier], relativeTo: .body) _targetLineHeight = ScaledMetric(wrappedValue: [40, 33, 27][tier], relativeTo: .body) } @@ -108,6 +108,8 @@ struct JournalSheetDismissButton: SwiftUI.View { content.frame(width: bounds.size.width, height: bounds.size.height) .scrollContentBackground(.hidden) #if os(iOS) + // Journals has no section title; named sections retain native indicators. + .scrollIndicators(properties.title == nil ? .hidden : .automatic) .scrollEdgeEffectHidden(true, for: .bottom) .scrollEdgeEffectStyle(.soft, for: .top) #endif diff --git a/test/application_view_test.ml b/test/application_view_test.ml index 0a10766..a5fd469 100644 --- a/test/application_view_test.ml +++ b/test/application_view_test.ml @@ -386,6 +386,8 @@ let run_favorites_native_visibility ?(check_hidden = false) ?(check_draft = false) ?(check_detail = false) + ?(check_detail_discovery = false) + ?(check_detail_wait = false) ?(check_copy = false) ?(check_navigation = false) ?(check_detail_row_action = false) @@ -431,6 +433,8 @@ let run_favorites_native_visibility let media_metadata_changed = Atomic.make false in let detail_fixture = Atomic.make false in let detail_initial_limit = Atomic.make None in + let discovery_reads = Atomic.make [] in + let detail_wait_release = Atomic.make false in let released_demands = Atomic.make 0 in let capture_root : P.v2_block_tree option Atomic.t = Atomic.make None in let capture_page : G.page option Atomic.t = Atomic.make None in @@ -957,13 +961,20 @@ let run_favorites_native_visibility ; revision_scope = V2_children_revision parent ; scope_revision = "children" ; items = - [ { value = { value with block = { value.block with parent } } - ; revision = "child" - } - ] + (List.init (if check_detail_wait then 2 else 1) (fun i -> + let value = if i = 0 then value else timeline_block 2 in + { P.value = { value with block = { value.block with parent } } + ; revision = "child" + })) ; next_cursor = None } - | V2_get_children { parent; _ } -> + | V2_get_children { parent; limit; _ } -> + if (check_detail_discovery || check_detail_wait) && G.Uuid.equal parent (uuid 2) + then Atomic.set discovery_reads (limit :: Atomic.get discovery_reads); + if check_detail_wait && G.Uuid.equal parent (uuid 2) then + while not (Atomic.get detail_wait_release) do + Eio.Time.Mono.sleep (W.Request_context.clock context) 0.001 + done; V2_children_outcome { parent ; revision_scope = V2_children_revision parent @@ -1232,6 +1243,7 @@ let run_favorites_native_visibility Fun.protect ~finally:(fun () -> Atomic.set child_release true; + Atomic.set detail_wait_release true; Atomic.set import_release true; Atomic.set acquire_release true; ignore (hooks.dispose ()); @@ -1263,6 +1275,131 @@ let run_favorites_native_visibility wait "Journals mounted" (fun () -> Option.is_some (find "accessibility-label" "Favorites") && Option.is_some (find "text" "Timeline fixture 2")); + if check_detail_wait then ( + Atomic.set detail_fixture true; + let root_list = Option.get (find "_extension" "journal-list") in + let label = Option.get (find "text" "Timeline fixture 0") in + dispatch (Lui_protocol.Press (ancestor_property label "press-enabled")); + let more_id = "detail-more:" ^ G.Uuid.to_string (uuid 3) in + wait "second unknown branch mounted" (fun () -> + Option.is_some (find "accessibility-identifier" more_id)); + Alcotest.(check bool) "idle branch has no wait explanation" true + (Option.is_none (find "text" "Waiting for another branch to finish")); + let list = Hashtbl.fold (fun id values found -> + if id <> root_list && List.assoc_opt "_extension" values = Some (`String "journal-list") + then Some id else found) props None |> Option.get in + let range first last = hooks.extension_event list "event" + (Yojson.Safe.to_string (`Assoc ["id", `Int 1; "payload", `String + (Yojson.Safe.to_string (`Assoc ["type", `String "visible_range"; + "first", `Int first; "last", `Int last]))])) |> consume in + range 2 3; + wait "first branch is pending" (fun () -> Atomic.get discovery_reads = [128]); + range 4 5; + let more = Option.get (find "accessibility-identifier" more_id) in + Alcotest.(check bool) "other branch stays disabled while first is pending" true + (List.assoc_opt "enabled" (Hashtbl.find props more) = Some (`Bool false)); + Alcotest.(check bool) "disabled branch explains serialized wait" true + (Option.is_some (find "text" "Waiting for another branch to finish")); + Atomic.set detail_wait_release true; + wait "wait explanation retires with pending read" (fun () -> + Option.is_none (find "text" "Waiting for another branch to finish")); + let navigator = Option.get (find "_extension" "navigation-stack") in + List.iter (fun name -> + let revision = List.assoc "revision" (Hashtbl.find props navigator) + |> Yojson.Safe.Util.to_int in + hooks.extension_event navigator name + (Yojson.Safe.to_string (`Assoc ["revision", `Int revision; "length", `Int 0])) + |> consume) ["path-changed"; "settled"]; + wait "wait scenario returns to root before shared checks" (fun () -> + not (Hashtbl.mem props list)); + Atomic.set detail_fixture false); + if check_detail_discovery + then ( + Atomic.set detail_fixture true; + let root_list = Option.get (find "_extension" "journal-list") in + let label = Option.get (find "text" "Timeline fixture 0") in + dispatch (Lui_protocol.Press (ancestor_property label "press-enabled")); + wait "Detail initial projection mounted" (fun () -> + Option.is_some + (find + "accessibility-identifier" + ("detail-block:" ^ G.Uuid.to_string (uuid 2)))); + for _ = 1 to 10 do + hooks.pump () |> consume; + Unix.sleepf 0.001 + done; + Alcotest.(check (list int)) + "no discovery before native range" + [] + (Atomic.get discovery_reads); + let more = + find "accessibility-identifier" ("detail-more:" ^ G.Uuid.to_string (uuid 2)) + |> Option.get + in + Alcotest.(check bool) + "unobserved More remains actionable" + true + (List.assoc_opt "enabled" (Hashtbl.find props more) = Some (`Bool true)); + let list = + Hashtbl.fold + (fun id values found -> + if + id <> root_list + && List.assoc_opt "_extension" values = Some (`String "journal-list") + then Some id + else found) + props + None + |> Option.get + in + let range () = + hooks.extension_event + list + "event" + {|{"id":1,"payload":"{\"type\":\"visible_range\",\"first\":2,\"last\":3}"}|} + |> consume + in + range (); + wait "first native range activates unknown visible child" (fun () -> + Atomic.get discovery_reads = [ 128 ]); + wait "authoritative empty child retires More" (fun () -> + Option.is_none (find "text" "Load more")); + for _ = 1 to 10 do + range (); + hooks.pump () |> consume + done; + Alcotest.(check (list int)) + "duplicate native ranges do not reread" + [ 128 ] + (Atomic.get discovery_reads); + Printf.printf + "FOLLOWUP_APPLICATION first_range reads=1 limit=128 repeated_range=10 \ + duplicate_reads=0\n\ + %!"; + let navigator = Option.get (find "_extension" "navigation-stack") in + let back name = + let revision = + List.assoc "revision" (Hashtbl.find props navigator) + |> Yojson.Safe.Util.to_int + in + hooks.extension_event + navigator + name + (Yojson.Safe.to_string + (`Assoc [ "revision", `Int revision; "length", `Int 0 ])) + |> consume + in + back "path-changed"; + back "settled"; + wait "native Back retires Detail visibility owner" (fun () -> + not (Hashtbl.mem props list)); + range (); + hooks.pump () |> consume; + Alcotest.(check (list int)) + "retired range cannot activate hidden reads" + [ 128 ] + (Atomic.get discovery_reads); + Atomic.set detail_fixture false); (* Detail/Routes already own text admission, retry, outline ordering and retained drafts, covered by their pure public reducer tests. They cannot reproduce native Capture placement, shared Composer wiring, @@ -2155,8 +2292,8 @@ let run_favorites_native_visibility if List.mem scenario - [ `Detail_collapse - ; `Detail_reopen + [ `Detail_range_exit + ; `Detail_range_reentry ; `Detail_shared ; `Detail_pending ; `Detail_offscreen @@ -2271,8 +2408,8 @@ let run_favorites_native_visibility native_path 0; assert_ready "natural Back without appearance replay" done - | `Detail_collapse - | `Detail_reopen + | `Detail_range_exit + | `Detail_range_reentry | `Detail_shared | `Detail_pending | `Detail_offscreen @@ -2350,29 +2487,23 @@ let run_favorites_native_visibility |> consume; settle () in - let expand expanded = - detail_event - (`Assoc - [ "type", `String "row_event" - ; "payload", `String (Yojson.Safe.to_string (`Assoc - [ "row", `String ("block:" ^ G.Uuid.to_string (uuid 1)) - ; "key", `String (if expanded then "expand" else "collapse") ])) - ]) - in - if scenario = `Detail_offscreen - then + let child_range visible = detail_event (`Assoc [ "type", `String "visible_range" ; "first", `Int 0 - ; "last", `Int 1 + ; "last", `Int (if visible then 2 else 1) ]) - else ( - expand false; - Alcotest.(check int) - "collapsed child native media node removed" - 0 - (List.length (child_files ()))); + in + child_range false; + if scenario = `Detail_preview + then ( + Alcotest.(check int) "offscreen preview retains its child lease" + 0 (Atomic.get released_files - before_released); + Alcotest.(check int) "offscreen child keeps its open preview" + 1 (List.length (previews ())); + dismiss_preview (List.hd (previews ())); + settle ()); if scenario = `Detail_pending then ( Alcotest.(check int) @@ -2400,7 +2531,7 @@ let run_favorites_native_visibility 1 (Atomic.get released_demands - before_demands); Printf.printf - "REVIEW_COLLAPSE acquired=%d released=%d collapse_release_delta=%d \ + "REVIEW_RANGE_EXIT acquired=%d released=%d range_release_delta=%d \ files=%d\n\ %!" (Atomic.get acquire_entered) @@ -2417,27 +2548,27 @@ let run_favorites_native_visibility if scenario = `Detail_preview then Alcotest.(check int) - "unmounted child removes preview path" + "dismissed offscreen child removes preview path" 0 (List.length (previews ())); - if scenario = `Detail_reopen + if scenario = `Detail_range_reentry then ( - expand true; - wait "reopened child remounts" (fun () -> + child_range true; + wait "visible child remounts" (fun () -> all "text" "Timeline fixture 1" |> List.exists (fun id -> within id detail_list)); appear_with_ancestors (waiting_for_row (child_label ())) detail_list; - wait "reopened child sends one new demand" (fun () -> + wait "visible child sends one new demand" (fun () -> List.length (Atomic.get demands) = 3); child_ready (); - wait "reopened child acquires fresh lease" (fun () -> + wait "visible child acquires fresh lease" (fun () -> Atomic.get acquire_entered = 3 && List.length (child_files ()) = 1); Alcotest.(check bool) - "reopened child gets a fresh native leaf" + "visible child gets a fresh native leaf" true (List.hd (child_files ()) <> old_leaf); - expand false; - wait "second collapse releases fresh child lease" (fun () -> + child_range false; + wait "second range exit releases fresh child lease" (fun () -> Atomic.get released_files = before_released + 2)); if scenario = `Detail_graph then ( @@ -2455,7 +2586,7 @@ let run_favorites_native_visibility else ( native_path 0; wait "entry retirement releases remaining root" (fun () -> - Atomic.get released_files = if scenario = `Detail_reopen then 3 else 2)) + Atomic.get released_files = if scenario = `Detail_range_reentry then 3 else 2)) | `Preview_offscreen | `Preview_navigation | `Preview_detail_pop @@ -4455,6 +4586,10 @@ let () = ~check_covered_update:true ~timeline_rows:50 ()) + ; Alcotest.test_case "Detail first native range activates discovery" `Quick (fun () -> + run_favorites_native_visibility ~check_detail_discovery:true ()) + ; Alcotest.test_case "Detail disabled branch explains serialized wait" `Quick (fun () -> + run_favorites_native_visibility ~check_detail_wait:true ()) ; Alcotest.test_case "Copy menus and replacement ownership" `Quick (fun () -> run_favorites_native_visibility ~check_copy:true ()) ; Alcotest.test_case "Detail native context menu dispatch" `Quick (fun () -> @@ -4581,30 +4716,30 @@ let () = ~media_rows:3 ~media_navigation:`Restore_early ()) - ; Alcotest.test_case "collapsed Detail retires media ownership" `Quick (fun () -> + ; Alcotest.test_case "Detail range exit retires media ownership" `Quick (fun () -> run_favorites_native_visibility ~media_rows:3 - ~media_navigation:`Detail_collapse + ~media_navigation:`Detail_range_exit ()) ; Alcotest.test_case "review preview offscreen reference" `Quick (fun () -> run_favorites_native_visibility ~media_rows:3 ~media_navigation:`Preview_offscreen ()) - ; Alcotest.test_case "Detail reopens after media retirement" `Quick (fun () -> + ; Alcotest.test_case "Detail range reentry after media retirement" `Quick (fun () -> run_favorites_native_visibility ~media_rows:3 - ~media_navigation:`Detail_reopen + ~media_navigation:`Detail_range_reentry ()) ; Alcotest.test_case - "Detail collapse preserves Timeline shared owner" + "Detail range exit preserves Timeline shared owner" `Quick (fun () -> run_favorites_native_visibility ~media_rows:3 ~media_navigation:`Detail_shared ()) - ; Alcotest.test_case "Detail collapse fences pending Acquire" `Quick (fun () -> + ; Alcotest.test_case "Detail range exit fences pending Acquire" `Quick (fun () -> run_favorites_native_visibility ~media_rows:3 ~media_navigation:`Detail_pending @@ -4622,7 +4757,7 @@ let () = ~media_rows:3 ~media_navigation:`Detail_graph ()) - ; Alcotest.test_case "Detail child removal retires its preview" `Quick (fun () -> + ; Alcotest.test_case "Detail offscreen preview retains until dismissal" `Quick (fun () -> run_favorites_native_visibility ~media_rows:3 ~media_navigation:`Detail_preview diff --git a/test/journal_routes_test.ml b/test/journal_routes_test.ml index 6ffddab..6ef40b4 100644 --- a/test/journal_routes_test.ml +++ b/test/journal_routes_test.ml @@ -1,6 +1,10 @@ module ID = Journal_ids module Ui = Journal_view +let observe_outline owner = + fst (Journal_detail.step owner (Observe_visible_range (0L, 10000L))) +;; + let fail format = Printf.ksprintf failwith format let require condition format = @@ -662,7 +666,7 @@ let test_append_restarts_partial_children_without_reusing_cursor () = require (List.exists (function - | D.More _ -> true + | D.More { parent_id; _ } -> parent_id = root_id | _ -> false) (D.rows created) = partial) @@ -757,8 +761,9 @@ let test_outline_branches_append_and_delete () = require (D.continuation initial ~parent_id:root_id = Some cursor) "root lost continuation"; - require (not (D.expanded initial ~block_id:child_id)) "deeper branch expanded eagerly"; - let opened, requests = D.step initial (Set_branch_expanded (child_id, true)) in + require (List.exists (function D.More { parent_id; _ } -> parent_id = child_id | _ -> false) (D.rows initial)) + "default outline has no child loading action"; + let opened, requests = D.step initial (Load_more child_id) in let generation = match requests with | [ Journal_graph_request.Load_detail @@ -848,7 +853,7 @@ let test_outline_branches_append_and_delete () = require (D.mode created = Reading && D.child_capture created = None) "append did not reset composer"; - require (D.expanded created ~block_id:child_id) "append discarded expanded branch"; + require (List.exists (function D.Block { block; _ } -> Journal_model.id block = Journal_model.id grandchild | _ -> false) (D.rows created)) "append discarded visible descendant"; let second = block ~id:"70000000-0000-4000-a000-000000000004" @@ -928,7 +933,7 @@ let test_outline_branches_append_and_delete () = (D.find_block deleted ~block_id:(Journal_model.id grandchild) = None) "staged descendant remained visible"; let restored = D.undo_delete deleted staged in - require (D.expanded restored ~block_id:child_id) "Undo lost expansion"; + require (List.exists (function D.Block { block; _ } -> Journal_model.id block = Journal_model.id grandchild | _ -> false) (D.rows restored)) "Undo lost visible descendant"; require (Option.is_some (D.find_block restored ~block_id:(Journal_model.id new_child))) "Undo discarded unrelated appended child"; @@ -1674,61 +1679,54 @@ let test_append_editor_session_after_save () = "parent navigation reused a completed editor session" ;; -let test_native_disclosure_state_is_idempotent () = +let test_automatic_outline_reads_are_bounded_and_idempotent () = let module D = Journal_detail in - let root = block () in - let child = - block - ~id:"70000000-0000-4000-a000-000000000002" - ~parent_id:(Some (Journal_model.id root)) - () - in - let initial = - D.create - ~session_number:91L - { root; children = { blocks = [ child ]; continuation = None } } - in - let same, requests = - D.step initial (Set_branch_expanded (Journal_model.id root, true)) - in - require - (D.expanded same ~block_id:(Journal_model.id root) && requests = []) - "repeated native expanded=true collapsed the branch"; - let child_id = Journal_model.id child in - let opened, requests = D.step same (Set_branch_expanded (child_id, true)) in - let generation = - match requests with - | [ Journal_graph_request.Load_detail { request_generation; limit = 128; _ } ] -> - request_generation - | _ -> fail "native disclosure did not admit a single bounded child request" - in - let duplicated, requests = D.step opened (Set_branch_expanded (child_id, true)) in - require - (D.expanded duplicated ~block_id:child_id && requests = []) - "duplicate expansion toggled state or restarted loading"; - let closed, _ = D.step duplicated (Set_branch_expanded (child_id, false)) in - let still_closed, requests = D.step closed (Set_branch_expanded (child_id, false)) in - require - ((not (D.expanded still_closed ~block_id:child_id)) && requests = []) - "repeated collapse reopened the branch"; - let reopening, requests = D.step still_closed (Set_branch_expanded (child_id, true)) in - require - (D.expanded reopening ~block_id:child_id && requests = []) - "reopening an in-flight branch stayed collapsed or duplicated the read"; - let still_closed, _ = D.step reopening (Set_branch_expanded (child_id, false)) in - let loaded, _ = - D.step - still_closed - (Loaded - (generation, { root = child; children = { blocks = []; continuation = None } })) - in - require - (not (D.expanded loaded ~block_id:child_id)) - "child completion reopened collapsed disclosure"; - let reopened, requests = D.step loaded (Set_branch_expanded (child_id, true)) in - require - (D.expanded reopened ~block_id:child_id && requests = []) - "reopening a loaded branch performed an unnecessary read" + let root = block ~child_count:130 () in + let children = List.init 130 (fun n -> + block ~id:(generated_block_id (1000 + n)) ~parent_id:(Some (Journal_model.id root)) + ~order:(Printf.sprintf "%06d" n) ~child_count:1 ()) in + let cursor : Journal_graph_projection.block_cursor = + { after_sibling_order = "000127"; after_block_id = Journal_model.id (List.nth children 127) + ; protocol_cursor = None } in + let owner = D.create ~session_number:91L + { root; children = { blocks = List.filteri (fun n _ -> n < 128) children + ; continuation = Some cursor } } |> observe_outline in + let owner, requests = D.step owner (Load_more (Journal_model.id root)) in + let generation = match requests with + | [ Journal_graph_request.Load_detail { request_generation; _ } ] -> request_generation + | _ -> fail "root continuation must remain explicit" in + let owner, _ = D.step owner (Loaded (generation, + { root; children = { blocks = List.filteri (fun n _ -> n >= 128) children; continuation = None } })) in + let rec finish owner n = + if n = 128 then owner else + let expected = Journal_model.id (List.nth children n) in + require (D.next_automatic_load owner = Some expected) "automatic order changed"; + let owner, requests = D.step owner Load_next in + let generation = match requests with + | [ Journal_graph_request.Load_detail { block_id; after = None; limit = 128; request_generation } ] + when block_id = expected -> request_generation + | _ -> fail "automatic branch did not issue its single bounded first page" in + let duplicate, requests = D.step owner Load_next in + require (requests = [] && D.next_automatic_load duplicate = None) + "automatic loading admitted a duplicate/concurrent read"; + let owner, _ = D.step duplicate (Loaded (generation, + { root = List.nth children n; children = { blocks = []; continuation = None } })) in + finish owner (n + 1) in + let owner = finish owner 0 in + require (D.next_automatic_load owner = None) "automatic branch budget exceeded 128"; + let manual = Journal_model.id (List.nth children 128) in + require (List.exists (function D.More { parent_id; loading = false; _ } -> parent_id = manual + | _ -> false) (D.rows owner)) "budget exhaustion removed Load more"; + let owner, requests = D.step owner (Load_more manual) in + let generation = match requests with + | [ Journal_graph_request.Load_detail { request_generation; _ } ] -> request_generation + | _ -> fail "manual Load more did not continue after automatic budget" in + let failed, _ = D.step owner (Load_failed (generation, false, "offline")) in + require (D.next_automatic_load failed = Some (Journal_model.id (List.nth children 129))) + "failed branch blocked another eligible branch or retried automatically"; + let retried, requests = D.step failed (Load_more manual) in + require (List.length requests = 1 && D.next_automatic_load retried = None) + "explicit retry must retain single-read admission" ;; let test_favorites_hidden_rows_do_not_block_pagination () = @@ -2106,7 +2104,7 @@ let test_typed_covered_failure_missing_and_branch () = in let owner = entry_detail ready a_id in let owner, requests = - Journal_detail.step owner (Set_branch_expanded (Journal_model.id child, true)) + Journal_detail.step owner (Load_more (Journal_model.id child)) in let generation = match requests with @@ -2617,6 +2615,128 @@ let test_retained_detail_picker_owner_and_terminal_delete () = "committed deletion revived its retired draft") ;; +(* Detail owns traversal and paging; all regressions exercise its public state, + admitted reads and completions, without injecting incorrect state. *) +let test_projected_unknown_children_are_read_once () = + let module G = Logseq_db_types.Graph_types in + let module P = Journal_graph_projection in + let uuid n = G.Uuid.of_string (Printf.sprintf "78000000-0000-4000-a000-%012d" n) |> Result.get_ok in + let page : G.page = + { uuid = uuid 100; name = "20260809"; title = "2026-08-09" + ; kind = G.Journal_page { journal_day = 20260809 } + ; created_at_ms = 1_786_204_800_000L; updated_at_ms = 1_786_204_800_000L + ; recycled = false; tags = []; properties = [] } in + let member n parent : P.block_member = + { block = + { uuid = uuid n; title = Printf.sprintf "Level %d" n; parent; page = page.uuid + ; order = "a"; created_at_ms = page.created_at_ms; updated_at_ms = page.updated_at_ms + ; refs = []; tags = []; properties = [] } + ; revision = "fixture-1" } in + let root = member 1 page.uuid in + let child = member 2 (uuid 1) in + let grandchild = member 3 (uuid 2) in + let project root children = + P.detail_on_page ~page ~time_context:{ localtime = Unix.gmtime } ~root + { G.items = children; continuation = None } + |> Result.get_ok in + let projection = project root [ child ] in + require (Journal_model.child_count (List.hd projection.children.blocks) = 0) + "public projection fixture must retain unknown child count"; + let module D = Journal_detail in + let owner = D.create ~session_number:134L projection |> observe_outline in + let child_id = G.Uuid.to_string child.block.uuid in + require (D.next_automatic_load owner = Some child_id) + "projected zero child count is unknown and must admit discovery"; + let load owner (parent : P.block_member) children = + let owner, requests = D.step owner Load_next in + let generation = match requests with + | [ Journal_graph_request.Load_detail { block_id; limit = 128; after = None; request_generation } ] + when block_id = G.Uuid.to_string parent.P.block.uuid -> request_generation + | _ -> fail "projected unknown branch must admit one bounded first page" in + fst (D.step owner (Loaded (generation, project parent children))) in + let owner = load owner child [ grandchild ] in + let owner = load owner grandchild [] in + require (D.next_automatic_load owner = None) "confirmed empty leaf was read twice"; + require (List.filter_map (function D.Block { depth; _ } -> Some depth | _ -> None) + (D.rows owner) = [ 0; 1; 2 ]) "real projected descendants did not auto-expand"; + require (not (List.exists (function D.More _ -> true | _ -> false) (D.rows owner))) + "confirmed leaves retained a spurious Load more" +;; + +let test_detail_default_outline_depth_and_cycle_boundaries () = + let module D = Journal_detail in + let id n = generated_block_id (1300 + n) in + let chain = List.init 12 (fun n -> + block ~id:(id n) ~parent_id:(if n = 0 then None else Some (id (n - 1))) + ~child_count:(if n = 11 then 0 else 1) ()) in + let projection n : Journal_graph_projection.detail = + { root = List.nth chain n; children = + { blocks = [ List.nth chain (n + 1) ]; continuation = None } } in + let owner = D.create ~session_number:131L (projection 0) |> observe_outline in + require (List.exists (function D.More { parent_id; _ } -> parent_id = id 1 + | _ -> false) (D.rows owner)) + "default expanded child must expose loading/Load more without disclosure"; + let rec load owner n = + if n >= 9 then owner else + let next, requests = D.step owner Load_next in + let generation = match requests with + | [ Journal_graph_request.Load_detail { request_generation; limit = 128; _ } ] -> request_generation + | _ -> fail "visible descendant did not admit one bounded page" in + let next, _ = D.step next (Loaded (generation, projection n)) in + load next (n + 1) in + let owner = load owner 1 in + require (List.filter_map (function D.Block { depth; _ } -> Some depth | _ -> None) + (D.rows owner) = List.init 10 Fun.id) + "Detail must display ten data levels including the root"; + require (not (List.exists (function D.More { parent_id; _ } -> parent_id = id 9 + | _ -> false) (D.rows owner))) + "depth ten must not expose a read for depth eleven"; + require (D.next_automatic_load owner = None) "automatic traversal crossed the depth limit"; + let _, requests = D.step owner (Load_more (id 9)) in + require (requests = []) "depth limit admitted a hidden subtree read"; + let cycle = D.reconcile_children owner + { root = List.nth chain 2; children = { blocks = [ List.nth chain 0 ]; continuation = None } } in + require (List.filter_map (function D.Block { block; _ } -> Some (Journal_model.id block) + | _ -> None) (D.rows cycle) = [ id 0; id 1; id 2 ]) + "ancestor cycle must terminate without hiding valid ancestors"; + let leaf = block ~id:(id 20) ~parent_id:(Some (id 0)) ~child_count:0 () in + let leaf_owner = D.create ~session_number:132L + { root = List.hd chain; children = { blocks = [ leaf ]; continuation = None } } |> observe_outline in + let leaf_owner, requests = D.step leaf_owner Load_next in + let generation = match requests with + | [ Journal_graph_request.Load_detail { request_generation; _ } ] -> request_generation + | _ -> fail "unknown zero count must be read once" in + let leaf_owner, _ = D.step leaf_owner (Loaded (generation, + { root = leaf; children = { blocks = []; continuation = None } })) in + require (not (List.exists (function D.More { parent_id; _ } -> parent_id = id 20 + | _ -> false) (D.rows leaf_owner))) + "confirmed empty leaf must not offer another empty-page read"; + let _, requests = D.step leaf_owner (Load_more (id 20)) in + require (requests = []) "confirmed leaf admitted an unnecessary read" +;; + +let test_detail_serial_reads_and_retry_feedback () = + let module D = Journal_detail in + let root = block ~child_count:2 () in + let child n = block ~id:(generated_block_id (1400 + n)) + ~parent_id:(Some (Journal_model.id root)) () in + let a, b = child 1, child 2 in + let owner = D.create ~session_number:140L + { root; children = { blocks = [ a; b ]; continuation = None } } in + let owner, requests = D.step owner (Load_more (Journal_model.id a)) in + let generation = match requests with + | [ Journal_graph_request.Load_detail { request_generation; _ } ] -> request_generation + | _ -> fail "first branch must admit its bounded read" in + let same, requests = D.step owner (Load_more (Journal_model.id b)) in + require (requests = []) "Detail admitted concurrent automatic branch reads"; + let failed, _ = D.step same (Load_failed (generation, false, "offline")) in + require (List.exists (function D.More { parent_id; error = Some "offline"; loading = false; _ } -> + parent_id = Journal_model.id a | _ -> false) (D.rows failed)) + "failed read must remain visible and retryable"; + let _, requests = D.step failed (Load_more (Journal_model.id a)) in + require (List.length requests = 1) "visible failure cannot retry" +;; + let test_detail_128_item_pages_preserve_order_and_completion () = let module D = Journal_detail in let root = block () in @@ -2646,7 +2766,7 @@ let test_detail_128_item_pages_preserve_order_and_completion () = | _ -> fail "Detail paging must issue exactly one bounded read" in let initial = D.create ~session_number:128L { root; children = { blocks = [ parent ]; continuation = None } } in - let first, requests = D.step initial (Set_branch_expanded (parent_id, true)) in + let first, requests = D.step initial (Load_more parent_id) in let generation = request None requests in let first, _ = D.step first (Loaded (generation, page 0 128 (Some (cursor 128)))) in require (List.length (D.children_of first ~parent_id) = 128) @@ -2691,7 +2811,346 @@ let test_detail_retry_uses_128_item_first_page () = | _ -> fail "Detail retry lost its first-page owner" ;; +(* These regressions reproduce the review findings through Detail's public + owner, including native visibility observations and admitted completions. *) +let followup_block number parent = + block + ~id:(Printf.sprintf "79000000-0000-4000-a000-%012d" number) + ~parent_id:parent + ~order:(Printf.sprintf "%06d" number) + ~child_count:0 + () +;; + +let followup_page root children continuation : Journal_graph_projection.detail = + { root; children = { blocks = children; continuation } } +;; + +let followup_read owner event = + let owner, requests = Journal_detail.step owner event in + match requests with + | [ Journal_graph_request.Load_detail + { block_id; limit = 128; request_generation; after } + ] -> owner, block_id, request_generation, after + | _ -> fail "followup expected exactly one 128-item public read" +;; + +let followup_visible owner first last = + fst + (Journal_detail.step + owner + (Observe_visible_range (Int64.of_int first, Int64.of_int last))) +;; + +let followup_counts owner = + let rows = Journal_detail.rows owner in + ( List.length + (List.filter + (function + | Journal_detail.Block _ -> true + | _ -> false) + rows) + , List.length rows ) +;; + +let test_followup_branch_loading_preserves_unrelated_errors () = + let module D = Journal_detail in + let root = followup_block 1 None in + let a, b, c = + ( followup_block 2 (Some (Journal_model.id root)) + , followup_block 3 (Some (Journal_model.id root)) + , followup_block 4 (Some (Journal_model.id root)) ) + in + let owner = D.create ~session_number:151L (followup_page root [ a; b; c ] None) in + let owner, _, generation, _ = followup_read owner (Load_more (Journal_model.id a)) in + let owner, _ = D.step owner (Load_failed (generation, false, "A offline")) in + let owner, _, generation, _ = followup_read owner (Load_more (Journal_model.id b)) in + let more id state = + List.find + (function + | D.More { parent_id; _ } -> parent_id = id + | _ -> false) + (D.rows state) + in + (match more (Journal_model.id a) owner with + | D.More { loading = false; enabled = false; error = Some "A offline"; _ } -> () + | _ -> fail "unrelated pending branch replaced A's error/Retry with loading"); + (match more (Journal_model.id b) owner with + | D.More { loading = true; enabled = false; error = None; _ } -> () + | _ -> fail "pending B must own its loading feedback"); + (match more (Journal_model.id c) owner with + | D.More { loading = false; enabled = false; error = None; _ } -> () + | _ -> fail "idle C must be waiting, not loading"); + let refused, requests = D.step owner (Load_more (Journal_model.id a)) in + require + (refused == owner && requests = []) + "busy Retry reset state or admitted another read"; + let owner, _ = D.step owner (Loaded (generation, followup_page b [] None)) in + (match more (Journal_model.id a) owner with + | D.More { loading = false; enabled = true; error = Some "A offline"; _ } -> () + | _ -> fail "serialized completion did not restore A's Retry"); + ignore (followup_read owner (Load_more (Journal_model.id a))) +;; + +let test_followup_materialized_rows_are_bounded () = + let module D = Journal_detail in + List.iteri + (fun scenario (initial_count, pages) -> + let root = followup_block (10000 + (scenario * 1000)) None in + let children = + List.init initial_count (fun n -> + followup_block (10001 + (scenario * 1000) + n) (Some (Journal_model.id root))) + in + let owner = + D.create + ~session_number:(Int64.of_int (152 + scenario)) + (followup_page root children None) + |> fun owner -> followup_visible owner 0 10000 + in + let returned = ref 0 + and reads = ref 0 in + let owner = + List.fold_left + (fun owner width -> + require + (D.next_automatic_load owner <> None) + "bounded sparse page stopped too soon"; + let next, parent_id, generation, after = followup_read owner Load_next in + require (after = None) "auto read consumed a continuation"; + let refused, requests = D.step next (Load_more parent_id) in + require + (refused == next && requests = []) + "rejected manual read reset row budget"; + let parent = D.find_block next ~block_id:parent_id |> Option.get in + incr reads; + let blocks = + List.init width (fun n -> + followup_block + (20000 + (scenario * 1000) + (!reads * 128) + n) + (Some parent_id)) + in + returned := !returned + width; + fst (D.step next (Loaded (generation, followup_page parent blocks None)))) + owner + pages + in + let block_count, total_rows = followup_counts owner in + require + (block_count <= 384 && total_rows <= 768) + "auto expansion exceeds materialized/flat row bound: blocks=%d rows=%d" + block_count + total_rows; + require + (D.next_automatic_load owner = None) + "auto read has no full 128-row reservation"; + let same, requests = D.step owner Load_next in + require (same == owner && requests = []) "exhausted auto round kept reading"; + require + (List.exists + (function + | D.More { loading = false; enabled = true; _ } -> true + | _ -> false) + (D.rows owner)) + "row budget exhaustion removed explicit Load more"; + Printf.printf + "FOLLOWUP_METRIC bounded-%d initial=%d reads=%d limit=128 returned=%d blocks=%d \ + rows=%d\n\ + %!" + scenario + (initial_count + 1) + !reads + !returned + block_count + total_rows; + let parent_id = + List.find_map + (function + | D.More { parent_id; _ } -> Some parent_id + | _ -> None) + (D.rows owner) + |> Option.get + in + let next, _, generation, _ = followup_read owner (Load_more parent_id) in + let parent = D.find_block next ~block_id:parent_id |> Option.get in + let blocks = + List.init 128 (fun n -> + followup_block (40000 + (scenario * 1000) + n) (Some parent_id)) + in + let next, _ = + D.step next (Loaded (generation, followup_page parent blocks None)) + in + require + (D.next_automatic_load next <> None) + "successful explicit read did not reopen a bounded round") + [ 128, [ 128 ]; 127, [ 128; 127 ]; 1, [ 127; 1; 128 ] ] +;; + +let test_followup_visible_discovery_and_presentation_reuse () = + let module D = Journal_detail in + let root = followup_block 50000 None in + let children = + List.init 128 (fun n -> followup_block (50001 + n) (Some (Journal_model.id root))) + in + let owner = D.create ~session_number:156L (followup_page root children None) in + require + (D.next_automatic_load owner = None) + "Detail read offscreen before its first native range"; + let initial_rows = D.rows owner in + require + (D.rows owner == initial_rows) + "unchanged outline repeatedly rebuilt row snapshots"; + let owner = followup_visible owner 2 3 in + require + (D.rows owner == initial_rows + && D.equal_presentation owner (followup_visible owner 2 3)) + "range-only changes rebuilt presentation"; + let owner, target, generation, _ = followup_read owner Load_next in + require + (target = Journal_model.id (List.hd children)) + "visible More did not discover its off-window parent"; + let owner, _ = + D.step owner (Loaded (generation, followup_page (List.hd children) [] None)) + in + require + (D.next_automatic_load owner = Some (Journal_model.id (List.nth children 1))) + "completion did not remap the saved indexes when More disappeared"; + let owner, _, generation, _ = followup_read owner Load_next in + let owner, _ = + D.step owner (Loaded (generation, followup_page (List.nth children 1) [] None)) + in + require + (D.next_automatic_load owner = None) + "visible empty-leaf discovery cascaded to offscreen siblings"; + let rows = D.rows owner in + for _ = 1 to 25 do + let same = followup_visible owner 2 3 in + require + (same == owner && D.rows same == rows) + "repeated native range rebuilt state/rows"; + let same, requests = D.step same Load_next in + require + (same == owner && requests = [] && D.rows same == rows) + "repeated pump performed work" + done; + let draft = D.update_child_source owner "Unrelated draft edit" in + require (D.rows draft == rows) "composer edit rebuilt unchanged outline rows"; + let stale, _ = D.step draft (Loaded (0L, followup_page root [] None)) in + require (stale == draft && D.rows stale == rows) "stale completion rebuilt rows"; + let offscreen = followup_visible owner 5000 6000 in + require + (D.next_automatic_load offscreen = None && D.rows offscreen == rows) + "out-of-range viewport caused hidden reads"; + let blocks, flat = followup_counts owner in + Printf.printf + "FOLLOWUP_METRIC wide-empty initial=129 reads=2 limit=128 returned=0 blocks=%d \ + rows=%d repeat_range=25 duplicate_reads=0\n\ + %!" + blocks + flat +;; + +let test_followup_snapshot_invalidation_and_owner_isolation () = + let module D = Journal_detail in + let root = followup_block 60000 None in + let child = followup_block 60001 (Some (Journal_model.id root)) in + let owner = D.create ~session_number:157L (followup_page root [ child ] None) in + let rows = D.rows owner in + require (D.rows owner == rows) "same owner rebuilt rows"; + let other = D.create ~session_number:158L (followup_page root [ child ] None) in + require (D.rows other != rows) "row snapshot crossed Detail sessions"; + let changed = + block + ~id:(Journal_model.id child) + ~parent_id:(Some (Journal_model.id root)) + ~source:"Updated task/media source" + ~revision:"changed" + ~task_state:Done + ~child_count:0 + () + |> fun block -> Journal_model.with_tag_titles block ~tag_titles:[ "QA updated" ] + in + let old_owner = owner in + let owner = D.apply_block owner changed in + require + (D.rows owner != rows + && List.exists + (function + | D.Block { block; _ } -> + Journal_model.source block = "Updated task/media source" + && Journal_model.task_state block = Done + && Journal_model.tag_titles block = [ "QA updated" ] + | _ -> false) + (D.rows owner)) + "block attributes did not invalidate rows"; + require (D.rows old_owner == rows) "derived outline overwrote retained snapshot cache"; + let rows = D.rows owner in + let owner, staged = + D.stage_delete owner ~block_id:(Journal_model.id child) |> Option.get + in + require + (D.rows owner != rows && fst (followup_counts owner) = 1) + "delete retained stale rows"; + let deleted = D.rows owner in + let owner = D.undo_delete owner staged in + require + (D.rows owner != deleted && fst (followup_counts owner) = 2) + "Undo retained deleted rows"; + let owner = D.reconcile_children owner (followup_page root [] None) in + require (fst (followup_counts owner) = 1) "authoritative refresh retained removed rows"; + let owner = D.update_child_source owner "Appended QA block" in + let owner, request = + D.admit_child + owner + ~mutation_id:"79000000-0000-4000-9000-000000060001" + ~calendar_generation:1L + ~block_id:(Journal_model.id child) + ~sibling_order:"999" + ~creation_time:(creation_time 600) + in + require (request <> None) "append admission missing"; + let rows = D.rows owner in + let owner = D.apply_child_created owner ~child ~parent:root in + require + (D.rows owner != rows && fst (followup_counts owner) = 2) + "append retained stale rows"; + let owner = followup_visible owner 0 10 in + let owner, id, generation, _ = followup_read owner Load_next in + require (id = Journal_model.id child) "new append not discoverable"; + let owner, _ = D.step owner (Loaded (generation, followup_page child [] None)) in + require (D.next_automatic_load owner = None) "append leaf read repeated"; + Printf.printf + "FOLLOWUP_METRIC root-only reads=0 rows=1 append reads=1 returned=0 rows=%d\n%!" + (snd (followup_counts owner)) +;; + +let test_followup_review_regressions () = + let failures = ref [] in + List.iter + (fun (name, run) -> + try run () with + | error -> + Printf.eprintf "FOLLOWUP_RED %s: %s\n%!" name (Printexc.to_string error); + failures := name :: !failures) + [ "branch-specific loading", test_followup_branch_loading_preserves_unrelated_errors + ; "materialized row cap", test_followup_materialized_rows_are_bounded + ; ( "visible discovery and snapshot reuse" + , test_followup_visible_discovery_and_presentation_reuse ) + ; ( "snapshot invalidation and isolation" + , test_followup_snapshot_invalidation_and_owner_isolation ) + ]; + require + (!failures = []) + "Review regressions failed: %s" + (String.concat ", " (List.rev !failures)) +;; + let tests = + [ "PR63 public review regressions", test_followup_review_regressions + ] @ + [ "projected unknown children are read once", test_projected_unknown_children_are_read_once + ; "Detail default ten levels and cycle boundaries", test_detail_default_outline_depth_and_cycle_boundaries + ; "Detail serialized reads and retry feedback", test_detail_serial_reads_and_retry_feedback + ] @ [ ( "retained picker and terminal delete" , test_retained_detail_picker_owner_and_terminal_delete ) ; "typed path prefix and loading owners", test_typed_path_prefix_and_loading_owners @@ -2713,7 +3172,7 @@ let tests = ; ( "child refresh replaces opaque cursor" , test_child_refresh_replaces_cursor_and_fences_pending_read ) ; "hidden favorites pagination", test_favorites_hidden_rows_do_not_block_pagination - ; "native disclosure state is idempotent", test_native_disclosure_state_is_idempotent + ; "automatic outline reads are bounded and idempotent", test_automatic_outline_reads_are_bounded_and_idempotent ; "Detail 128-item pages preserve order", test_detail_128_item_pages_preserve_order_and_completion ; "Detail retry uses 128-item first page", test_detail_retry_uses_128_item_first_page ; "Append editor session after save", test_append_editor_session_after_save diff --git a/test/journal_semantics_test.ml b/test/journal_semantics_test.ml index 9fd6f0c..3be45cb 100644 --- a/test/journal_semantics_test.ml +++ b/test/journal_semantics_test.ml @@ -2388,7 +2388,7 @@ let test_detail_three_tiers_keep_deep_order_and_plain_rows () = |> fun t -> Journal_routes.apply_detail_response t ~request_generation:1L (projection root [ child; sibling ]) in let load detail parent children = - let detail, requests = Journal_detail.step detail (Set_branch_expanded (Journal_model.id parent, true)) in + let detail, requests = Journal_detail.step detail (Load_more (Journal_model.id parent)) in let generation = match requests with | [ Journal_graph_request.Load_detail { limit = 128; request_generation; _ } ] -> request_generation | _ -> fail "Expanding one branch must issue exactly one bounded page read" @@ -2399,6 +2399,8 @@ let test_detail_three_tiers_keep_deep_order_and_plain_rows () = |> fun t -> load t child [ grandchild ] |> fun t -> load t grandchild [ deep ] |> fun t -> load t deep [ deeper ] + |> fun t -> load t deeper [] + |> fun t -> load t sibling [] in let routes = Journal_routes.update_detail routes detail in let body = Application.For_testing.detail_page ~routes ~write_enabled:true ignore in @@ -2425,7 +2427,7 @@ let test_detail_three_tiers_keep_deep_order_and_plain_rows () = require (Yojson.Basic.Util.member "text" label <> `Null) "Detail drops long or Chinese text") expected) ;; -let test_detail_flat_branch_keeps_explicit_collapse_action () = +let test_detail_flat_branch_has_no_collapse_action () = let child = block ~id:"20000000-0000-4000-a000-000000000002" ~parent_id:block_id ~child_count:0 () in let projection : Journal_graph_projection.detail = { root = block (); children = { blocks = [ child ]; continuation = None } } in @@ -2436,8 +2438,19 @@ let test_detail_flat_branch_keeps_explicit_collapse_action () = let body = Application.For_testing.detail_page ~routes ~write_enabled:true (fun a -> actions := a :: !actions) in with_mounted (V.Body.Private.to_widget body) (fun app ops -> dispatch_row_action app (native_list_node (ops ())) ("block:" ^ block_id) "collapse"; - require (!actions = [ Application.For_testing.Set_expanded (block_id, false) ]) - "Removing disclosure chrome loses the existing bounded collapse action") + dispatch_row_action app (native_list_node (ops ())) ("block:" ^ block_id) "expand"; + require (!actions = []) "Detail retains a collapse/expand action"; + let payloads = List.filter_map (function + | Lui_protocol.SetExtensionProp (_, "payload", StringValue s) -> Some (Yojson.Basic.from_string s) + | _ -> None) (ops ()) in + let list = List.find (fun p -> Yojson.Basic.Util.member "sections" p <> `Null) payloads in + let rows = Yojson.Basic.Util.(list |> member "sections" |> to_list |> List.hd |> member "rows" |> to_list) in + List.iter (fun row -> + let menu = Yojson.Basic.Util.member "context_menu" row in + let actions = if menu = `Null then [] else Yojson.Basic.Util.(menu |> member "actions" |> to_list) in + require (not (List.exists (fun action -> + List.mem (Yojson.Basic.Util.member "key" action) [ `String "collapse"; `String "expand" ]) actions)) + "Detail menu advertises collapse/expand") rows) ;; (* Composition and native placement have no pure reducer owner. Exercise the @@ -2512,7 +2525,7 @@ let tests = ; "Bottom native inset retains Capture", test_bottom_controls_reuse_lui_inset_and_keep_capture ] @ [ "Detail three typography tiers and deep flat rows", test_detail_three_tiers_keep_deep_order_and_plain_rows - ; "Detail flat branch retains collapse", test_detail_flat_branch_keeps_explicit_collapse_action + ; "Detail flat branch removes collapse", test_detail_flat_branch_has_no_collapse_action ] @ [ "Detail shared Capture control", test_detail_uses_shared_capture_control ; ( "timeline asset child preview title" diff --git a/test/source_boundary_test.ml b/test/source_boundary_test.ml index e308e1d..bd21599 100644 --- a/test/source_boundary_test.ml +++ b/test/source_boundary_test.ml @@ -1522,13 +1522,13 @@ let () = ; "top_corner_radius" ]) [ "app/journal_visual_tokens.ml"; "app/journal_visual_tokens.mli" ]; + forbid_text root "app/application.ml" [ "Detail_expand"; "Detail_collapse" ]; + forbid_text root "app/journal_detail.ml" [ "Set_branch_expanded" ]; require_text root "app/application.ml" [ "Timeline_open_block" ; "Favorite_open_block" - ; "Detail_expand" - ; "Detail_collapse" ; "Detail_submit" ; "V.secure_field" ; "Graph_service.Submit_e2ee_password"