Fix task status parity with master

shared/src/logseq/core/graph_read.ml

@@ -59,6 +59,18 @@ let ref_eids db eid attr =
   List.of_seq (Ds.Db.datoms db Ds.Eavt ~e:eid ~a:attr ())
   |> List.filter_map (fun (datom : Ds.datom) -> Ds_value.ref_eid db attr datom.v)
 
+let block_classes_provide_property db eid attr =
+  match Ds.entid db "db/ident" (Ds.Keyword attr) with
+  | None -> false
+  | Some property ->
+    let visited = Hashtbl.create 8 in
+    let rec provides tag =
+      if Hashtbl.mem visited tag then false else (
+        Hashtbl.add visited tag ();
+        has_ref db tag "logseq.property.class/properties" property
+        || List.exists provides (ref_eids db tag "logseq.property.class/extends")) in
+    List.exists provides (ref_eids db eid "block/tags")
+
 let class_descendants db root_eid =
   let rec loop pending seen =
     match pending with
@@ -246,9 +258,12 @@ let choice_for_eid decrypt_title db eid property =
   let selected =
     if selected = None && property = "logseq.property/status"
        && value db eid property = None
-       && entity_is_instance_of db eid "logseq.class/Task"
+       && (entity_is_instance_of db eid "logseq.class/Task"
+           || block_classes_provide_property db eid property)
     then default_task_status_eid db else selected in
-  Option.bind selected (choice_metadata decrypt_title db)
+  Option.bind selected (fun selected ->
+    if value db selected "db/ident" = Some (Ds.Keyword "logseq.property/empty-placeholder")
+    then None else choice_metadata decrypt_title db selected)
 
 let property_choices decrypt_title db property =
   match Ds.entid db "db/ident" (Ds.Keyword property) with

shared/src/logseq/core/graph_read.mli

@@ -15,6 +15,7 @@ val int_value : Datascript.value option -> int option
 val uuid_for_eid : Datascript.db -> int -> string option
 val has_ref : Datascript.db -> int -> string -> int -> bool
 val ref_eids : Datascript.db -> int -> string -> int list
+val block_classes_provide_property : Datascript.db -> int -> string -> bool
 val class_descendants : Datascript.db -> int -> int list
 val entity_is_instance_of : Datascript.db -> int -> string -> bool
 val tag_display_type : Datascript.db -> int -> string option

shared/src/logseq/core/outliner_effects.ml

@@ -70,6 +70,22 @@ let status_reference (status : Model.status) =
   | Some ident -> Ops.Ref_ident ident
   | None -> Ops.Ref_uuid status.uuid
 
+let stored_status_value db uuid =
+  Option.map (fun value ->
+    match Datascript_value.ref_eid db "logseq.property/status" value with
+    | Some eid ->
+      (match Graph_read.value db eid "db/ident" with
+       | Some (Datascript.Keyword ident) -> Ops.Ref_ident ident
+       | _ -> Ops.Ref_uuid (Option.get (Graph_read.uuid_for_eid db eid)))
+    | None -> invalid_arg "Invalid task status reference")
+    (Pending_projection.one_value db (Pending_projection.lookup uuid) "logseq.property/status")
+
+let expected_status (context : State.outliner_context) (block : Model.block) =
+  match context.db with
+  | Some db when Datascript.entid db "block/uuid" (Datascript.Uuid block.uuid) <> None ->
+    stored_status_value db block.uuid
+  | _ -> Option.map status_reference block.status
+
 let next_status_value (block : Model.block) =
   match block.status with
   | Some { Model.ident = Some "logseq.property/status.todo"; _ } ->
