Show flashcard categories and open advanced card groups

shared/src/logseq/core/flashcard_decks.ml

@@ -61,22 +61,18 @@ let cards ~due_only db now uuid =
       | definition :: _ -> Option.value ~default:"" (G.entity_title (fun s -> Ok s) db definition)
       | [] -> "" in
     if String.trim source = "" then Ok (load db now)
-    else try
-      let opts : Dev_query.Db_query_dsl.exec_opts = {
-        opt_cards = true; opt_block_attrs = Some "[:db/id]"; opt_current_page_title = None;
-        opt_today_day = Dev_query.Time.local_date_of_journal_day (Dev_query.Time.local_tz ())
-          (Cache_model.journal_day_for_ms now)} in
-      match Dev_query.Db_query_dsl.execute_query db source opts with
+    else
+      match Query_block.render ~now ~remove_children_by_default:false db uuid with
+      | Some {error = Some message; _} -> Error message
       | None -> Error "This card group has an invalid query"
-      | Some rows ->
-        let matched = Hashtbl.create (List.length rows) in
+      | Some result ->
+        let matched = Hashtbl.create (List.length result.rows) in
         List.iter (function
-          | [D.Result_entity eid] -> Hashtbl.replace matched eid ()
-          | [D.Result_pull entity] -> Hashtbl.replace matched entity.D.pulled_id ()
-          | _ -> ()) rows;
+          | Query_block.Block block ->
+            Option.iter (fun eid -> Hashtbl.replace matched eid ())
+              (D.entid db "block/uuid" (D.Uuid block.uuid))
+          | Query_block.Cells _ -> ()) result.rows;
         Ok (load ~include_eid:(Hashtbl.mem matched) db now)
-    with Invalid_argument message | Failure message -> Error message
-       | _ -> Error "This card group's query could not be evaluated"
 
 let due_cards db now uuid = cards ~due_only:true db now uuid
 let all_cards db now uuid = cards ~due_only:false db now uuid

shared/src/logseq/core/query_block.ml

@@ -101,8 +101,9 @@ let filter_rows db ~instance owner definition remove_children rows =
 let source_for db definition =
   Option.value ~default:"" (Graph.string_value (Graph.value db definition "block/title"))
 
-let execute ?current_page ~instance db owner definition source =
-  let day = Cache_model.journal_day_for_ms (int_of_float (Unix.gettimeofday () *. 1000.)) in
+let execute ?current_page ?(now = int_of_float (Unix.gettimeofday () *. 1000.))
+    ?(remove_children_by_default = true) ~instance db owner definition source =
+  let day = Cache_model.journal_day_for_ms now in
   let opts : Dev.Db_query_dsl.exec_opts = {
     opt_cards = Graph.entity_is_instance_of db owner "logseq.class/Cards";
     opt_block_attrs = Some "[*]";
@@ -136,10 +137,12 @@ let execute ?current_page ~instance db owner definition source =
             Dev.execute_custom_query_typed db query inputs (forms (field "rules" config)) ctx
           | _ -> (match Dev.Db_query_dsl.execute_query db (Dev.Ds_wire.edn_of_query_form query_form) opts with
               | Some rows -> rows | None -> invalid_arg "Invalid query DSL") in
-        rows, field "result-transform" config, field "remove-block-children?" config <> Some (Ds.QueryFormBool false)
+        let remove_children = match field "remove-block-children?" config with
+          | Some (Ds.QueryFormBool value) -> value | _ -> remove_children_by_default in
+        rows, field "result-transform" config, remove_children
       | None ->
         (match Dev.Db_query_dsl.execute_query db source {opts with opt_block_attrs = Some "[:db/id]"} with
-         | Some rows -> rows, None, true
+         | Some rows -> rows, None, remove_children_by_default
          | None -> invalid_arg "Invalid query DSL") in
     let rows = filter_rows db ~instance owner definition remove_children query_rows in
     let block_results = List.for_all (function [cell] -> Option.is_some (eid_of_result cell) | _ -> false) rows in
@@ -171,7 +174,7 @@ let is_query db uuid =
   | Some eid -> query_eid db eid
   | None -> false
 
-let render ?current_page db uuid =
+let render ?current_page ?now ?remove_children_by_default db uuid =
   match Ds.entid db "block/uuid" (Ds.Uuid uuid) with
   | None -> None
   | Some instance ->
@@ -189,7 +192,7 @@ let render ?current_page db uuid =
           let current_page = match current_page with Some _ -> current_page | None ->
             Option.bind (List.nth_opt (Graph.ref_eids db instance "block/page") 0)
               (fun page -> Graph.string_value (Graph.value db page "block/title")) in
-          Some (execute ?current_page ~instance db eid definition !source)
+          Some (execute ?current_page ?now ?remove_children_by_default ~instance db eid definition !source)
         with error ->
           let message = match error with Invalid_argument message | Failure message -> message
             | _ -> Printexc.to_string error in

shared/src/logseq/core/query_block.mli

@@ -6,7 +6,7 @@ type result = {
   rows : row list;
   error : string option;
 }
-val render : ?current_page:string -> Datascript.db -> string -> result option
+val render : ?current_page:string -> ?now:int -> ?remove_children_by_default:bool -> Datascript.db -> string -> result option
 val owner_uuids : Datascript.db -> string list
 val to_yojson : (Cache_model.block -> Yojson.Basic.t) -> result -> Yojson.Basic.t
 

shared/src/logseq/model.ml

@@ -105,6 +105,7 @@ type flashcard =
   { flashcard_uuid : string
   ; question_hidden : string
   ; question_revealed : string
+  ; card_categories : sidebar_page list
   ; answer_rows : flashcard_answer_row list
   ; has_cloze : bool
   }

shared/src/logseq/model.mli

@@ -102,6 +102,7 @@ type flashcard =
   { flashcard_uuid : string
   ; question_hidden : string
   ; question_revealed : string
+  ; card_categories : sidebar_page list
   ; answer_rows : flashcard_answer_row list
   ; has_cloze : bool
   }

shared/src/logseq/response_snapshot.ml

@@ -231,6 +231,7 @@ let flashcard input =
       { Model.flashcard_uuid;
         question_hidden = block_markup_text false block;
         question_revealed = block_markup_text true block;
+        card_categories = sidebar_pages_member "references" block;
         answer_rows; has_cloze }
   | None -> None
 

shared/src/logseq/view_flashcards.ml

@@ -61,6 +61,16 @@ let flashcard_review_content model_source send : t =
                     ~value_signal:
                       (Signal.map View_base.flashcard_question model_source)
                     ~accessibility_identifier:"flashcard.question" [];
+                  keyed
+                    ~source:(Signal.map (fun model ->
+                      Option.fold ~none:[] ~some:(fun card -> card.Model.card_categories)
+                        (View_base.first_flashcard model)) model_source)
+                    ~key:(fun (category : Model.sidebar_page) -> category.uuid) ~cmp:String.compare
+                    ~mount:(fun source ->
+                      let category = Signal.sample source in
+                      text ~style_class:"footnote" ~foreground:"muted-foreground"
+                        ~value_signal:(Signal.map (fun (category : Model.sidebar_page) -> category.title) source)
+                        ~accessibility_identifier:("flashcard.category." ^ category.uuid) []);
                   if_
                     ~test:
                       (Signal.map View_base.flashcard_answer_rows_visible_

shared/test/logseq/app_test.ml

@@ -425,6 +425,7 @@ let flashcard uuid question_hidden question_revealed answer_rows has_cloze =
     Model.flashcard_uuid = uuid;
     question_hidden;
     question_revealed;
+    card_categories = [];
     answer_rows;
     has_cloze;
   }

shared/test/logseq/flashcard_decks_test.ml

@@ -290,6 +290,27 @@ let finish_deck_effect app session =
     | Error message -> fail message);
   succeeded
 
