Something went wrong. Try again.
Git-native issue tracker
Something went wrong. Try again.
52 kB · 1520 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521module Repo = Git_eio.Repositorymodule Row = Core.Row
let err_index fmt = Fmt.kstr (fun message -> Error message) fmt
type summary = { id : string; title : string; kind : string; status : Core.status; priority : int; triage : Row.triage; disclosure : Row.disclosure option; filed : string; holder : string option;}
type exploration_summary = { id : string; mode : Row.work_mode; phase : Exploration.phase option; attempt_count : int; critique_count : int;}
module Db = struct open Sqlite
let metadata = table "metadata" let meta_key = field metadata "key" text let meta_value = field metadata "value" text let issues = table "issues" let id = field issues "id" text let title = field issues "title" text let kind = field issues "kind" text let status = field issues "status" text let priority = field issues "priority" int let triage = field issues "triage" text let disclosure = field issues "disclosure" (nullable text) let filed = field issues "filed" text let holder = field issues "holder" (nullable text) let filed_at = field issues "filed_at" float let claimed_at = field issues "claimed_at" (nullable float) let closed_at = field issues "closed_at" (nullable float) let blocked = field issues "blocked" int let explorations = table "explorations" let exploration_id = field explorations "id" text let exploration_mode = field explorations "mode" text let exploration_phase = field explorations "phase" (nullable text) let attempt_count = field explorations "attempt_count" int let critique_count = field explorations "critique_count" int let summaries = table "summaries" let summary_id = field summaries "id" text let summary_json = field summaries "json" text let labels = table "labels" let issue_id = field labels "issue_id" text let label = field labels "label" text let dependencies = table "dependencies" let dependent_id = field dependencies "dependent_id" text let target_id = field dependencies "target_id" text let external_refs = table "external_refs" let external_key = field external_refs "external_key" text let external_issue_id = field external_refs "issue_id" text let imported_closures = table "imported_closures" let imported_id = field imported_closures "id" text let imported_reason = field imported_closures "reason" (nullable text) let imported_closed_at = field imported_closures "closed_at" text let ready = table "ready" let ready_id = field ready "id" text let ready_title = field ready "title" text let ready_priority = field ready "priority" int let ready_disclosure = field ready "disclosure" (nullable text) let ready_unblocks = field ready "unblocks" int let ready_json = field ready "row_json" text let ready_labels = table "ready_labels" let ready_label = field ready_labels "label" text let ready_issue = field ready_labels "issue_id" text let foreign_prerequisites = table "foreign_prerequisites" let foreign_dependent = field foreign_prerequisites "dependent_id" text let foreign_prerequisite = field foreign_prerequisites "target_id" text let anchors = table "anchors" let anchor_issue = field anchors "issue_id" text let anchor_ord = field anchors "ord" int let anchor_at = field anchors "at" text let anchor_text = field anchors "text" text let anchor_package = field anchors "package" (nullable text) let row_fields = table "row_fields" let fields_id = field row_fields "id" text let fields_json = field row_fields "json" text let foreign_dependents = table "foreign_dependents" let foreign_target = field foreign_dependents "target_id" text let foreign_count = field foreign_dependents "count" int let live_postings = table "live_postings" let live_term = field live_postings "term" text let live_ids = field live_postings "ids" text let closed_postings = table "closed_postings" let closed_term = field closed_postings "term" text let closed_ids = field closed_postings "ids" text let filing_masses = table "filing_masses" let mass_issue = field filing_masses "issue_id" text let mass = field filing_masses "mass" float
let schema = Schema.v [ Schema.table metadata [ coldef ~primary_key:true meta_key; coldef ~not_null:true meta_value; ]; Schema.table issues [ coldef ~primary_key:true id; coldef ~not_null:true title; coldef ~not_null:true kind; coldef ~not_null:true status; coldef ~not_null:true priority; coldef ~not_null:true triage; coldef disclosure; coldef ~not_null:true filed; coldef holder; coldef ~not_null:true filed_at; coldef claimed_at; coldef closed_at; coldef ~not_null:true blocked; ]; Schema.table explorations [ coldef ~primary_key:true exploration_id; coldef ~not_null:true exploration_mode; coldef exploration_phase; coldef ~not_null:true attempt_count; coldef ~not_null:true critique_count; ]; Schema.table summaries [ coldef ~not_null:true summary_id; coldef ~not_null:true summary_json; ]; Schema.table ~primary_key:[ key issue_id; key label ] labels [ coldef ~not_null:true issue_id; coldef ~not_null:true label ]; Schema.table ~primary_key:[ key dependent_id; key target_id ] dependencies [ coldef ~not_null:true dependent_id; coldef ~not_null:true target_id; ]; Schema.table external_refs [ coldef ~primary_key:true external_key; coldef ~not_null:true external_issue_id; ]; Schema.table imported_closures [ coldef ~primary_key:true imported_id; coldef imported_reason; coldef ~not_null:true imported_closed_at; ]; Schema.table ready [ coldef ~primary_key:true ready_id; coldef ~not_null:true ready_title; coldef ~not_null:true ready_priority; coldef ready_disclosure; coldef ~not_null:true ready_unblocks; coldef ~not_null:true ready_json; ]; Schema.table ~primary_key:[ key ready_label; key ready_issue ] ready_labels [ coldef ~not_null:true ready_label; coldef ~not_null:true ready_issue; ]; Schema.table ~primary_key:[ key foreign_dependent; key foreign_prerequisite ] foreign_prerequisites [ coldef ~not_null:true foreign_dependent; coldef ~not_null:true foreign_prerequisite; ]; Schema.table ~primary_key:[ key anchor_issue; key anchor_ord ] anchors [ coldef ~not_null:true anchor_issue; coldef ~not_null:true anchor_ord; coldef ~not_null:true anchor_at; coldef ~not_null:true anchor_text; coldef anchor_package; ]; Schema.table row_fields [ coldef ~primary_key:true fields_id; coldef ~not_null:true fields_json; ]; Schema.table foreign_dependents [ coldef ~primary_key:true foreign_target; coldef ~not_null:true foreign_count; ]; Schema.table live_postings [ coldef ~primary_key:true live_term; coldef ~not_null:true live_ids ]; Schema.table closed_postings [ coldef ~primary_key:true closed_term; coldef ~not_null:true closed_ids; ]; Schema.table filing_masses [ coldef ~primary_key:true mass_issue; coldef ~not_null:true mass ]; Schema.index "issues_by_status_priority" issues [ key status; key priority; key id ]; Schema.index "issues_by_disclosure" issues [ key disclosure; key id ]; Schema.index "issues_by_filed_at" issues [ key filed_at; key id ]; Schema.index "issues_by_closed_at" issues [ key closed_at; key id ]; Schema.index "issues_by_blocked" issues [ key blocked; key status ]; Schema.index "explorations_by_mode_phase" explorations [ key exploration_mode; key exploration_phase; key exploration_id ]; Schema.index "explorations_by_phase" explorations [ key exploration_phase; key exploration_id ]; Schema.index "labels_by_label" labels [ key label; key issue_id ]; Schema.index "dependencies_by_target" dependencies [ key target_id; key dependent_id ]; ]
let source_tree db = from metadata |> where (meta_key =. "source_tree") |> select1 meta_value |> run db
let prefix db = from metadata |> where (meta_key =. "prefix") |> select1 meta_value |> run db
let filtered ?status:status_filter ?priority_at_most ?label:label_filter ?(public = false) () = let q = from issues in let q = match label_filter with | None -> q | Some value -> q |> join labels ~on:(issue_id ==. id) |> where (label =. value) in let q = match status_filter with | None -> q | Some value -> q |> where (status =. value) in let q = match priority_at_most with | None -> q | Some value -> q |> where (priority <=. Int64.of_int value) in let q = if public then q |> where (is_null disclosure ||. (disclosure <>. Some "untriaged")) else q in q
let rows db ?status:status_filter ?priority_at_most ?label ?public () = filtered ?status:status_filter ?priority_at_most ?label ?public () |> select9 id title kind status priority triage disclosure filed holder |> order_by id `Asc |> run db
let titled db ?label ~public () = filtered ?label ~public () |> select2 id title |> order_by id `Asc |> run db
let ready_rows db ?label ~public () = let q = match label with | None -> from ready | Some value -> from ready_labels |> join ready ~on:(ready_id ==. ready_issue) |> where (ready_label =. value) in let q = if public then q |> where (is_null ready_disclosure ||. (ready_disclosure <>. Some "untriaged")) else q in q |> select5 ready_id ready_title ready_priority ready_unblocks ready_json |> run db
let ready_foreign_prerequisites db = from foreign_prerequisites |> select2 foreign_dependent foreign_prerequisite |> run db
let has_label db issue value = from labels |> where (issue_id =. issue) |> where (label =. value) |> select1 label |> run db <> []
let fields_rows db = from row_fields |> select2 fields_id fields_json |> run db
let exploration_rows db ?mode ?phase () = let q = from explorations in let q = match mode with | None -> q | Some value -> q |> where (exploration_mode =. value) in let q = match phase with | None -> q | Some value -> q |> where (exploration_phase =. Some value) in q |> select5 exploration_id exploration_mode exploration_phase attempt_count critique_count |> order_by exploration_id `Asc |> run db
let cross_store_dependents db = from foreign_dependents |> select2 foreign_target foreign_count |> run db
let status_of db issue = from issues |> where (id =. issue) |> select1 status |> run db
let live_rows db = from metadata |> where (meta_key =. "live_rows") |> select1 meta_value |> run db
let live_postings_of db term = from live_postings |> where (live_term =. term) |> select1 live_ids |> run db
let closed_postings_of db term = from closed_postings |> where (closed_term =. term) |> select1 closed_ids |> run db
let mass_of db issue = from filing_masses |> where (mass_issue =. issue) |> select1 mass |> run db
let candidate_of db issue = from issues |> where (id =. issue) |> select3 title status holder |> run db
let flow_rows db = from issues |> select9 id kind status priority triage filed_at claimed_at closed_at blocked |> run db
let dependency_rows db = from dependencies |> select2 dependent_id target_id |> run db
let anchor_rows db = from anchors |> select5 anchor_issue anchor_ord anchor_at anchor_text anchor_package |> run db
let external_ref_id db key = from external_refs |> where (external_key =. key) |> select1 external_issue_id |> run db
let imported_closure db key = from imported_closures |> where (imported_id =. key) |> select2 imported_reason imported_closed_at |> run db
let external_refs_prefix db prefix = from external_refs |> join issues ~on:(external_issue_id ==. id) |> where (like external_key (prefix ^ "%")) |> select3 external_key external_issue_id status |> order_by external_key `Asc |> run db |> List.filter (fun (key, _, _) -> String.starts_with ~prefix key)end
let path repo = Filename.concat (Fpath.to_string (Repo.git_dir repo)) "tk/index.sqlite"
let mkdir path = try Unix.mkdir path 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) when Sys.is_directory path -> ()
let status_name = function | Core.Open -> "open" | Claimed -> "claimed" | Landed -> "landed" | Closed -> "closed"
let status_of_name = function | "open" -> Core.Open | "claimed" -> Claimed | "landed" -> Landed | "closed" -> Closed | _ -> invalid_arg "sqlite index: invalid status"
let triage_name = function | Row.Filed -> "filed" | Validated -> "validated" | Ready -> "ready" | Stale -> "stale"
let triage_of_name = function | "filed" -> Row.Filed | "validated" -> Validated | "ready" -> Ready | "stale" -> Stale | _ -> invalid_arg "sqlite index: invalid triage"
let disclosure_name = function | Row.Untriaged -> "untriaged" | Triaged -> "triaged" | Published -> "published"
let disclosure_of_name = function | "untriaged" -> Row.Untriaged | "triaged" -> Triaged | "published" -> Published | _ -> invalid_arg "sqlite index: invalid disclosure"
let mode_name = function | Row.Delegate -> "delegate" | Routine -> "routine" | Deliberate -> "deliberate" | Learn -> "learn"
let mode_of_name = function | "delegate" -> Row.Delegate | "routine" -> Routine | "deliberate" -> Deliberate | "learn" -> Learn | _ -> invalid_arg "sqlite index: invalid exploration mode"
let phase_name = function | Exploration.Diverge -> "diverge" | Converge -> "converge" | Synthesised -> "synthesised" | Judged -> "judged" | Executing -> "executing" | Learning -> "learning" | Understood -> "understood"
let phase_of_name = function | "diverge" -> Exploration.Diverge | "converge" -> Converge | "synthesised" -> Synthesised | "judged" -> Judged | "executing" -> Executing | "learning" -> Learning | "understood" -> Understood | _ -> invalid_arg "sqlite index: invalid exploration phase"
let summary_json (row : summary) = let field key value = Json.member (Json.name key) value in Json.object' [ field "id" (Json.string row.id); field "title" (Json.string row.title); field "kind" (Json.string row.kind); field "status" (Json.string (status_name row.status)); field "priority" (Json.int row.priority); field "triage" (Json.string (triage_name row.triage)); field "disclosure" (match row.disclosure with | None -> Json.null () | Some value -> Json.string (disclosure_name value)); field "filed" (Json.string row.filed); field "holder" (match row.holder with | None -> Json.null () | Some holder -> Json.string holder); ] |> Json.Value.to_string
let summary_of_row row : summary = { id = Row.id row; title = Row.title row; kind = Row.kind row; status = Row.status row; priority = Row.priority row; triage = Row.triage row; disclosure = Row.disclosure row; filed = Row.filed row; holder = Option.map fst (Row.claim row); }
let parse_instant value = Timestamp.Rfc3339.parse value |> Option.map Ptime.to_float_s
let closed_at row = match Row.closure row with | None -> None | Some (Core.Closure.Imported { closed_at; _ }) | Some (Core.Closure.Manual { closed_at; _ }) | Some (Core.Closure.Delivered { closed_at; _ }) -> parse_instant closed_at
(* A row's anchors in its order, each with the row's package when it names exactly one. *)let insert_anchors db row = let open Sqlite in let package = match Row.packages row with [ package ] -> Some package | _ -> None in List.iteri (fun ord anchor -> insert db Db.anchors [ Db.anchor_issue <-- Row.id row; Db.anchor_ord <-- Int64.of_int ord; Db.anchor_at <-- Core.Anchor.at anchor; Db.anchor_text <-- Core.Anchor.text anchor; Db.anchor_package <-- package; ]) (Row.anchors row)
(* The row's summary, as tk list --json prints it. *)let insert_summary db row = Sqlite.insert db Db.summaries Sqlite. [ Db.summary_id <-- Row.id row; Db.summary_json <-- summary_json (summary_of_row row); ]
let insert_exploration db row = Option.iter (fun mode -> let phase, attempts, critiques = match Row.exploration row with | None -> (None, 0, 0) | Some (Exploration.Deliberating d as state) -> ( Some (Exploration.phase state), List.length d.attempts, List.length d.critiques ) | Some (Exploration.Learning_path l as state) -> ( Some (Exploration.phase state), (if Option.is_some l.human_attempt then 1 else 0), if Option.is_some l.ai_critique then 1 else 0 ) in Sqlite.insert db Db.explorations Sqlite. [ Db.exploration_id <-- Row.id row; Db.exploration_mode <-- mode_name mode; Db.exploration_phase <-- Option.map phase_name phase; Db.attempt_count <-- Int64.of_int attempts; Db.critique_count <-- Int64.of_int critiques; ]) (Row.work_mode row)
let insert_row db ~blocked row = let open Sqlite in let holder = Option.map fst (Row.claim row) in let filed_at = match parse_instant (Row.filed row) with | Some value -> value | None -> failwith ("sqlite index: row " ^ Row.id row ^ " has invalid filed instant") in let claimed_at = Option.bind (Row.claim row) (fun (_, at) -> parse_instant at) in insert db Db.issues [ Db.id <-- Row.id row; Db.title <-- Row.title row; Db.kind <-- Row.kind row; Db.status <-- status_name (Row.status row); Db.priority <-- Int64.of_int (Row.priority row); Db.triage <-- triage_name (Row.triage row); Db.disclosure <-- Option.map disclosure_name (Row.disclosure row); Db.filed <-- Row.filed row; Db.holder <-- holder; Db.filed_at <-- filed_at; Db.claimed_at <-- claimed_at; Db.closed_at <-- closed_at row; (Db.blocked <-- if blocked then 1L else 0L); ]; insert_exploration db row; insert_summary db row; List.iter (fun value -> insert db Db.labels [ Db.issue_id <-- Row.id row; Db.label <-- value ]) (Row.labels row); List.iter (fun edge -> if Core.Edge.kind edge = Core.Edge.Depends_on then insert db Db.dependencies [ Db.dependent_id <-- Row.id row; Db.target_id <-- Core.Edge.row edge; ]) (Row.edges row); insert_anchors db row; (match Row.closure row with | Some (Core.Closure.Imported { reason; closed_at }) -> insert db Db.imported_closures [ Db.imported_id <-- Row.id row; Db.imported_reason <-- reason; Db.imported_closed_at <-- closed_at; ] | Some (Core.Closure.Manual _ | Core.Closure.Delivered _) | None -> ()); Option.iter (fun key -> insert db Db.external_refs [ Db.external_key <-- key; Db.external_issue_id <-- Row.id row ]) (Row.external_ref row)
(* [blocked_by statuses row] is [true] iff a row [row] depends on is not closed in [statuses]. *)let blocked_by statuses row = List.exists (fun edge -> Core.Edge.kind edge = Core.Edge.Depends_on && Hashtbl.find_opt statuses (Core.Edge.row edge) <> Some Core.Closed) (Row.edges row)
(* [waits_here statuses row] is [true] iff a row [row] depends on is a row of [statuses] that is not closed. *)let waits_here statuses row = List.exists (fun target -> match Hashtbl.find_opt statuses target with | Some status -> status <> Core.Closed | None -> false) (Ready.prerequisites row)
(* Insert the ready row [row] of a store whose statuses are [statuses]: its row.json, the open rows of its store it unblocks, its labels and its prerequisites in other stores. *)let insert_ready_row db ~schema ~statuses ~unblocks row = let open Sqlite in let id = Row.id row in let json = match Row_json.to_string ~schema row with | Ok json -> String.trim json | Error message -> failwith ("sqlite index: row " ^ id ^ ": " ^ message) in insert db Db.ready [ Db.ready_id <-- id; Db.ready_title <-- Row.title row; Db.ready_priority <-- Int64.of_int (Row.priority row); Db.ready_disclosure <-- Option.map disclosure_name (Row.disclosure row); Db.ready_unblocks <-- Int64.of_int unblocks; Db.ready_json <-- json; ]; List.iter (fun label -> insert db Db.ready_labels [ Db.ready_label <-- label; Db.ready_issue <-- id ]) (List.sort_uniq String.compare (Row.labels row)); List.iter (fun target -> if not (Hashtbl.mem statuses target) then insert db Db.foreign_prerequisites [ Db.foreign_dependent <-- id; Db.foreign_prerequisite <-- target ]) (List.sort_uniq String.compare (Ready.prerequisites row))
(* The ready list's projection of [rows], whose statuses are [statuses]: the rows that are {!Ready.eligible} and wait on none of [rows] ({!insert_ready_row}), and the open rows of [rows] that depend on each row outside them. *)let insert_ready db ~schema ~statuses rows = let open Sqlite in let dependents = Ready.open_dependents rows in let unblocks = Hashtbl.create 64 in List.iter (fun (id, n) -> Hashtbl.replace unblocks id n) dependents; List.iter (fun row -> if Ready.eligible row && not (waits_here statuses row) then insert_ready_row db ~schema ~statuses ~unblocks: (Option.value (Hashtbl.find_opt unblocks (Row.id row)) ~default:0) row) rows; List.iter (fun (target, count) -> if not (Hashtbl.mem statuses target) then insert db Db.foreign_dependents [ Db.foreign_target <-- target; Db.foreign_count <-- Int64.of_int count; ]) dependents
(* The structured fields of [row], as row.json holds them, when it has any. *)let insert_fields db ~schema row = match Row.fields row with | [] -> () | fields -> let json = Row_json.json_of_fields ~schema ~kind:(Row.kind row) fields |> Json.Value.to_string in Sqlite.insert db Db.row_fields Sqlite.[ Db.fields_id <-- Row.id row; Db.fields_json <-- json ]
(* The discovery projection of [rows] with their bodies: each term's live and closed rows, as Discovery.terms reads a title and body, and each live row's filing mass under the weights of its words among the live rows. *)type postings = { live : (string, string list) Hashtbl.t; closed : (string, string list) Hashtbl.t; texts : (Row.t * string) list; (** Each row with its title and body. *)}
(* Each term's live and closed rows of [rows], as Discovery.terms reads a title and body. *)let postings rows = let live = Hashtbl.create 4096 and closed = Hashtbl.create 4096 in let texts = List.map (fun (row, body) -> let text = Row.title row ^ "\n" ^ Option.value body ~default:"" in let postings = if Row.status row = Core.Closed then closed else live in List.iter (fun term -> Hashtbl.replace postings term (Row.id row :: Option.value ~default:[] (Hashtbl.find_opt postings term))) (Discovery.terms text); (row, text)) rows in { live; closed; texts }
(* Each live row's filing mass: the weights of its words among the live rows and a proposal. *)let insert_masses db { live; texts; _ } = let open Sqlite in let live_rows = List.length (List.filter (fun (row, _) -> Row.status row <> Core.Closed) texts) in let weights = Hashtbl.create (Hashtbl.length live) in Hashtbl.iter (fun word ids -> Hashtbl.replace weights word (Discovery.weight ~documents:(live_rows + 1) ~frequency:(List.length ids))) live; List.iter (fun (row, text) -> if Row.status row <> Core.Closed then insert db Db.filing_masses [ Db.mass_issue <-- Row.id row; Db.mass <-- List.fold_left (fun sum word -> sum +. Hashtbl.find weights word) 0. (Discovery.words text); ]) texts; insert db Db.metadata [ Db.meta_key <-- "live_rows"; Db.meta_value <-- string_of_int live_rows ]
(* The discovery projection of [rows] with their bodies: each term's rows as one doclist, and each live row's filing mass. *)let insert_discovery db rows = let open Sqlite in let postings = postings rows in let put table term_field ids_field doclists = Hashtbl.iter (fun term ids -> insert db table [ term_field <-- term; ids_field <-- String.concat "\n" (List.sort String.compare ids); ]) doclists in put Db.live_postings Db.live_term Db.live_ids postings.live; put Db.closed_postings Db.closed_term Db.closed_ids postings.closed; insert_masses db postings
(* Fill the empty database [db] with [rows] of [tree] and their bodies, refusing a count that differs from the source. The rows are inserted in id order, so the rowid order of the summaries is id order and a walk of them is the list in the order it prints ({!write_rows}). *)let fill db ~tree ~prefix ~schema rows = let statuses = Hashtbl.create (List.length rows) in List.iter (fun (row, _) -> Hashtbl.replace statuses (Row.id row) (Row.status row)) rows; (match Sqlite.Schema.init db Db.schema with | Ok () -> () | Error m -> Fmt.failwith "%a" Sqlite.Schema.pp_mismatch m); Sqlite.with_transaction db (fun () -> Sqlite.insert db Db.metadata Sqlite. [ Db.meta_key <-- "source_tree"; Db.meta_value <-- Git.Hash.to_hex tree; ]; Option.iter (fun prefix -> Sqlite.insert db Db.metadata Sqlite.[ Db.meta_key <-- "prefix"; Db.meta_value <-- prefix ]) prefix; List.iter (fun (row, _) -> insert_row db ~blocked:(blocked_by statuses row) row; insert_fields db ~schema row) (List.sort (fun (a, _) (b, _) -> String.compare (Row.id a) (Row.id b)) rows); insert_discovery db rows; insert_ready db ~schema ~statuses (List.map fst rows)); let count = Sqlite.(from Db.issues |> select1 (count Db.id) |> run db) in if count <> [ Int64.of_int (List.length rows) ] then failwith "sqlite index: row count differs from source tree"
(* Put the complete [database] at [projection]'s name. A hot journal beside the file it replaces belongs to that file alone (howtocorrupt.html, 1.4), so a writable open rolls it back into that file and deletes it, the deletion being the recovery's commit point (lockingv3.html, 4.1), before the name moves: deleting it first would leave the torn file for a reader to take as whole (howtocorrupt.html, 1.3), and moving the name first would leave it beside the new file. The write transaction holds the old file's lock until the rename, so no writer starts a journal at the name in between. A missing file has nothing to recover, and neither has one that is no database once its journal is rolled back. *)let replace ~sw ~database projection = let rename () = Eio.Path.rename database projection; Sqlite.Durability.sync_dir_of projection in match Sqlite.open_ ~sw ~create:false ~journal_mode:`Journal projection with | exception Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) -> rename () | exception Sqlite.Not_a_database _ -> rename () | db -> Fun.protect ~finally:(fun () -> Sqlite.close db) (fun () -> Sqlite.with_transaction db rename)
let build_file ~sw ~fs ~repo ~tree file = let ( let* ) = Result.bind in let* snapshot = Store_tree.load_tree ~repo ~tree in let* rows = Store_tree.bodies ~repo snapshot in let schema = Schema_candidate.schema (Store_tree.candidate snapshot) in let prefix = Result.to_option (Config.of_tree ~repo ~tree) |> Option.map Config.prefix in let dir = Filename.dirname file in mkdir (Filename.dirname dir); mkdir dir; let temporary = Filename.temp_file ~temp_dir:dir "local-" ".sqlite" in Unix.unlink temporary; let database = Eio.Path.(fs / temporary) in let remove path = try Eio.Path.unlink path with Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) -> () in (* A rebuild that fails leaves neither its database nor the rollback journal beside it; after the rename both names are gone already. *) Fun.protect ~finally:(fun () -> remove database; remove (Sqlite.Durability.journal_path database)) (fun () -> Sqlite.with_open ~sw ~journal_mode:`Journal database (fun db -> fill db ~tree ~prefix ~schema rows); replace ~sw ~database Eio.Path.(fs / file); Ok ())
let init ~sw ~fs ~repo ~tree = try build_file ~sw ~fs ~repo ~tree (path repo) with (Unix.Unix_error _ | Sys_error _ | Eio.Io _ | Failure _) as exn -> Error ("sqlite index: " ^ Printexc.to_string exn)
let summary_of_columns (id, title, kind, status, priority, triage, disclosure, filed, holder) = { id; title; kind; status = status_of_name status; priority = Int64.to_int priority; triage = triage_of_name triage; disclosure = Option.map disclosure_of_name disclosure; filed; holder; }
let query db ?status ?priority_at_most ?label ?public () = let status = Option.map status_name status in Db.rows db ?status ?priority_at_most ?label ?public () |> List.map summary_of_columns
let read_with_stats ~db ~tree ?status ?priority_at_most ?label ?public () = match Sqlite.Schema.check db Db.schema with | Error mismatch -> err_index "sqlite index: %a" Sqlite.Schema.pp_mismatch mismatch | Ok () -> if Db.source_tree db <> [ Git.Hash.to_hex tree ] then Error "sqlite index: source tree changed" else let before = Sqlite.Stats.rows_scanned db in let rows = query db ?status ?priority_at_most ?label ?public () in Ok (rows, Sqlite.Stats.rows_scanned db - before)
let read ~db ~tree ?status ?priority_at_most ?label ?public () = read_with_stats ~db ~tree ?status ?priority_at_most ?label ?public () |> Result.map fst
let stats_with_ids ~db ~tree = match Sqlite.Schema.check db Db.schema with | Error mismatch -> err_index "sqlite index: %a" Sqlite.Schema.pp_mismatch mismatch | Ok () -> if Db.source_tree db <> [ Git.Hash.to_hex tree ] then Error "sqlite index: source tree changed" else Db.flow_rows db |> List.map (fun ( id, kind, status, priority, triage, filed_at, claimed_at, closed_at, blocked ) -> ( id, Stats. { kind; status = status_of_name status; priority = Int64.to_int priority; triage = triage_of_name triage; filed_at; claimed_at; closed_at; blocked = blocked <> 0L; } )) |> fun rows -> Ok rows
let fields ~db ~tree = match Sqlite.Schema.check db Db.schema with | Error mismatch -> err_index "sqlite index: %a" Sqlite.Schema.pp_mismatch mismatch | Ok () -> if Db.source_tree db <> [ Git.Hash.to_hex tree ] then Error "sqlite index: source tree changed" else Ok (Db.fields_rows db)
let stats_rows ~db ~tree = stats_with_ids ~db ~tree |> Result.map (List.map snd)
let explorations ~db ~tree ?mode ?phase () = match Sqlite.Schema.check db Db.schema with | Error mismatch -> err_index "sqlite index: %a" Sqlite.Schema.pp_mismatch mismatch | Ok () -> if Db.source_tree db <> [ Git.Hash.to_hex tree ] then Error "sqlite index: source tree changed" else let mode = Option.map mode_name mode in let phase = Option.map phase_name phase in Db.exploration_rows db ?mode ?phase () |> List.map (fun (id, mode, phase, attempt_count, critique_count) -> { id; mode = mode_of_name mode; phase = Option.map phase_of_name phase; attempt_count = Int64.to_int attempt_count; critique_count = Int64.to_int critique_count; }) |> fun rows -> Ok rows
let dependency_rows ~db ~tree = match Sqlite.Schema.check db Db.schema with | Error mismatch -> err_index "sqlite index: %a" Sqlite.Schema.pp_mismatch mismatch | Ok () -> if Db.source_tree db <> [ Git.Hash.to_hex tree ] then Error "sqlite index: source tree changed" else Ok (Db.dependency_rows db)
type anchor = { row : string; package : string option; anchor : Core.Anchor.t }
let anchors ~db ~tree = match Sqlite.Schema.check db Db.schema with | Error mismatch -> err_index "sqlite index: %a" Sqlite.Schema.pp_mismatch mismatch | Ok () -> if Db.source_tree db <> [ Git.Hash.to_hex tree ] then Error "sqlite index: source tree changed" else Db.anchor_rows db |> List.sort (fun (a, i, _, _, _) (b, j, _, _, _) -> match String.compare a b with 0 -> Int64.compare i j | c -> c) |> List.map (fun (row, _, at, text, package) -> { row; package; anchor = Core.Anchor.v ~at ~text }) |> Result.ok
let external_ref_id ~db ~tree key = match Sqlite.Schema.check db Db.schema with | Error mismatch -> err_index "sqlite index: %a" Sqlite.Schema.pp_mismatch mismatch | Ok () -> ( if Db.source_tree db <> [ Git.Hash.to_hex tree ] then Error "sqlite index: source tree changed" else match Db.external_ref_id db key with | [] -> Ok None | [ id ] -> Ok (Some id) | _ -> Error ("sqlite index: duplicate external ref " ^ key))
let imported_closure ~db ~tree id = match Sqlite.Schema.check db Db.schema with | Error mismatch -> err_index "sqlite index: %a" Sqlite.Schema.pp_mismatch mismatch | Ok () -> ( if Db.source_tree db <> [ Git.Hash.to_hex tree ] then Error "sqlite index: source tree changed" else match Db.imported_closure db id with | [] -> Ok None | [ (reason, closed_at) ] -> Core.Closure.imported ~reason ~closed_at |> Result.map Option.some | _ -> Error ("sqlite index: duplicate imported closure " ^ id))
let external_refs_prefix ~db ~tree prefix = match Sqlite.Schema.check db Db.schema with | Error mismatch -> err_index "sqlite index: %a" Sqlite.Schema.pp_mismatch mismatch | Ok () -> if Db.source_tree db <> [ Git.Hash.to_hex tree ] then Error "sqlite index: source tree changed" else Ok (Db.external_refs_prefix db prefix)
let open_read ~prefixed ~sw ~fs ~repo ~tree f = let ( let* ) = Result.bind in let attempt () = try Sqlite.with_open ~sw ~create:false ~read_only:true Eio.Path.(fs / path repo) (fun db -> match Sqlite.Schema.check db Db.schema with | Error mismatch -> `Invalid (Fmt.str "sqlite index: %a" Sqlite.Schema.pp_mismatch mismatch) | Ok () -> if Db.source_tree db <> [ Git.Hash.to_hex tree ] then `Invalid "sqlite index: source tree changed" else if prefixed && Db.prefix db = [] then `Invalid "sqlite index: store prefix missing" else `Ready (f db)) with | ( Eio.Io _ | Sqlite.Not_a_database _ | Sqlite.Readonly_rollback _ | Sqlite.Error.Prepare _ | Failure _ | Invalid_argument _ ) as exn -> `Invalid ("sqlite index: " ^ Printexc.to_string exn) in match attempt () with | `Ready result -> result | `Invalid _ -> ( let* () = init ~sw ~fs ~repo ~tree in match attempt () with | `Ready result -> result | `Invalid message -> Error message)
let with_read ~sw ~fs ~repo ~tree f = open_read ~prefixed:false ~sw ~fs ~repo ~tree f
type cost = { page_reads : int; rows_scanned : int }
(* [measured db f] is [f ()] and the SQLite work it did on [db]. *)let measured db f = let pages = Sqlite.Stats.page_fetches db and scanned = Sqlite.Stats.rows_scanned db in let value = f () in ( value, { page_reads = Sqlite.Stats.page_fetches db - pages; rows_scanned = Sqlite.Stats.rows_scanned db - scanned; } )
let list_with_cost ~sw ~fs ~repo ~tree ?status ?priority_at_most ?label ?public () = with_read ~sw ~fs ~repo ~tree (fun db -> Ok (measured db (fun () -> query db ?status ?priority_at_most ?label ?public ())))
let list ~sw ~fs ~repo ~tree ?status ?priority_at_most ?label ?public () = list_with_cost ~sw ~fs ~repo ~tree ?status ?priority_at_most ?label ?public () |> Result.map fst
let rec with_reads ~sw ~fs stores f = match stores with | [] -> f [] | (repo, tree) :: rest -> open_read ~prefixed:true ~sw ~fs ~repo ~tree (fun db -> Sqlite.with_transaction db (fun () -> with_reads ~sw ~fs rest (fun dbs -> f (db :: dbs))))
(* The JSON list. Each admitted row's stored summary goes from the page it lies on into one fixed buffer, which is handed to the writer each time it fills: no row is decoded into a string, and nothing on the per-row path allocates, so the list costs one buffer whatever the store's size. *)
type sink = { buf : bytes; mutable fill : int; mutable elements : int; write : bytes -> int -> int -> unit;}
let sink ?(size = 65536) write = if size < 1 then invalid_arg "Sqlite_index.sink: an empty buffer"; let buf = Bytes.create size in Bytes.set buf 0 '['; { buf; fill = 1; elements = 0; write }
let flush s = if s.fill > 0 then begin s.write s.buf 0 s.fill; s.fill <- 0 end
let put_char s c = if s.fill = Bytes.length s.buf then flush s; Bytes.set s.buf s.fill c; s.fill <- s.fill + 1
let close s = put_char s ']'; put_char s '\n'; flush s
(* The bytes [off..len) of the cell [col] of [row], in as many pieces as the buffer's free space takes. *)let rec put_cell s row col ~len off = if off < len then begin if s.fill = Bytes.length s.buf then flush s; let n = min (len - off) (Bytes.length s.buf - s.fill) in Sqlite.Blob.read row col ~off s.buf ~pos:s.fill ~len:n; s.fill <- s.fill + n; put_cell s row col ~len (off + n) end
let rec occurs_at needle s i j = j >= String.length needle || Char.lowercase_ascii (String.unsafe_get s (i + j)) = String.unsafe_get needle j && occurs_at needle s i (j + 1)
let rec occurs_from needle s i stop = i + String.length needle <= stop && (occurs_at needle s i 0 || occurs_from needle s (i + 1) stop)
(* [contains ~needle s off len] is [true] iff the lowercase [needle] occurs in the [len] bytes of [s] at [off], compared without regard to ASCII case. *)let contains ~needle s off len = occurs_from needle s off (off + len)
let matches ~query ~id ~title = let needle = String.lowercase_ascii query in needle = "" || contains ~needle id 0 (String.length id) || contains ~needle title 0 (String.length title)
(* [compare_span s off len key] orders the [len] bytes of [s] at [off] against [key], byte by byte as [String.compare] does. *)let rec compare_from s off len key i = if i = len || i = String.length key then Int.compare len (String.length key) else let c = Char.compare (String.unsafe_get s (off + i)) key.[i] in if c <> 0 then c else compare_from s off len key (i + 1)
let compare_span s off len key = compare_from s off len key 0
(* [mem_sorted keys s off len] is [true] iff the span is an element of the sorted [keys]. *)let rec search keys s off len lo hi = lo < hi && let mid = (lo + hi) / 2 in let c = compare_span s off len keys.(mid) in c = 0 || if c < 0 then search keys s off len lo mid else search keys s off len (mid + 1) hi
let mem_sorted keys s off len = search keys s off len 0 (Array.length keys)
(* The ids, in order, of the rows a filtered list admits: the projection's own disclosure and label filters, then the query over each id and title. *)let admitted db ~public ?label ~query () = Db.titled db ?label ~public () |> List.filter_map (fun (id, title) -> if matches ~query ~id ~title then Some id else None) |> Array.of_list
(* What a walk of one store's summaries reads: the two columns, the ids it admits ([None] for every one), and the scratch buffer an id is read into to be looked up. *)type walk = { sink : sink; id : Sqlite.Blob.column; json : Sqlite.Blob.column; admitted : string array option; mutable scratch : bytes;}
let admits w row = match w.admitted with | None -> true | Some ids -> let len = Sqlite.Blob.length row w.id in if len > Bytes.length w.scratch then w.scratch <- Bytes.create (max len (2 * Bytes.length w.scratch)); Sqlite.Blob.read row w.id ~off:0 w.scratch ~pos:0 ~len; mem_sorted ids (Bytes.unsafe_to_string w.scratch) 0 len
let write_row w row = if admits w row then begin if w.sink.elements > 0 then put_char w.sink ','; put_cell w.sink row w.json ~len:(Sqlite.Blob.length row w.json) 0; w.sink.elements <- w.sink.elements + 1 end
let stream db ~public ?label ~query sink = let column e = Sqlite.Blob.column db e in let w = { sink; id = column Db.summary_id; json = column Db.summary_json; admitted = (if public || Option.is_some label || query <> "" then Some (admitted db ~public ?label ~query ()) else None); scratch = Bytes.create 256; } in Sqlite.Blob.iter db Db.summaries ~f:(write_row w)
let write_rows ~db ~tree ?(public = false) ?label ?(query = "") sink = match Sqlite.Schema.check db Db.schema with | Error mismatch -> err_index "sqlite index: %a" Sqlite.Schema.pp_mismatch mismatch | Ok () -> if Db.source_tree db <> [ Git.Hash.to_hex tree ] then Error "sqlite index: source tree changed" else Ok (stream db ~public ?label ~query sink)
let list_json ~sw ~fs ~stores ?(public = false) ?label ?(query = "") sink = with_reads ~sw ~fs stores (fun dbs -> let cost = { page_reads = 0; rows_scanned = 0 } in let cost = List.fold_left (fun (cost : cost) db -> let (), c = measured db (fun () -> stream db ~public ?label ~query sink) in { page_reads = cost.page_reads + c.page_reads; rows_scanned = cost.rows_scanned + c.rows_scanned; }) cost dbs in close sink; Ok cost)
(* [add_to t id n] adds [n] to the count of [id] in [t]. *)let add_to t id n = Hashtbl.replace t id (n + Option.value (Hashtbl.find_opt t id) ~default:0)
type ready = { store : int; id : string; title : string; priority : int; dependents : int; json : string;}
(* The ready rows of [db] that carry every label of [labels], each with the open rows of [db] it unblocks and its row.json, and with its prerequisites in other stores. *)let ready_in db ~store ~labels ~public = let label, others = match labels with [] -> (None, []) | l :: rest -> (Some l, rest) in let elsewhere = Hashtbl.create 16 in List.iter (fun (dependent, target) -> Hashtbl.add elsewhere dependent target) (Db.ready_foreign_prerequisites db); Db.ready_rows db ?label ~public () |> List.filter_map (fun (id, title, priority, unblocks, json) -> if List.for_all (Db.has_label db id) others then Some ( { store; id; title; priority = Int64.to_int priority; dependents = Int64.to_int unblocks; json; }, Hashtbl.find_all elsewhere id ) else None)
(* The status of each prerequisite of [ids] in the store its prefix names, among [dbs] whose prefixes are [prefixes]; a prerequisite no store names is refused, and one its store lacks has no status. *)let statuses_in dbs ~prefixes ~unlinked ids = let statuses = Hashtbl.create 16 in List.fold_left (fun acc id -> let ( let* ) = Result.bind in let* () = acc in let* store = Ready.route ~prefixes ~unlinked id in (match Db.status_of (List.nth dbs store) id with | [ value ] -> Hashtbl.replace statuses id (status_of_name value) | _ -> ()); Ok ()) (Ok ()) (List.sort_uniq String.compare ids) |> Result.map (fun () -> statuses)
let position q = { Ready.id = q.id; priority = q.priority; dependents = q.dependents }
let ranked dbs ~prefixes ~unlinked ~listed ~labels ~public = let ( let* ) = Result.bind in let candidates = List.combine dbs listed |> List.mapi (fun store (db, listed) -> if listed then ready_in db ~store ~labels ~public else []) |> List.concat in let* statuses = statuses_in dbs ~prefixes ~unlinked (List.concat_map snd candidates) in let dependents = Hashtbl.create 16 in List.iter (fun db -> List.iter (fun (id, n) -> add_to dependents id (Int64.to_int n)) (Db.cross_store_dependents db)) dbs; Ok (List.filter_map (fun (item, elsewhere) -> if Ready.unblocked ~status:(Hashtbl.find_opt statuses) elsewhere then Some { item with dependents = item.dependents + Option.value (Hashtbl.find_opt dependents item.id) ~default:0; } else None) candidates |> List.sort (fun a b -> Ready.compare (position a) (position b)))
let ready ~sw ~fs ~stores ?(unlinked = []) ?(labels = []) ?(public = false) () = let ( let* ) = Result.bind in let listed = List.map (fun (_, _, listed) -> listed) stores in with_reads ~sw ~fs (List.map (fun (repo, tree, _) -> (repo, tree)) stores) (fun dbs -> let counters () = List.fold_left (fun (pages, scanned) db -> ( pages + Sqlite.Stats.page_fetches db, scanned + Sqlite.Stats.rows_scanned db )) (0, 0) dbs in let prefixes = List.concat_map Db.prefix dbs in let pages, scanned = counters () in let* items = ranked dbs ~prefixes ~unlinked ~listed ~labels ~public in let pages', scanned' = counters () in Ok ( items, { page_reads = pages' - pages; rows_scanned = scanned' - scanned } ))
(** {1:discovery Discovery} *)
module Ids = Set.Make (String)
let doclist = function [ ids ] -> String.split_on_char '\n' ids | _ -> []
let candidate_in db issue = match Db.candidate_of db issue with | [ (title, status, holder) ] -> Some { Discovery.id = issue; title; status = status_of_name status; holder = Option.value holder ~default:"-"; } | _ -> None
(* The rows of [db] holding every term of [query], with the row whose id [query] is. *)let search_ids db ~include_closed query = let postings term = Ids.of_list (doclist (Db.live_postings_of db term) @ if include_closed then doclist (Db.closed_postings_of db term) else []) in let by_terms = match Discovery.terms query with | [] -> Ids.empty | first :: rest -> List.fold_left (fun acc term -> if Ids.is_empty acc then acc else Ids.inter acc (postings term)) (postings first) rest in let id = String.trim query in match Db.candidate_of db id with | [ (_, status, _) ] when include_closed || status <> "closed" -> Ids.add id by_terms | _ -> by_terms
let search_in db ~repo ~tree ~include_closed query = let ( let* ) = Result.bind in let whole = Discovery.terms query = [ String.lowercase_ascii (String.trim query) ] in Ids.fold (fun id acc -> let* found = acc in match candidate_in db id with | None -> Error ("sqlite index: row " ^ id ^ " is not indexed") | Some candidate -> if whole || String.equal id (String.trim query) then Ok (candidate :: found) else let* body = Store_tree.body ~repo ~tree ~id in if Discovery.matches ~query ~id ~title:candidate.title ~body:(Option.value body ~default:"") then Ok (candidate :: found) else acc) (search_ids db ~include_closed query) (Ok []) |> Result.map List.rev
let filing_in db ~title ~body = let ( let* ) = Result.bind in let* documents = match Db.live_rows db with | [ n ] -> ( match int_of_string_opt n with | Some n -> Ok (n + 1) | None -> Error "sqlite index: invalid live row count") | _ -> Error "sqlite index: missing live row count" in let shared = Hashtbl.create 64 in let proposed = List.fold_left (fun sum word -> let ids = doclist (Db.live_postings_of db word) in let weight = Discovery.weight ~documents ~frequency:(List.length ids) in List.iter (fun id -> let mass, count = Option.value ~default:(0., 0) (Hashtbl.find_opt shared id) in Hashtbl.replace shared id (mass +. weight, count + 1)) ids; sum +. weight) 0. (Discovery.words (title ^ " " ^ body)) in let* scored = Hashtbl.fold (fun id (mass, count) acc -> let* acc = acc in if count < 2 then Ok acc else match Db.mass_of db id with | [ existing ] -> Ok ((Discovery.similarity ~shared:mass ~proposed ~existing, id) :: acc) | _ -> Error ("sqlite index: live row " ^ id ^ " has no filing weight")) shared (Ok []) in List.fold_right (fun id acc -> let* acc = acc in match candidate_in db id with | Some candidate -> Ok (candidate :: acc) | None -> Error ("sqlite index: live row " ^ id ^ " is not indexed")) (Discovery.best ~id:Fun.id scored) (Ok [])
let search ~sw ~fs ~repo ~tree ?(include_closed = false) query = with_read ~sw ~fs ~repo ~tree (fun db -> match measured db (fun () -> search_in db ~repo ~tree ~include_closed query) with | Ok found, cost -> Ok (found, cost) | (Error _ as e), _ -> e)
let filing_candidates ~sw ~fs ~repo ~tree ~title ~body = with_read ~sw ~fs ~repo ~tree (fun db -> match measured db (fun () -> filing_in db ~title ~body) with | Ok found, cost -> Ok (found, cost) | (Error _ as e), _ -> e)