[OCaml] High Intensity Training Online
refactor share SQLite query wrappers
Make transactional code stand out from repeated one-statement Caqti calls.
lib/persistence/sqlite_repo.ml
@@ -187,6 +187,18 @@
187
187
188
188
let run t f = Caqti_lwt_unix.Pool.use f t.pool >>= Caqti_lwt.or_fail
189
189
190
Added:
let q_exec t query data =
191
Added:
run t (fun (module Db : Caqti_lwt.CONNECTION) -> Db.exec query data)
192
Added:
193
Added:
let q_find t query data =
194
Added:
run t (fun (module Db : Caqti_lwt.CONNECTION) -> Db.find query data)
195
Added:
196
Added:
let q_find_opt t query data =
197
Added:
run t (fun (module Db : Caqti_lwt.CONNECTION) -> Db.find_opt query data)
198
Added:
199
Added:
let q_collect_list t query data =
200
Added:
run t (fun (module Db : Caqti_lwt.CONNECTION) -> Db.collect_list query data)
201
Added:
190
202
(* SQLite admits one writer at a time. Without a busy timeout a second writer
191
203
fails at once with SQLITE_BUSY; with one it waits its turn. The driver reads
192
204
[busy_timeout] (milliseconds) from the URI, so a caller who sets it keeps
@@ -273,16 +285,13 @@
273
285
| Error _ -> None
274
286
275
287
let find_trainee_by_username t username =
276
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
277
Removed:
Db.find_opt Q.trainee_by_username (Trainee.username_to_string username))
288
Added:
q_find_opt t Q.trainee_by_username (Trainee.username_to_string username)
278
289
>|= function
279
290
| Some row -> trainee_of_row row
280
291
| None -> None
281
292
282
293
let find_trainee t id =
283
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
284
Removed:
Db.find_opt Q.trainee_by_id (Trainee.id_to_string id))
285
Removed:
>|= function
294
Added:
q_find_opt t Q.trainee_by_id (Trainee.id_to_string id) >|= function
286
295
| Some row -> trainee_of_row row
287
296
| None -> None
288
297
@@ -310,9 +319,7 @@
310
319
311
320
let update_credential t id credential =
312
321
let trainee = Trainee.id_to_string id in
313
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
314
Removed:
Db.exec Q.update_credential
315
Removed:
(Trainee.credential_to_hash credential, trainee))
322
Added:
q_exec t Q.update_credential (Trainee.credential_to_hash credential, trainee)
316
323
>>= fun () -> find_trainee t id
317
324
318
325
(* --- catalog --- *)
@@ -343,30 +350,22 @@
343
350
(* --- per-trainee selection and workout in progress --- *)
344
351
345
352
let active_routine t id =
346
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
347
Removed:
Db.find_opt Q.get_active (Trainee.id_to_string id))
353
Added:
q_find_opt t Q.get_active (Trainee.id_to_string id)
348
354
>|= Option.map Repository.routine_id
349
355
350
356
let set_active_routine t id (routine : Repository.routine_id) =
351
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
352
Removed:
Db.exec Q.set_active (Trainee.id_to_string id, (routine :> string)))
357
Added:
q_exec t Q.set_active (Trainee.id_to_string id, (routine :> string))
353
358
354
359
let in_progress t id =
355
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
356
Removed:
Db.find_opt Q.get_in_progress (Trainee.id_to_string id))
357
Removed:
>|= function
360
Added:
q_find_opt t Q.get_in_progress (Trainee.id_to_string id) >|= function
358
361
| None -> None
359
362
| Some encoded -> Some (decode encoded)
360
363
361
364
let set_in_progress t id workout =
362
365
let trainee = Trainee.id_to_string id in
363
366
match workout with
364
Removed:
| None ->
365
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
366
Removed:
Db.exec Q.clear_in_progress trainee)
367
Removed:
| Some workout ->
368
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
369
Removed:
Db.exec Q.set_in_progress (trainee, encode workout))
367
Added:
| None -> q_exec t Q.clear_in_progress trainee
368
Added:
| Some workout -> q_exec t Q.set_in_progress (trainee, encode workout)
370
369
371
370
(* --- history --- *)
372
371
@@ -387,40 +386,32 @@
387
386
{ Repository.id = Repository.workout_id wid; workout }))
388
387
389
388
let find t id (wid : Repository.workout_id) =
390
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
391
Removed:
Db.find_opt Q.workout_by_id (Trainee.id_to_string id, (wid :> string)))
389
Added:
q_find_opt t Q.workout_by_id (Trainee.id_to_string id, (wid :> string))
392
390
>|= function
393
391
| None -> None
394
392
| Some encoded -> Some { Repository.id = wid; workout = decode encoded }
395
393
396
394
let replace t id record =
397
395
let trainee = Trainee.id_to_string id in
398
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
399
Removed:
Db.find_opt Q.workout_by_id (trainee, (record.Repository.id :> string)))
396
Added:
q_find_opt t Q.workout_by_id (trainee, (record.Repository.id :> string))
400
397
>>= function
401
398
| None -> Lwt.return false
402
399
| Some _ ->
403
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
404
Removed:
Db.exec Q.update_workout
405
Removed:
( encode record.Repository.workout,
406
Removed:
trainee,
407
Removed:
(record.Repository.id :> string) ))
400
Added:
q_exec t Q.update_workout
401
Added:
( encode record.Repository.workout,
402
Added:
trainee,
403
Added:
(record.Repository.id :> string) )
408
404
>|= fun () -> true
409
405
410
406
let delete_workout t id (wid : Repository.workout_id) =
411
407
let trainee = Trainee.id_to_string id in
412
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
413
Removed:
Db.find_opt Q.workout_by_id (trainee, (wid :> string)))
414
Removed:
>>= function
408
Added:
q_find_opt t Q.workout_by_id (trainee, (wid :> string)) >>= function
415
409
| None -> Lwt.return false
416
410
| Some _ ->
417
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
418
Removed:
Db.exec Q.delete_workout (trainee, (wid :> string)))
419
Removed:
>|= fun () -> true
411
Added:
q_exec t Q.delete_workout (trainee, (wid :> string)) >|= fun () -> true
420
412
421
413
let history t id =
422
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
423
Removed:
Db.collect_list Q.history (Trainee.id_to_string id))
414
Added:
q_collect_list t Q.history (Trainee.id_to_string id)
424
415
>|= List.filter_map decode_history_row
425
416
426
417
let log t id =
@@ -434,11 +425,8 @@
434
425
let save_feedback t id report =
435
426
let trainee = Trainee.id_to_string id in
436
427
let encoded = Codec.encode_feedback report in
437
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
438
Removed:
Db.find Q.next_feedback_seq trainee)
439
Removed:
>>= fun seq ->
440
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
441
Removed:
Db.exec Q.insert_feedback (trainee, seq, encoded))
428
Added:
q_find t Q.next_feedback_seq trainee >>= fun seq ->
429
Added:
q_exec t Q.insert_feedback (trainee, seq, encoded)
442
430
443
431
(* Quarantine a corrupt row in a list read, naming its position. *)
444
432
let quarantine ~what ~pp_error decode rows =
@@ -452,8 +440,7 @@
452
440
None)
453
441
454
442
let feedback t id =
455
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
456
Removed:
Db.collect_list Q.feedback (Trainee.id_to_string id))
443
Added:
q_collect_list t Q.feedback (Trainee.id_to_string id)
457
444
>|= quarantine ~what:"feedback report" ~pp_error:Codec.pp_error
458
445
Codec.decode_feedback
459
446
@@ -463,12 +450,9 @@
463
450
| None ->
464
451
Lwt.fail_with "cannot save application feedback for an unknown trainee"
465
452
| Some author ->
466
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
467
Removed:
Db.find Q.next_app_feedback_seq trainee)
468
Removed:
>>= fun seq ->
469
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
470
Removed:
Db.exec Q.insert_app_feedback
471
Removed:
(trainee, seq, Timestamp.encode submitted_at, message))
453
Added:
q_find t Q.next_app_feedback_seq trainee >>= fun seq ->
454
Added:
q_exec t Q.insert_app_feedback
455
Added:
(trainee, seq, Timestamp.encode submitted_at, message)
472
456
>|= fun () ->
473
457
Repository.
474
458
{
@@ -483,12 +467,8 @@
483
467
}
484
468
485
469
let app_feedback t ~viewer =
486
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
487
Removed:
Db.collect_list Q.app_feedback ())
488
Removed:
>>= fun rows ->
489
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
490
Removed:
Db.collect_list Q.viewer_votes (Trainee.id_to_string viewer))
491
Removed:
>|= fun voted ->
470
Added:
q_collect_list t Q.app_feedback () >>= fun rows ->
471
Added:
q_collect_list t Q.viewer_votes (Trainee.id_to_string viewer) >|= fun voted ->
492
472
List.map
493
473
(fun (trainee, seq, author, submitted_at, message, contributions, upvotes)
494
474
->
@@ -528,48 +508,33 @@
528
508
| None -> Lwt.return false
529
509
| Some (trainee, seq) -> (
530
510
let voter = Trainee.id_to_string voter in
531
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
532
Removed:
Db.find_opt Q.feedback_owner (trainee, seq))
533
Removed:
>>= function
511
Added:
q_find_opt t Q.feedback_owner (trainee, seq) >>= function
534
512
| None -> Lwt.return false
535
513
| Some owner when String.equal owner voter -> Lwt.return false
536
514
| Some _ -> (
537
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
538
Removed:
Db.find_opt Q.vote_exists (trainee, seq, voter))
539
Removed:
>>= function
515
Added:
q_find_opt t Q.vote_exists (trainee, seq, voter) >>= function
540
516
| Some _ -> Lwt.return false
541
517
| None ->
542
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
543
Removed:
Db.exec Q.insert_vote (trainee, seq, voter))
544
Removed:
>|= fun () -> true))
518
Added:
q_exec t Q.insert_vote (trainee, seq, voter) >|= fun () -> true))
545
519
546
520
let update_app_feedback t ~author id ~message =
547
521
match split_app_feedback_id id with
548
522
| None -> Lwt.return false
549
523
| Some (trainee, seq) -> (
550
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
551
Removed:
Db.find_opt Q.feedback_owner (trainee, seq))
552
Removed:
>>= function
524
Added:
q_find_opt t Q.feedback_owner (trainee, seq) >>= function
553
525
| Some owner when String.equal owner (Trainee.id_to_string author) ->
554
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
555
Removed:
Db.exec Q.update_app_feedback (message, trainee, seq))
556
Removed:
>|= fun () -> true
526
Added:
q_exec t Q.update_app_feedback (message, trainee, seq) >|= fun () ->
527
Added:
true
557
528
| _ -> Lwt.return false)
558
529
559
530
let delete_app_feedback t ~author id =
560
531
match split_app_feedback_id id with
561
532
| None -> Lwt.return false
562
533
| Some (trainee, seq) -> (
563
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
564
Removed:
Db.find_opt Q.feedback_owner (trainee, seq))
565
Removed:
>>= function
534
Added:
q_find_opt t Q.feedback_owner (trainee, seq) >>= function
566
535
| Some owner when String.equal owner (Trainee.id_to_string author) ->
567
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
568
Removed:
Db.exec Q.delete_feedback_votes (trainee, seq))
569
Removed:
>>= fun () ->
570
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
571
Removed:
Db.exec Q.delete_app_feedback (trainee, seq))
572
Removed:
>|= fun () -> true
536
Added:
q_exec t Q.delete_feedback_votes (trainee, seq) >>= fun () ->
537
Added:
q_exec t Q.delete_app_feedback (trainee, seq) >|= fun () -> true
573
538
| _ -> Lwt.return false)
574
539
575
540
(* --- workout import --- *)
@@ -592,21 +557,18 @@
592
557
let source = Workout_import.batch_source batch in
593
558
let fingerprint = Workout_import.batch_fingerprint batch in
594
559
let snapshot = Import_codec.encode_snapshot (Workout_import.snapshot batch) in
595
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
596
Removed:
Db.exec Q.upsert_import_batch
597
Removed:
(trainee, batch_id, imported_at, source, fingerprint, snapshot))
560
Added:
q_exec t Q.upsert_import_batch
561
Added:
(trainee, batch_id, imported_at, source, fingerprint, snapshot)
598
562
599
563
let find_import_batch t id batch_id =
600
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
601
Removed:
Db.find_opt Q.import_batch_by_id
602
Removed:
(Trainee.id_to_string id, Workout_import.batch_id_to_string batch_id))
564
Added:
q_find_opt t Q.import_batch_by_id
565
Added:
(Trainee.id_to_string id, Workout_import.batch_id_to_string batch_id)
603
566
>|= function
604
567
| None -> None
605
568
| Some encoded -> Some (decode_batch encoded)
606
569
607
570
let import_batches t id =
608
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
609
Removed:
Db.collect_list Q.import_batches (Trainee.id_to_string id))
571
Added:
q_collect_list t Q.import_batches (Trainee.id_to_string id)
610
572
>|= quarantine ~what:"import batch" ~pp_error:Import_codec.pp_error
611
573
(Import_codec.decode_snapshot ~find_exercise)
612
574
@@ -615,14 +577,10 @@
615
577
let delete_import_batch t id batch_id =
616
578
let trainee = Trainee.id_to_string id in
617
579
let batch_id = Workout_import.batch_id_to_string batch_id in
618
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
619
Removed:
Db.find_opt Q.import_batch_exists (trainee, batch_id))
620
Removed:
>>= function
580
Added:
q_find_opt t Q.import_batch_exists (trainee, batch_id) >>= function
621
581
| None -> Lwt.return false
622
582
| Some _ ->
623
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
624
Removed:
Db.exec Q.delete_import_batch (trainee, batch_id))
625
Removed:
>|= fun () -> true
583
Added:
q_exec t Q.delete_import_batch (trainee, batch_id) >|= fun () -> true
626
584
627
585
let replace_imported_record t id (record : Repository.imported_record) =
628
586
let trainee = Trainee.id_to_string id in
@@ -632,13 +590,11 @@
632
590
let started_at = Timestamp.encode record.started_at in
633
591
let ended_at = Timestamp.encode record.ended_at in
634
592
let snapshot = Import_codec.encode_record record in
635
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
636
Removed:
Db.exec Q.upsert_imported_record
637
Removed:
( (trainee, workout_id, batch_id, record.revision),
638
Removed:
(title, started_at, ended_at, snapshot) ))
593
Added:
q_exec t Q.upsert_imported_record
594
Added:
( (trainee, workout_id, batch_id, record.revision),
595
Added:
(title, started_at, ended_at, snapshot) )
639
596
640
597
let imported_records t id =
641
Removed:
run t (fun (module Db : Caqti_lwt.CONNECTION) ->
642
Removed:
Db.collect_list Q.imported_records (Trainee.id_to_string id))
598
Added:
q_collect_list t Q.imported_records (Trainee.id_to_string id)
643
599
>|= quarantine ~what:"imported record" ~pp_error:Import_codec.pp_error
644
600
Import_codec.decode_record