+let native_due_card_shows_its_linked_category () = with_runtime (fun session _ _ ->
+  ignore (Rpc_test.dispatch_json session "loadFlashcards" (string_of_int (now ())));
+  Q.with_ui App_test.kotlin_backend (Rpc_session.snapshot_visible session) (fun app ->
+    App_test.send app Model.ShowFlashcards; App_test.flush app;
+    let category = find app ("flashcard.category." ^ scope_page) in
+    check ~msg:"the due card displays its linked Topic page before revealing the answer" (category <> -1);
+    check_eq (App_test.property_string (Lui_app.runtime app) category Lui_protocol.TextValue) "Topic page"))
+
+let native_selects_an_advanced_saved_group () = with_runtime (fun session runtime conn ->
+  let query = "{:query [:find (pull ?b [*]) :where [?b :block/refs ?topic] [?topic :block/name \"topic page\"]]}" in
+  ignore (D.transact_conn conn [put page_query "block/title" (D.String query)]);
+  Graph_runtime.rebase runtime 42 [] [];
+  ignore (Rpc_test.dispatch_json session "loadFlashcards" (string_of_int (now ())));
+  Q.with_ui App_test.kotlin_backend (Rpc_session.snapshot_visible session) (fun app ->
+    App_test.send app Model.ShowFlashcards; App_test.flush app;
+    press app ("flashcards.deck.select." ^ page_deck);
+    check ~msg:"a saved group with an advanced query can be selected" (finish_deck_effect app session);
+    let selected = snapshot session in
+    check_eq (member "selectedUuid" (metadata selected)) (`String page_deck);
+    expect [Q.alpha; R.gamma] selected))
+
 let native_create_and_select_roundtrip () =
   List.iter (fun backend -> with_runtime (fun session runtime _ ->
     ignore (Rpc_test.dispatch_json session "loadFlashcards" (string_of_int (now ())));
@@ -473,6 +494,8 @@ let empty_and_unavailable_groups_do_not_offer_unrelated_practice () =
     check_eq (Graph_runtime.pending_operations runtime) [])) [App_test.ios_backend; App_test.kotlin_backend]
 
 let cases = [
+  case "due cards show the linked category on Android" native_due_card_shows_its_linked_category;
+  case "Android can select a saved group with an advanced query" native_selects_an_advanced_saved_group;
   case "both native hosts can repeatedly practice all cards in the completed group" native_practice_again_repeats_the_whole_selected_group;
   case "practice works without due cards and resets safely across groups and graphs" practice_when_nothing_is_due_preserves_scope_and_resets_on_navigation;
   case "empty and unavailable groups never practice unrelated cards" empty_and_unavailable_groups_do_not_offer_unrelated_practice;