@@ -168,6 +184,12 @@ let command base_t now fresh_uuid context cmd =
   | State.Cycle_task_status uuid ->
     (match find_block context uuid with
      | Some block ->
+       let block = match context.db with
+         | Some db ->
+           (match Datascript.entid db "block/uuid" (Datascript.Uuid uuid) with
+            | Some eid -> {block with Model.status = Graph_read.status_for_eid (fun text -> Ok text) db eid}
+            | None -> block)
+         | None -> block in
        Ok
          (result
             [
@@ -176,10 +198,7 @@ let command base_t now fresh_uuid context cmd =
                    {
                      uuid;
                      attr = "logseq.property/status";
-                     expected =
-                       (match block.Model.status with
-                        | Some status -> Some (status_reference status)
-                        | None -> None);
+                     expected = expected_status context block;
                      value = next_status_value block;
                    });
             ]
@@ -196,10 +215,7 @@ let command base_t now fresh_uuid context cmd =
                    {
                      uuid = value.status_uuid;
                      attr = "logseq.property/status";
-                     expected =
-                       (match block.Model.status with
-                        | Some status -> Some (status_reference status)
-                        | None -> None);
+                     expected = expected_status context block;
                      value = Some value.status;
                    });
             ]

shared/src/logseq/core/outliner_effects.mli

@@ -33,6 +33,8 @@ val operation :
   Pending_ops.pending_intent ->
   Pending_ops.pending_operation
 val status_reference : Cache_model.status -> Pending_ops.semantic_value
+val stored_status_value :
+  Datascript.db -> string -> Pending_ops.semantic_value option
 val next_status_value : Cache_model.block -> Pending_ops.semantic_value option
 val append_result : outliner_effects -> outliner_effects -> outliner_effects
 val command :

shared/src/logseq/core/pending_projection.ml

@@ -345,13 +345,43 @@ let property_value db reference attr =
   | None -> None
 
 let property_txs db uuid attr value =
+  let eid = Option.get (Ds.entid db "block/uuid" (Ds.Uuid uuid)) in
+  let reference = lookup uuid in
+  let task = Ds.entid db "db/ident" (Ds.Keyword "logseq.class/Task") in
   let many = Option.fold ~none:false ~some:(fun spec -> spec.Ds.cardinality = Ds.Many)
       (List.assoc_opt attr db.Ds.schema) in
-  match many, value with
-  | true, Some (Ops.Set_value values) ->
-    Ds.RetractAttr (lookup uuid, attr) :: List.map (fun value ->
-      Ds.Add (lookup uuid, attr, datascript_value value)) values
-  | _, value -> [property_tx uuid attr value]
+  match attr, value with
+  | "logseq.property/status", None ->
+    let placeholder = Ds.entid db "db/ident" (Ds.Keyword "logseq.property/empty-placeholder") in
+    let direct = one_value db reference attr in
+    let empty = Option.fold ~none:false ~some:(fun id ->
+      Datascript_value.optional_ref_eid db attr direct = Some id) placeholder in
+    let tagged = Option.fold ~none:false ~some:(has_ref db eid "block/tags") task in
+    let other_properties = Option.fold ~none:[]
+      ~some:(fun id -> Graph_read.ref_eids db id "logseq.property.class/properties") task in
+    let has_other = List.exists (fun id ->
+      match Graph_read.value db id "db/ident" with
+      | Some (Ds.Keyword property) when property <> attr -> one_value db reference property <> None
+      | _ -> false) other_properties in
+    if empty then []
+    else if tagged && not has_other then
+      [Ds.RetractAttr (reference, attr);
+       Ds.Retract (reference, "block/tags", Some (Ds.Ref (Option.get task)))]
+    else if tagged || Graph_read.block_classes_provide_property db eid attr then
+      [Ds.Add (reference, attr, Ds.Ref_to (Ds.Ident "logseq.property/empty-placeholder"))]
+    else [property_tx uuid attr None]
+  | _, Some _ when List.mem attr ["logseq.property/status"; "logseq.property/scheduled"; "logseq.property/deadline"] ->
+    property_tx uuid attr value ::
+      (match task with
+       | Some task when not (Graph_read.block_classes_provide_property db eid attr) ->
+         [Ds.Add (reference, "block/tags", Ds.Ref task)]
+       | _ -> [])
+  | _ ->
+    match many, value with
+    | true, Some (Ops.Set_value values) ->
+      Ds.RetractAttr (reference, attr) :: List.map (fun value ->
+        Ds.Add (reference, attr, datascript_value value)) values
+    | _, value -> [property_tx uuid attr value]
 
 let property_value_attrs db (value : Ops.pending_property_value) =
   let owner = lookup value.owner_uuid in

