module Make (R : Repository.S) = struct
  open Lwt.Infix

  type t = { repo : R.t }

  let make ~repo = { repo }

  (* Error types are part of the flat public interface, so they live at the top
     level of the functor. The implementation below is grouped into focused
     use-case modules over the shared [t]; the public names are re-exported at
     the end, so callers and {!Service.mli} see one flat service. *)

  type register_error = [ `Username of Trainee.username_error | `Username_taken ]

  type change_username_error =
    [ `Username of Trainee.username_error | `Username_taken | `Unknown ]

  type change_password_error = [ `Incorrect_password | `Unknown ]
  type error = Unknown_routine | Not_recovered of Recovery.readiness

  let pp_error ppf = function
    | Unknown_routine -> Format.pp_print_string ppf "no such routine"
    | Not_recovered readiness ->
        Format.fprintf ppf "not recovered: %a" Recovery.pp_readiness readiness

  type log_error = No_workout_in_progress | Rejected of Evidence.Workout.error

  let pp_log_error ppf = function
    | No_workout_in_progress ->
        Format.pp_print_string ppf "no workout in progress"
    | Rejected e -> Evidence.Workout.pp_error ppf e

  type edit_error = Unknown_workout | Rejected_edit of Evidence.Workout.error
  type app_feedback_error = [ `Empty_message | `Unknown_feedback ]

  (* Shared helpers over a routine and a log, used by more than one use case. *)

  let routine t id =
    match R.find_routine t.repo id with
    | Some r -> Ok r
    | None -> Error Unknown_routine

  (* Where the cycle stands. With nothing logged, start at the beginning. *)
  let next_of routine log =
    match Evidence.Log.last_prescription log with
    | Some last -> Prescription.Routine.workout_after routine last
    | None -> List.hd (Prescription.Routine.workouts routine)

  (* How long HD1 asks you to rest depends on where in the cycle you are, so
     the recommendation comes from the last workout performed. *)
  let recommended routine log =
    match Evidence.Log.last_prescription log with
    | Some last -> Prescription.Routine.recovery_after routine last
    | None -> Prescription.Routine.training_interval

  (* --- accounts --- *)
  module Accounts = struct
    let register t ~username ~password =
      let open Lwt_result.Syntax in
      (* Validate the username, hash the password, then create the account.
         Username validation short-circuits into [register_error]; the password
         carries no policy, so hashing always succeeds. *)
      let* username =
        Lwt.return
          (Result.map_error (fun e -> `Username e) (Trainee.username username))
      in
      let credential = Trainee.hash_password password in
      Lwt_result.map_error
        (fun `Username_taken -> `Username_taken)
        (R.create_trainee t.repo ~username ~credential)

    let authenticate t ~username ~password =
      match Trainee.username username with
      | Error _ -> Lwt.return None
      | Ok username -> (
          R.find_trainee_by_username t.repo username >|= function
          | Some trainee
            when Trainee.verify_password trainee.Trainee.credential password ->
              Some trainee
          | _ -> None)

    let find_trainee t id = R.find_trainee t.repo id

    (* Rename the account. Validate the new name, then let the repository check
       it is free. The trainee's own current name is accepted as a no-op. *)
    let change_username t id ~username =
      let open Lwt_result.Syntax in
      let* username =
        Lwt.return
          (Result.map_error (fun e -> `Username e) (Trainee.username username))
      in
      Lwt_result.map_error
        (fun `Username_taken -> `Username_taken)
        (R.update_username t.repo id username)

    (* Change the password. The current password must verify first, so a
       hijacked session cannot silently reset it. Passwords carry no policy, so
       any new password is accepted once the current one checks out. *)
    let change_password t id ~current ~next =
      R.find_trainee t.repo id >>= function
      | None -> Lwt.return (Error `Unknown)
      | Some trainee ->
          if not (Trainee.verify_password trainee.Trainee.credential current)
          then Lwt.return (Error `Incorrect_password)
          else
            R.update_credential t.repo id (Trainee.hash_password next)
            >|= fun updated -> Option.to_result ~none:`Unknown updated
  end

  (* --- routines and selection --- *)
  module Routines = struct
    let list_routines t = R.list_routines t.repo

    let select_routine t trainee id =
      match R.find_routine t.repo id with
      | None -> Lwt.return (Error Unknown_routine)
      | Some _ -> R.set_active_routine t.repo trainee id >|= fun () -> Ok ()

    let active_routine t trainee =
      R.active_routine t.repo trainee >|= function
      | None -> None
      | Some id ->
          Option.map (fun routine -> (id, routine)) (R.find_routine t.repo id)

    let next_workout t trainee ~routine:id =
      let open Lwt_result.Syntax in
      let* r = Lwt.return (routine t id) in
      let+ log = Lwt_result.ok (R.log t.repo trainee) in
      next_of r log

    let readiness t trainee ~routine:id ~now =
      let open Lwt_result.Syntax in
      let* r = Lwt.return (routine t id) in
      let+ log = Lwt_result.ok (R.log t.repo trainee) in
      Evidence.Log.readiness log ~now ~recommended:(recommended r log)
  end

  (* --- the workout in progress --- *)
  module Workouts = struct
    let begin_workout t trainee ~routine:id ~now ?override () =
      let open Lwt_result.Syntax in
      let* r = Lwt.return (routine t id) in
      let* log = Lwt_result.ok (R.log t.repo trainee) in
      let readiness =
        Evidence.Log.readiness log ~now ~recommended:(recommended r log)
      in
      let clearance =
        match (Recovery.clear readiness, override) with
        | Some c, _ -> Some c
        | None, Some () -> Some (Recovery.override readiness)
        | None, None -> None
      in
      match clearance with
      | None -> Lwt.return (Error (Not_recovered readiness))
      | Some clearance ->
          let workout =
            Evidence.Workout.start (next_of r log) ~clearance ~started_at:now
          in
          let+ () =
            Lwt_result.ok (R.set_in_progress t.repo trainee (Some workout))
          in
          workout

    let in_progress t trainee = R.in_progress t.repo trainee

    let log t trainee stimulus =
      R.in_progress t.repo trainee >>= function
      | None -> Lwt.return (Error No_workout_in_progress)
      | Some workout -> (
          match Evidence.Workout.add_stimulus workout stimulus with
          | updated ->
              R.set_in_progress t.repo trainee (Some updated) >|= fun () ->
              Ok updated
          | exception Evidence.Workout.Invalid error ->
              Lwt.return (Error (Rejected error)))

    let replace_current t trainee ~slot stimulus =
      R.in_progress t.repo trainee >>= function
      | None -> Lwt.return (Error No_workout_in_progress)
      | Some workout -> (
          match Evidence.Workout.replace_stimulus workout ~slot stimulus with
          | updated ->
              R.set_in_progress t.repo trainee (Some updated) >|= fun () ->
              Ok updated
          | exception Evidence.Workout.Invalid error ->
              Lwt.return (Error (Rejected error)))

    let finish t trainee ~ended_at =
      R.in_progress t.repo trainee >>= function
      | None -> Lwt.return None
      | Some workout ->
          let finished = Evidence.Workout.finish workout ~ended_at in
          R.finish_workout t.repo trainee finished >|= fun record -> Some record

    (* Discard the workout in progress. This clears the slot only; it never
       writes to history, so a cancelled workout leaves no record. The doctrine
       keeps plan and record distinct — an abandoned session is not evidence. *)
    let cancel t trainee =
      R.in_progress t.repo trainee >>= function
      | None -> Lwt.return false
      | Some _ -> R.set_in_progress t.repo trainee None >|= fun () -> true
  end

  (* --- saved records --- *)
  module Records = struct
    let find_record t trainee id = R.find t.repo trainee id

    (* Apply every saved-record edit through the same lookup, validation, and
       replacement path. This keeps add and correction operations consistent. *)
    let update_record t trainee id ~edit =
      R.find t.repo trainee id >>= function
      | None -> Lwt.return (Error Unknown_workout)
      | Some record -> (
          match edit record.Repository.workout with
          | Error error -> Lwt.return (Error (Rejected_edit error))
          | Ok workout ->
              R.replace t.repo trainee { record with Repository.workout }
              >|= fun replaced ->
              if replaced then Ok { record with Repository.workout }
              else Error Unknown_workout)

    let add_to_record t trainee id stimulus =
      update_record t trainee id ~edit:(fun workout ->
          try Ok (Evidence.Workout.add_stimulus workout stimulus)
          with Evidence.Workout.Invalid error -> Error error)

    let replace_in_record t trainee id ~slot stimulus =
      update_record t trainee id ~edit:(fun workout ->
          try Ok (Evidence.Workout.replace_stimulus workout ~slot stimulus)
          with Evidence.Workout.Invalid error -> Error error)

    let history t trainee = R.history t.repo trainee
  end

  (* --- what the record means --- *)
  module Assessment = struct
    let progress t trainee exercise =
      R.log t.repo trainee >|= fun log ->
      match Progression.assess (Evidence.Log.observations log exercise) with
      | assessment -> Ok assessment
      | exception Progression.Invalid error -> Error error

    let diagnostics t trainee =
      R.log t.repo trainee >|= fun log -> Progression.diagnose log
  end

  (* --- subjective feedback --- *)
  module Feedback = struct
    let record t trainee ~reported_at signals =
      match Evidence.Feedback.make ~reported_at signals with
      | report -> R.save_feedback t.repo trainee report >|= fun () -> Ok report
      | exception Evidence.Feedback.Invalid error -> Lwt.return (Error error)

    let list t trainee = R.feedback t.repo trainee
  end

  (* --- application feedback --- *)
  module App_feedback = struct
    let record t trainee ~submitted_at ~message =
      if String.trim message = "" then Lwt.return (Error `Empty_message)
      else
        R.save_app_feedback t.repo trainee ~submitted_at ~message
        >|= fun report -> Ok report

    let list t trainee = R.app_feedback t.repo ~viewer:trainee
    let upvote t trainee id = R.upvote_app_feedback t.repo ~voter:trainee id

    let edit t trainee id ~message =
      if String.trim message = "" then Lwt.return (Error `Empty_message)
      else
        R.update_app_feedback t.repo ~author:trainee id ~message >|= function
        | true -> Ok ()
        | false -> Error `Unknown_feedback

    let remove t trainee id = R.delete_app_feedback t.repo ~author:trainee id
  end

  (* Re-export the use cases as one flat service, matching Service.mli. *)

  let register = Accounts.register
  let authenticate = Accounts.authenticate
  let find_trainee = Accounts.find_trainee
  let change_username = Accounts.change_username
  let change_password = Accounts.change_password
  let list_routines = Routines.list_routines
  let select_routine = Routines.select_routine
  let active_routine = Routines.active_routine
  let next_workout = Routines.next_workout
  let readiness = Routines.readiness
  let begin_workout = Workouts.begin_workout
  let in_progress = Workouts.in_progress
  let log = Workouts.log
  let replace_current = Workouts.replace_current
  let finish = Workouts.finish
  let cancel = Workouts.cancel
  let find_record = Records.find_record
  let add_to_record = Records.add_to_record
  let replace_in_record = Records.replace_in_record
  let history = Records.history
  let progress = Assessment.progress
  let diagnostics = Assessment.diagnostics
  let record_feedback = Feedback.record
  let feedback = Feedback.list
  let record_app_feedback = App_feedback.record
  let app_feedback = App_feedback.list
  let upvote_app_feedback = App_feedback.upvote
  let edit_app_feedback = App_feedback.edit
  let remove_app_feedback = App_feedback.remove
end