1 (** Application service: orchestrates the core over a {!Repository.S}. The API a 2 client calls — no HTML or serialization. 3 4 Every call is scoped to a {!Trainee.id}. The service holds no mutable state 5 of its own: the active routine and the workout in progress live in the 6 repository, so a restart loses nothing and two trainees never share a slot. 7 8 Recovery gating lives here, not in the client. {!Evidence.Workout.start} 9 demands a {!Recovery.clearance}, and this module is the only thing that 10 decides how one is obtained: earned by having rested, or taken deliberately 11 through {!begin_workout}'s [override] acknowledgment. Putting that policy 12 here means a native client cannot quietly adopt looser rules than the web 13 one. *) 14 15 module Make (R : Repository.S) : sig 16 type t 17 18 val make : repo:R.t -> t 19 (** [repo] is the store this service reads and writes. *) 20 21 (** {2 Accounts} *) 22 23 type register_error = [ `Username of Trainee.username_error | `Username_taken ] 24 (** Why registration was refused: a malformed username or a username already 25 in use. Passwords carry no policy, so they never refuse registration. *) 26 27 val register : 28 t -> 29 username:string -> 30 password:string -> 31 (Trainee.t, register_error) result Lwt.t 32 33 val authenticate : 34 t -> username:string -> password:string -> Trainee.t option Lwt.t 35 (** [Some] only when the username is known and the password verifies. *) 36 37 val find_trainee : t -> Trainee.id -> Trainee.t option Lwt.t 38 39 type change_username_error = 40 [ `Username of Trainee.username_error | `Username_taken | `Unknown ] 41 (** Why a rename was refused: a malformed name, a name already in use, or an 42 unknown account. *) 43 44 val change_username : 45 t -> 46 Trainee.id -> 47 username:string -> 48 (Trainee.t, change_username_error) result Lwt.t 49 (** Rename the account. The trainee's own current name is accepted as a no-op. 50 Returns the updated trainee on success. *) 51 52 type change_password_error = [ `Incorrect_password | `Unknown ] 53 (** Why a password change was refused: the current password did not verify, or 54 the account is unknown. *) 55 56 val change_password : 57 t -> 58 Trainee.id -> 59 current:string -> 60 next:string -> 61 (Trainee.t, change_password_error) result Lwt.t 62 (** Change the password. [current] must verify before [next] is stored, so a 63 hijacked session cannot reset it silently. Passwords carry no policy. *) 64 65 (** {2 Routines} *) 66 67 val list_routines : t -> (Repository.routine_id * Prescription.Routine.t) list 68 69 type error = 70 | Unknown_routine 71 | Not_recovered of Recovery.readiness 72 (** Refused: recovery is incomplete and no override was given. Carries 73 the reading so a client can say how much longer. *) 74 75 val pp_error : Format.formatter -> error -> unit 76 77 val select_routine : 78 t -> Trainee.id -> Repository.routine_id -> (unit, error) result Lwt.t 79 80 val active_routine : 81 t -> 82 Trainee.id -> 83 (Repository.routine_id * Prescription.Routine.t) option Lwt.t 84 85 val next_workout : 86 t -> 87 Trainee.id -> 88 routine:Repository.routine_id -> 89 (Prescription.Workout.t, error) result Lwt.t 90 (** Where the cycle stands: the workout after the last one logged. *) 91 92 val readiness : 93 t -> 94 Trainee.id -> 95 routine:Repository.routine_id -> 96 now:Recovery.timestamp -> 97 (Recovery.readiness, error) result Lwt.t 98 99 val begin_workout : 100 t -> 101 Trainee.id -> 102 routine:Repository.routine_id -> 103 now:Recovery.timestamp -> 104 ?override:unit -> 105 unit -> 106 (Evidence.Workout.t, error) result Lwt.t 107 (** Start the next workout. [Error (Not_recovered _)] unless recovery is 108 complete or [override] explicitly acknowledges early training. *) 109 110 val in_progress : t -> Trainee.id -> Evidence.Workout.t option Lwt.t 111 (** The workout being logged, if any. Per-trainee and durable. *) 112 113 type log_error = 114 | No_workout_in_progress 115 | Rejected of Evidence.Workout.error 116 (** The workout refused the stimulus; see {!Evidence.Workout.error}. *) 117 118 val pp_log_error : Format.formatter -> log_error -> unit 119 120 val log : 121 t -> 122 Trainee.id -> 123 Evidence.Stimulus.t -> 124 (Evidence.Workout.t, log_error) result Lwt.t 125 (** Record a stimulus against the workout in progress. *) 126 127 val replace_current : 128 t -> 129 Trainee.id -> 130 slot:int -> 131 Evidence.Stimulus.t -> 132 (Evidence.Workout.t, log_error) result Lwt.t 133 (** Correct a recorded slot of the workout in progress. Replaces the slot's 134 record rather than adding volume. *) 135 136 val finish : 137 t -> 138 Trainee.id -> 139 ended_at:Recovery.timestamp -> 140 Repository.record option Lwt.t 141 (** Complete and persist the workout in progress, clearing the slot. [None] if 142 nothing was in progress. *) 143 144 val cancel : t -> Trainee.id -> bool Lwt.t 145 (** Discard the workout in progress, clearing the slot without saving it to 146 history. Saved records are untouched. [true] if a workout was discarded, 147 [false] if nothing was in progress. *) 148 149 type edit_error = Unknown_workout | Rejected_edit of Evidence.Workout.error 150 151 val find_record : 152 t -> Trainee.id -> Repository.workout_id -> Repository.record option Lwt.t 153 154 val add_to_record : 155 t -> 156 Trainee.id -> 157 Repository.workout_id -> 158 Evidence.Stimulus.t -> 159 (Repository.record, edit_error) result Lwt.t 160 161 val replace_in_record : 162 t -> 163 Trainee.id -> 164 Repository.workout_id -> 165 slot:int -> 166 Evidence.Stimulus.t -> 167 (Repository.record, edit_error) result Lwt.t 168 (** Correct a recorded slot of a saved workout. Replaces the slot's record 169 rather than adding volume. *) 170 171 val history : t -> Trainee.id -> Repository.record list Lwt.t 172 173 val progress : 174 t -> 175 Trainee.id -> 176 Exercise.t -> 177 (Progression.assessment, Progression.error) result Lwt.t 178 179 val diagnostics : t -> Trainee.id -> Progression.diagnostic list Lwt.t 180 (** Habits the record shows that HD1 names as causes of overtraining. *) 181 182 (** {2 Subjective feedback} *) 183 184 val record_feedback : 185 t -> 186 Trainee.id -> 187 reported_at:Recovery.timestamp -> 188 Evidence.Feedback.signal list -> 189 (Evidence.Feedback.t, Evidence.Feedback.error) result Lwt.t 190 (** Store a subjective feedback report. [Error] when a signal category 191 repeats. Feedback is standalone: a trainee may report it at any time, 192 independent of a workout. *) 193 194 val feedback : t -> Trainee.id -> Evidence.Feedback.t list Lwt.t 195 (** Stored feedback reports, most recent first. *) 196 197 (** {2 Application feedback} *) 198 199 type app_feedback_error = [ `Empty_message | `Unknown_feedback ] 200 (** Why an application feedback operation was refused. *) 201 202 val record_app_feedback : 203 t -> 204 Trainee.id -> 205 submitted_at:Recovery.timestamp -> 206 message:string -> 207 (Repository.app_feedback, app_feedback_error) result Lwt.t 208 (** Store a non-blank freeform application feedback message. *) 209 210 val app_feedback : t -> Trainee.id -> Repository.app_feedback list Lwt.t 211 (** All application feedback, ranked by upvotes for this viewer. *) 212 213 val upvote_app_feedback : 214 t -> Trainee.id -> Repository.app_feedback_id -> bool Lwt.t 215 (** Try to add the trainee's vote to another trainee's feedback. *) 216 217 val edit_app_feedback : 218 t -> 219 Trainee.id -> 220 Repository.app_feedback_id -> 221 message:string -> 222 (unit, app_feedback_error) result Lwt.t 223 (** Edit one of the trainee's own messages. *) 224 225 val remove_app_feedback : 226 t -> Trainee.id -> Repository.app_feedback_id -> bool Lwt.t 227 (** Remove one of the trainee's own messages. *) 228 end 229