shared/src/logseq/core/pending_pump.ml

@@ -311,6 +311,13 @@ let enqueue_capture session uuid title now status =
   List.fold_left
     (fun result operation ->
       let* () = result in
+      let operation = match operation.Ops.intent with
+        | Ops.Set_property change when change.attr = "logseq.property/status" ->
+          (match (So.base_outliner_context session).db with
+           | Some db -> {operation with Ops.intent = Ops.Set_property {change with
+               expected = Outliner_effects.stored_status_value db change.uuid}}
+           | None -> operation)
+        | _ -> operation in
       enqueue_semantic session operation)
     (Ok ()) operations
 

shared/src/logseq/core/rpc_session.ml

@@ -1399,15 +1399,25 @@ let send_tagged session input fields =
     let now = Option.value ~default:(now_ms ()) now in
     let text = String.trim text in
     if text = "" then Error "Enter text to capture" else
-    let* operations = capture_operations session uuid text now status in
+    let* operations = capture_operations session uuid text now None in
     match operations with
     | [] -> Error "The capture is unavailable"
     | first :: _ ->
       let operation = {first with Ops.operation_id = fresh_squuid ();
         intent = Ops.Atomic (List.map (fun (op : Ops.pending_operation) -> op.intent) operations)} in
       let tags = match input with `Assoc fields -> Option.value ~default:`Null (List.assoc_opt "tags" fields) | _ -> `Null in
       let* tag_intent = prepare_capture_tags session uuid tags operation now in
-      Ok {operation with Ops.intent = Ops.Atomic [operation.intent; tag_intent]}
+      let intent = Ops.Atomic [operation.intent; tag_intent] in
+      let* intent = match status with
+        | None -> Ok intent
+        | Some status ->
+          let* db = match query_db session with Some db -> Ok db | None -> Error "The graph is unavailable" in
+          let* tx = Pending_projection.compile db intent in
+          let db = Datascript.db_with tx db in
+          Ok (Ops.Atomic [intent; Ops.Set_property {Ops.uuid; attr = "logseq.property/status";
+            expected = Effects.stored_status_value db uuid;
+            value = Some (Effects.status_reference status)}]) in
+      Ok {operation with Ops.intent = intent}
   in
   match prepared with
   | Error message -> Rpc.failure "capture_failed" message

shared/test/logseq/composer_tag_test.ml

@@ -66,15 +66,31 @@ let invalid_tags_do_not_capture_or_create () = R.with_runtime (fun session runti
     check_eq (Datascript.entid (Graph_runtime.db runtime) "block/uuid" (Datascript.Uuid captured)) None)
     [tags [Q.alpha] ["Must not exist"]; tags ["missing"] []; tags [] [" "]])
 
-let inline_tags_and_status_survive () = R.with_runtime (fun session runtime _ ->
-  let status = `Assoc ["uuid", `String "00000002-7975-1727-0000-000000000001";
-    "ident", `String "logseq.property/status.todo"; "title", `String "Todo"] in
-  let response = Rpc_test.dispatch_json session "sendTagged" (J.to_string (`Assoc [
-    "uuid", `String captured; "text", `String "Note #Project"; "now", `Int 1792719000000;
-    "status", status; "tags", tags [] ["Mobile"]])) in
-  succeed response;
-  check_eq ~msg:"selected tags preserve tags typed in the note" (tag_titles runtime captured) ["Mobile"; "Project"];
-  check ~msg:"tagged tasks retain their status" (Editor_command_test.value runtime captured "logseq.property/status" <> None))
+let inline_tags_and_status_survive () =
+  List.iter (fun (method_, body, provides_status, expected_tags) ->
+    R.with_runtime (fun session runtime conn ->
+      if provides_status then (
+        ignore (Datascript.transact_conn conn [Datascript.Add (
+          Datascript.Lookup_ref ("block/uuid", Datascript.Uuid Q.project),
+          "logseq.property.class/properties", Datascript.Ref_to (Datascript.Ident "logseq.property/status"))]);
+        Graph_runtime.rebase runtime 42 [] [Q.project]);
+      let response = Rpc_test.dispatch_json session method_ (J.to_string (`Assoc [
+        "uuid", `String captured; "text", `String body; "now", `Int 1792719000000;
+        "status", `Assoc ["ident", `String "logseq.property/status.doing"; "title", `String "Doing";
+          "uuid", `String "00000002-7975-1727-0000-000000000002"];
+        "tags", tags (if provides_status then [Q.project] else []) ["Mobile"]])) in
+      succeed response;
+      check_eq ~msg:"capture preserves tags without a redundant task class"
+        (tag_titles runtime captured) expected_tags;
+      let db = Graph_runtime.db runtime in
+      let eid = Option.get (Datascript.entid db "block/uuid" (Datascript.Uuid captured)) in
+      let status = Option.bind (Graph_read.status_for_eid (fun value -> Ok value) db eid)
+        (fun status -> status.Cache_model.ident) in
+      check_eq ~msg:"tag defaults do not replace the selected status" status (Some "logseq.property/status.doing")))
+    ["sendTagged", "Note #Project", false, ["Mobile"; "Project"; "Task"];
+     "sendTagged", "Note #Task", false, ["Mobile"; "Task"];
+     "sendTagged", "Note", true, ["Mobile"; "Project"];
+     "sendTask", "Note #Task", false, ["Task"]]
 
 let assets_assign_tags_without_changing_the_filename () = R.with_runtime (fun session runtime conn ->
   let payload = ["uuid", `String captured; "title", `String "Photo.png"; "now", `Int 1792719000000;

shared/test/logseq/pending_projection_test.ml

@@ -46,6 +46,11 @@ let schema : (string * Ds.schema_attr) list =
     ("logseq.property.recycle/original-page", ref_attr);
     ("logseq.property.recycle/original-order", string_attr);
     ("logseq.property/status", ref_attr);
+    ("logseq.property/priority", ref_attr);
+    ("logseq.property/scheduled", number_attr);
+    ("logseq.property/deadline", number_attr);
+    ("logseq.property/default-value", ref_attr);
+    ("logseq.property.class/properties", many_ref);
     ("logseq.property.class/extends", many_ref);
     ("logseq.property.asset/type", string_attr);
     ("logseq.property.asset/size", number_attr);
@@ -1207,6 +1212,71 @@ let built_in_tag_db () =
         add 105 "block/uuid" (Ds.Uuid "done");
         add 105 "block/title" (Ds.String "Done")])
 
+let task_properties_follow_master_tag_and_clear_semantics () =
+  let status = "logseq.property/status" in
+  let db = with_tx (built_in_tag_db ())
+    [add 110 "db/ident" (Ds.Keyword status);
+     add 110 "logseq.property/default-value" (Ds.Ref 104);
+     add 111 "db/ident" (Ds.Keyword "logseq.property/priority");
+     add 112 "db/ident" (Ds.Keyword "logseq.property/scheduled");
+     add 113 "db/ident" (Ds.Keyword "logseq.property/deadline");
+     add 114 "db/ident" (Ds.Keyword "logseq.property/empty-placeholder");
+     add 114 "block/uuid" (Ds.Uuid "empty");
+     add 115 "db/ident" (Ds.Keyword "logseq.property/status.doing");
+     add 115 "block/uuid" (Ds.Uuid "doing");
+     add 115 "block/title" (Ds.String "Doing");
+     add 116 "logseq.property.class/extends" (Ds.Ref 103);
+     add 117 "logseq.property.class/properties" (Ds.Ref 110);
+     add 103 "logseq.property.class/properties" (Ds.Ref 110);
+     add 103 "logseq.property.class/properties" (Ds.Ref 111);
+     add 103 "logseq.property.class/properties" (Ds.Ref 112);
+     add 103 "logseq.property.class/properties" (Ds.Ref 113)] in
+  List.iter (fun (attr, selected) ->
+    List.iter (fun (owner, tags, adds_task) ->
+      let db = with_tx db (Ds.RetractAttr (Projection.lookup owner, "block/tags") ::
+        List.map (fun tag -> Ds.Add (Projection.lookup owner, "block/tags", Ds.Ref tag)) tags) in
+      let projected = apply_intent db (property owner attr None (Some selected)) in
+      let id = Option.get (Ds.entid projected "block/uuid" (Ds.Uuid owner)) in
+      check_eq ~msg:(owner ^ ": " ^ attr ^ " supplies Task only when needed")
+        (Read.has_ref projected id "block/tags" 103) adds_task;
+      List.iter (fun tag -> check (Read.has_ref projected id "block/tags" tag)) tags)
+      ["block", [], true; "page", [5], true; "block", [5], true;
+       "block", [116], false; "block", [117], attr <> status])
+    [status, Ops.Ref_ident "logseq.property/status.todo";
+     "logseq.property/scheduled", Ops.Int_value 100;
+     "logseq.property/deadline", Ops.Int_value 200];
+  let stale_block = Option.get (Read.block (fun text -> Ok text) db 10) in
+  let cycle db =
+    let context = Outliner_state.context ~db [stale_block] [] [] in
+    match Outliner_effects.interpret 42 (fun () -> 100) (fun () -> "cycle") context
+      [Outliner_state.Cycle_task_status "block"] with
+    | Error message -> fail message
+    | Ok result -> List.fold_left (fun db (op : Ops.pending_operation) -> apply_intent db op.intent)
+        db result.operations in
+  let selected db = Option.bind (Read.status_for_eid (fun text -> Ok text) db 10)
+      (fun status -> status.Cache_model.ident) in
+  List.iter (fun (tag, other) ->
+    let start = with_tx db ([add 10 "block/tags" (Ds.Ref tag)] @ other) in
+    let start = apply_intent start (property "block" status None
+        (Some (Ops.Ref_ident "logseq.property/status.todo"))) in
+    let doing = cycle start in
+    let done_ = cycle doing in
+    let cleared = cycle done_ in
+    check_eq (List.map selected [start; doing; done_; cleared; cycle cleared])
+      [Some "logseq.property/status.todo"; Some "logseq.property/status.doing";
+       Some "logseq.property/status.done"; None; Some "logseq.property/status.todo"];
+    let keep_task = other <> [] in
+    check_eq (Read.has_ref cleared 10 "block/tags" 103) keep_task;
+    check_eq (value cleared "block" status)
+      (if keep_task || tag <> 103 then Some (Ds.Ref 114) else None);
+    let cleared_again = apply_intent cleared (property "block" status
+      (if keep_task || tag <> 103 then Some (Ops.Ref_ident "logseq.property/empty-placeholder") else None) None) in
+    check_eq (value cleared_again "block" status) (value cleared "block" status))
+    [103, []; 103, [add 10 "logseq.property/priority" (Ds.Ref 104)];
+     103, [add 10 "logseq.property/scheduled" (Ds.Int64 100L)]; 116, []; 117, []];
+  let inherited = with_tx db [add 10 "block/tags" (Ds.Ref 116)] in
+  check_eq (selected (cycle inherited)) (Some "logseq.property/status.doing")
+
 let built_in_tags_initialize_behavior_and_render_through_cache () =
   List.iter (fun kind ->
     let db = apply_intent (built_in_tag_db ())
@@ -1287,7 +1357,9 @@ let asset_transcript_survives_persistence_and_projects_atomically () =
   check_eq (Ds.entid before "block/uuid" (Ds.Uuid "transcript")) None
 
 let cases =
-  [ case "built-in tags initialize behavior and render through cache"
+  [ case "task properties follow master tag and clear semantics"
+      task_properties_follow_master_tag_and_clear_semantics;
+    case "built-in tags initialize behavior and render through cache"
       built_in_tags_initialize_behavior_and_render_through_cache;
     case "inline built-in tags initialize behavior" inline_built_in_tags_initialize_behavior;
     case "existing display properties and tagged tasks are rendered"