(** Deterministic native history for the local development account.

    The fixture uses the application repository port, so it exercises the same
    stored-workout path as a real trainee. It does not belong in production. *)

open Lwt.Infix

module Make (R : Repository.S) (H : Password_hash.S) = struct
  module App_service = Service.Make (R) (H)
  module Stimulus = Evidence.Stimulus

  let day = 86_400
  let fixture_days = 90
  let cycle_days = 7
  let session_offsets = [ 0; 2; 4 ]

  let load_for exercise =
    match (Exercise.id exercise :> string) with
    | "dumbbell-flyes" -> 18.
    | "incline-press" -> 55.
    | "laterals" -> 10.
    | "bent-over-laterals" -> 8.
    | "lying-french-press" -> 25.
    | "dips" -> 0.
    | "pullovers" -> 20.
    | "close-grip-pulldowns" -> 50.
    | "bent-over-rows" -> 50.
    | "shrugs" -> 60.
    | "hyperextensions" -> 0.
    | "curls" -> 30.
    | "preacher-curls" -> 25.
    | "leg-extensions" -> 40.
    | "leg-presses" -> 120.
    | "squats" -> 70.
    | "leg-curls" -> 35.
    | "calf-raises" -> 60.
    | "sit-ups" -> 0.
    | "straight-arm-pulldowns" -> 35.
    | "reverse-pec-deck" -> 30.
    | "pressdowns" -> 30.
    | "triceps-machine" -> 35.
    | "deadlifts" -> 90.
    | _ -> 10.

  let effort ~cycle exercise =
    let load = load_for exercise in
    let load = if Float.equal load 0. then 0. else load +. float_of_int cycle in
    let reps = 6 + (cycle mod 5) in
    match
      Stimulus.Effort.make ~exercise ~load ~reps
        ~outcome:Stimulus.Positive_failure
    with
    | Ok effort -> effort
    | Error error ->
        invalid_arg
          (Format.asprintf "invalid development fixture effort: %a"
             Stimulus.Effort.pp_error error)

  let stimulus ~cycle prescription =
    let single exercise =
      Stimulus.make (Stimulus.Single (effort ~cycle exercise))
    in
    match Prescription.Stimulus.delivery prescription with
    | Prescription.Stimulus.Single exercise -> single exercise
    | Prescription.Stimulus.Pre_exhaust { isolation; compound } ->
        Stimulus.make
          (Stimulus.Pair
             {
               first = effort ~cycle isolation;
               second = effort ~cycle compound;
             })

  let complete_workout ~cycle ~started_at prescription =
    let clearance = Option.get (Recovery.clear Recovery.Ready) in
    let workout = Evidence.Workout.start prescription ~clearance ~started_at in
    let workout =
      Prescription.Workout.stimuli prescription
      |> List.mapi (fun slot prescription -> (slot, prescription))
      |> List.fold_left
           (fun workout (slot, prescription) ->
             Evidence.Workout.record_at workout ~slot
               (stimulus ~cycle prescription))
           workout
    in
    Evidence.Workout.finish workout
      ~ended_at:
        (Recovery.timestamp_to_unix_seconds started_at + (45 * 60)
        |> Recovery.timestamp_of_unix_seconds)

  let seed_history repo trainee_id ~now routine =
    let first =
      Recovery.timestamp_to_unix_seconds now - (fixture_days * day)
      |> Recovery.timestamp_of_unix_seconds
    in
    let sessions =
      List.init 13 (fun cycle ->
          List.map
            (fun offset -> (cycle, (cycle * cycle_days) + offset, offset / 2))
            session_offsets)
      |> List.concat
    in
    Lwt_list.iter_s
      (fun (cycle, offset_days, workout_index) ->
        let started_at =
          Recovery.timestamp_to_unix_seconds first + (offset_days * day)
          |> Recovery.timestamp_of_unix_seconds
        in
        let prescription =
          List.nth (Prescription.Routine.workouts routine) workout_index
        in
        let workout = complete_workout ~cycle ~started_at prescription in
        R.finish_workout repo trainee_id workout >|= ignore)
      sessions

  let find_or_register service repo =
    App_service.register service ~username:"test" ~password:"test" >>= function
    | Ok trainee -> Lwt.return_some trainee
    | Error App_service.Username_taken -> (
        match Trainee.username "test" with
        | Error _ -> Lwt.return_none
        | Ok username -> R.find_trainee_by_username repo username)
    | Error (App_service.Username_invalid error) ->
        Lwt.fail_with
          (Format.asprintf "cannot seed development user: %a"
             Trainee.pp_username_error error)

  let seed repo ~now =
    let service = App_service.make ~repo in
    find_or_register service repo >>= function
    | None -> Lwt.return_unit
    | Some trainee -> (
        let trainee_id = trainee.Trainee.id in
        R.set_active_routine repo trainee_id (Repository.routine_id "ideal")
        >>= fun () ->
        R.history repo trainee_id >>= function
        | _ :: _ -> Lwt.return_unit
        | [] -> (
            match R.find_routine repo (Repository.routine_id "ideal") with
            | None ->
                Lwt.fail_with
                  "cannot seed development user: Ideal Routine missing"
            | Some routine -> seed_history repo trainee_id ~now routine))
end