(** Unit tests for {!Evidence}, authored against the evidence.mli contract. *)

module Stimulus = Evidence.Stimulus
module Workout = Evidence.Workout
module Feedback = Evidence.Feedback
module Log = Evidence.Log

let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"

let get id =
  match Exercise.find_id id with
  | Some e -> e
  | None -> Alcotest.failf "catalog is missing %S" id

let load n = n
let reps n = n
let at s = Recovery.timestamp_of_unix_seconds s
let day n = at (n * 86_400)

let move ?(outcome = Stimulus.Positive_failure) id load_kg rep_count =
  Stimulus.Effort.make ~exercise:(get id) ~load:(load load_kg)
    ~reps:(reps rep_count) ~outcome

let single id load r = Stimulus.make (Stimulus.Single (move id load r))
let pair first second = Stimulus.make (Stimulus.Pair { first; second })

let invalid_error f =
  try
    let _ = f () in
    None
  with Workout.Invalid error -> Some error

(* {1 One stimulus} *)

let outcome_tests =
  [
    ( "positive failure used no extension",
      `Quick,
      fun () ->
        Alcotest.(check (list string))
          "none" []
          (List.map
             (Format.asprintf "%a" Stimulus.pp_extension)
             (Stimulus.extensions_of_outcome Stimulus.Positive_failure)) );
    ( "extensions stack in the order applied",
      `Quick,
      fun () ->
        let o =
          Stimulus.Beyond_failure (Stimulus.Forced_reps, [ Stimulus.Negatives ])
        in
        Alcotest.(check (list string))
          "forced reps then negatives"
          [ "forced reps"; "negatives" ]
          (List.map
             (Format.asprintf "%a" Stimulus.pp_extension)
             (Stimulus.extensions_of_outcome o)) );
  ]

let stimulus_delivery_tests =
  [
    ( "a single movement is one stimulus",
      `Quick,
      fun () ->
        let s = single "curls" 40. 8 in
        Alcotest.(check int) "one effort" 1 (List.length (Stimulus.efforts s));
        Alcotest.(check bool) "not extended" false (Stimulus.is_extended s) );
    ( "a pre-exhaust pair is one stimulus, isolation first",
      `Quick,
      fun () ->
        let s =
          pair (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7)
        in
        Alcotest.(check int)
          "two movements" 2
          (List.length (Stimulus.efforts s));
        Alcotest.(check (list string))
          "isolation leads"
          [ "Dumbbell Flyes"; "Incline Presses" ]
          (List.map Exercise.name (Stimulus.exercises s)) );
    ( "an unrelated pair is recorded as performed",
      `Quick,
      fun () ->
        let s =
          Stimulus.make
            (Stimulus.Pair
               {
                 first = move "dumbbell-flyes" 20. 9;
                 second = move "squats" 100. 8;
               })
        in
        Alcotest.(check (list string))
          "both movements"
          [ "Dumbbell Flyes"; "Squats" ]
          (List.map Exercise.name (Stimulus.exercises s)) );
    ( "extensions are gathered across a pre-exhaust's movements",
      `Quick,
      fun () ->
        let s =
          pair
            (move "lying-french-press" 30. 9)
            (move
               ~outcome:
                 (Stimulus.Beyond_failure
                    (Stimulus.Forced_reps, [ Stimulus.Negatives ]))
               "dips" 0. 6)
        in
        Alcotest.(check bool) "extended" true (Stimulus.is_extended s);
        Alcotest.(check int)
          "two extensions" 2
          (List.length (Stimulus.extensions s)) );
  ]

(* {1 One performed workout} *)

let routine = Prescription.Routine.ideal
let prescribed n = List.nth (Prescription.Routine.workouts routine) n
let day_one = prescribed 0
let cleared = Option.get (Recovery.clear Recovery.Ready)
let fresh () = Workout.start day_one ~clearance:cleared ~started_at:(at 0)

(* HD1's Day 1, in the order it lists. *)
let day_one_stimuli =
  [
    pair (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7);
    single "laterals" 12. 8;
    single "bent-over-laterals" 10. 9;
    pair (move "lying-french-press" 30. 8) (move "dips" 0. 6);
  ]

let perform stimuli =
  List.fold_left (fun w s -> Workout.add_stimulus w s) (fresh ()) stimuli

let lifecycle_tests =
  [
    ( "a fresh workout has performed nothing and answers its prescription",
      `Quick,
      fun () ->
        let w = fresh () in
        Alcotest.(check string)
          "prescription" "Day 1"
          (Prescription.Workout.name (Workout.prescription w));
        Alcotest.(check int) "no stimuli" 0 (List.length (Workout.stimuli w));
        Alcotest.(check int)
          "four slots outstanding" 4
          (List.length (Workout.unperformed w));
        Alcotest.(check bool) "unfinished" false (Workout.is_finished w);
        Alcotest.(check bool)
          "no duration" true
          (Option.is_none (Workout.duration w)) );
    ( "HD1's Day 1 can be logged end to end",
      `Quick,
      fun () ->
        let w = perform day_one_stimuli in
        Alcotest.(check int) "four stimuli" 4 (List.length (Workout.stimuli w));
        Alcotest.(check int)
          "nothing outstanding" 0
          (List.length (Workout.unperformed w));
        let finished = Workout.finish w ~ended_at:(at 2400) in
        Alcotest.(check bool) "finished" true (Workout.is_finished finished);
        Alcotest.(check (option int))
          "40 minutes" (Some 2400)
          (Option.map Recovery.duration_to_seconds (Workout.duration finished))
    );
    ( "stimuli come back in the order performed",
      `Quick,
      fun () ->
        let w =
          perform [ single "laterals" 12. 8; single "bent-over-laterals" 10. 9 ]
        in
        Alcotest.(check (list string))
          "as performed"
          [ "Laterals"; "Bent-over Dumbbell Laterals" ]
          (List.map
             (fun s -> Exercise.name (List.hd (Stimulus.exercises s)))
             (Workout.stimuli w)) );
    ( "a finished workout remains editable and retains its end time",
      `Quick,
      fun () ->
        let w = Workout.finish (fresh ()) ~ended_at:(at 60) in
        let w = Workout.add_stimulus w (single "laterals" 12. 8) in
        let w = Workout.finish w ~ended_at:(at 120) in
        Alcotest.(check int)
          "original end" 60
          (Recovery.timestamp_to_unix_seconds (Option.get (Workout.ended_at w)));
        Alcotest.(check int) "one recorded" 1 (List.length (Workout.stimuli w))
    );
  ]

let conformance_tests =
  [
    ( "an unprescribed movement is refused",
      `Quick,
      fun () ->
        match
          invalid_error (fun () ->
              Workout.add_stimulus (fresh ()) (single "shrugs" 80. 10))
        with
        | Some (Workout.Not_prescribed id) ->
            Alcotest.(check string) "shrugs" "shrugs" (id :> string)
        | _ -> Alcotest.fail "expected Not_prescribed" );
    ( "a lone set where a pre-exhaust was prescribed is refused",
      `Quick,
      fun () ->
        match
          invalid_error (fun () ->
              Workout.add_stimulus (fresh ()) (single "dumbbell-flyes" 20. 9))
        with
        | Some
            (Workout.Delivery_mismatch
               { prescribed = Workout.As_pair; logged = Workout.As_single; _ })
          ->
            ()
        | _ -> Alcotest.fail "expected Delivery_mismatch" );
    ( "the prescribed pair, delivered as prescribed, is accepted",
      `Quick,
      fun () ->
        ignore
          (Workout.add_stimulus (fresh ())
             (pair (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7)))
    );
    ( "an allowed substitute is accepted in its own role",
      `Quick,
      fun () ->
        let w =
          Workout.add_stimulus (fresh ())
            (pair (move "pec-deck" 45. 9) (move "incline-press" 60. 7))
        in
        Alcotest.(check int) "recorded" 1 (List.length (Workout.stimuli w));
        Alcotest.(check int)
          "slot filled" 3
          (List.length (Workout.unperformed w)) );
    ( "a movement off the prescription's substitute list is refused",
      `Quick,
      fun () ->
        (* Cable crossovers substitute for flyes in the catalog, but Day 1
           permits only crossovers and pec deck — dips is never the pec
           compound. *)
        match
          invalid_error (fun () ->
              Workout.add_stimulus (fresh ())
                (pair (move "dumbbell-flyes" 20. 9) (move "dips" 0. 7)))
        with
        | Some _ -> ()
        | None -> Alcotest.fail "dips is not the prescribed pec compound" );
  ]

let volume_tests =
  [
    ( "repeated work is recorded, and shows as more stimuli than slots",
      `Quick,
      fun () ->
        (* HD1 forbids extra volume, but the log must still say what happened;
           diagnosing it is Progression's job. *)
        let w = perform [ single "laterals" 12. 8; single "laterals" 12. 6 ] in
        Alcotest.(check int) "two stimuli" 2 (List.length (Workout.stimuli w));
        Alcotest.(check int)
          "still three slots outstanding" 3
          (List.length (Workout.unperformed w)) );
    ( "unperformed shrinks as slots are answered",
      `Quick,
      fun () ->
        let w = perform [ single "laterals" 12. 8 ] in
        Alcotest.(check int)
          "three left" 3
          (List.length (Workout.unperformed w));
        let w = Workout.add_stimulus w (single "bent-over-laterals" 10. 9) in
        Alcotest.(check int) "two left" 2 (List.length (Workout.unperformed w))
    );
  ]

let editing_tests =
  [
    ( "replace_stimulus corrects a slot in place without adding volume",
      `Quick,
      fun () ->
        let w = perform [ single "laterals" 12. 8 ] in
        Alcotest.(check int) "one filled slot" 1 (Workout.filled_slots w);
        let w = Workout.replace_stimulus w ~slot:1 (single "laterals" 14. 7) in
        Alcotest.(check int) "still one filled slot" 1 (Workout.filled_slots w);
        Alcotest.(check int)
          "still one stimulus" 1
          (List.length (Workout.stimuli w));
        match Workout.stimuli w with
        | [ s ] ->
            Alcotest.(check (float 0.001))
              "corrected load" 14.
              (Stimulus.Effort.load (List.hd (Stimulus.efforts s)))
        | _ -> Alcotest.fail "expected one stimulus" );
    ( "replace_stimulus fills an empty slot as its first record",
      `Quick,
      fun () ->
        let w =
          Workout.replace_stimulus (fresh ()) ~slot:1 (single "laterals" 12. 8)
        in
        Alcotest.(check int) "one filled slot" 1 (Workout.filled_slots w);
        Alcotest.(check int)
          "three slots still outstanding" 3
          (List.length (Workout.unperformed w)) );
    ( "replace_stimulus rejects an unknown slot",
      `Quick,
      fun () ->
        match
          invalid_error (fun () ->
              Workout.replace_stimulus (fresh ()) ~slot:9
                (single "laterals" 12. 8))
        with
        | Some (Workout.No_such_slot 9) -> ()
        | _ -> Alcotest.fail "expected No_such_slot" );
    ( "replace_stimulus rejects a stimulus the slot does not call for",
      `Quick,
      fun () ->
        (* Slot 0 is the pre-exhaust pair; a lone set does not fit its shape. *)
        match
          invalid_error (fun () ->
              Workout.replace_stimulus (fresh ()) ~slot:0
                (single "dumbbell-flyes" 20. 9))
        with
        | Some (Workout.Delivery_mismatch _) -> ()
        | Some _ | None -> Alcotest.fail "expected Delivery_mismatch" );
    ( "filled_slots never exceeds the prescription despite extra volume",
      `Quick,
      fun () ->
        let w = perform [ single "laterals" 12. 8; single "laterals" 12. 6 ] in
        Alcotest.(check int)
          "two stimuli recorded" 2
          (List.length (Workout.stimuli w));
        Alcotest.(check int) "but one slot filled" 1 (Workout.filled_slots w) );
    ( "record_at appends at a slot, preserving prior fills",
      `Quick,
      fun () ->
        let w =
          Workout.record_at (fresh ()) ~slot:1 (single "laterals" 12. 8)
        in
        let w = Workout.record_at w ~slot:1 (single "laterals" 12. 6) in
        Alcotest.(check int)
          "two records at the slot" 2
          (List.length (Workout.performed w));
        Alcotest.(check int)
          "still one distinct slot" 1 (Workout.filled_slots w) );
    ( "performed pairs each stimulus with its slot",
      `Quick,
      fun () ->
        let w =
          perform [ single "laterals" 12. 8; single "bent-over-laterals" 10. 9 ]
        in
        Alcotest.(check (list int))
          "slots 1 then 2" [ 1; 2 ]
          (List.map fst (Workout.performed w)) );
  ]

let clearance_tests =
  [
    ( "a workout keeps the basis on which it was begun",
      `Quick,
      fun () ->
        let recovering =
          Recovery.evaluate_readiness ~elapsed:(Recovery.hours 12)
            ~recommended:Prescription.Routine.training_interval
        in
        let w =
          Workout.start day_one
            ~clearance:(Recovery.override recovering)
            ~started_at:(at 0)
        in
        match Recovery.basis (Workout.clearance w) with
        | Recovery.Overridden _ -> ()
        | Recovery.Recovered -> Alcotest.fail "expected Overridden" );
  ]

(* {1 The log} *)

(* A finished workout: Day n of the Ideal Routine, with stimuli logged. *)
let logged ~workout:p ~on ~stimuli =
  let w =
    List.fold_left
      (fun w s -> Workout.add_stimulus w s)
      (Workout.start p ~clearance:cleared ~started_at:on)
      stimuli
  in
  Workout.finish w ~ended_at:on

let laterals load r = single "laterals" load r

let log_basic_tests =
  [
    ( "an empty log knows nothing",
      `Quick,
      fun () ->
        Alcotest.(check int)
          "no workouts" 0
          (List.length (Log.workouts Log.empty));
        Alcotest.(check bool)
          "no last prescription" true
          (Option.is_none (Log.last_prescription Log.empty)) );
    ( "workouts come back most recent first, however they were added",
      `Quick,
      fun () ->
        let book =
          ( Log.empty |> fun b ->
            Log.add b (logged ~workout:(prescribed 1) ~on:(day 3) ~stimuli:[])
          )
          |> fun b ->
          Log.add b (logged ~workout:(prescribed 0) ~on:(day 1) ~stimuli:[])
        in
        Alcotest.(check (list string))
          "newest first" [ "Day 2"; "Day 1" ]
          (List.map
             (fun w -> Prescription.Workout.name (Workout.prescription w))
             (Log.workouts book)) );
    ( "the last prescription is what the cycle should advance from",
      `Quick,
      fun () ->
        let book =
          Log.add Log.empty
            (logged ~workout:(prescribed 1) ~on:(day 1) ~stimuli:[])
        in
        let last = Option.get (Log.last_prescription book) in
        Alcotest.(check string)
          "performed Day 2" "Day 2"
          (Prescription.Workout.name last);
        Alcotest.(check string)
          "so Day 3 is next" "Day 3"
          (Prescription.Workout.name
             (Prescription.Routine.workout_after routine last)) );
  ]

let observation_tests =
  [
    ( "observations for a movement come back oldest first",
      `Quick,
      fun () ->
        let book =
          ( Log.empty |> fun b ->
            Log.add b
              (logged ~workout:(prescribed 0) ~on:(day 5)
                 ~stimuli:[ laterals 14. 7 ]) )
          |> fun b ->
          Log.add b
            (logged ~workout:(prescribed 0) ~on:(day 1)
               ~stimuli:[ laterals 12. 8 ])
        in
        let history = Log.observations book (get "laterals") in
        Alcotest.(check int) "two observations" 2 (List.length history);
        Alcotest.(check (list (float 0.001)))
          "12kg then 14kg" [ 12.; 14. ]
          (List.map
             (fun (o : Log.observation) -> Stimulus.Effort.load o.effort)
             history) );
    ( "observations are dated, so a stall can be measured",
      `Quick,
      fun () ->
        let book =
          Log.add Log.empty
            (logged ~workout:(prescribed 0) ~on:(day 2)
               ~stimuli:[ laterals 12. 8 ])
        in
        match Log.observations book (get "laterals") with
        | [ o ] ->
            Alcotest.(check int)
              "day 2" 172_800
              (Recovery.timestamp_to_unix_seconds o.performed_at)
        | _ -> Alcotest.fail "expected one observation" );
    ( "a movement never performed has no observations",
      `Quick,
      fun () ->
        let book =
          Log.add Log.empty
            (logged ~workout:(prescribed 0) ~on:(day 1)
               ~stimuli:[ laterals 12. 8 ])
        in
        Alcotest.(check int)
          "none" 0
          (List.length (Log.observations book (get "squats"))) );
    ( "both halves of a pre-exhaust are recorded separately",
      `Quick,
      fun () ->
        let pair =
          pair (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7)
        in
        let book =
          Log.add Log.empty
            (logged ~workout:(prescribed 0) ~on:(day 1) ~stimuli:[ pair ])
        in
        Alcotest.(check int)
          "isolation" 1
          (List.length (Log.observations book (get "dumbbell-flyes")));
        Alcotest.(check int)
          "compound" 1
          (List.length (Log.observations book (get "incline-press"))) );
  ]

let readiness_tests =
  [
    ( "an empty log is ready: nothing to recover from",
      `Quick,
      fun () ->
        Alcotest.(check bool)
          "ready" true
          (Recovery.is_ready
             (Log.readiness Log.empty ~now:(day 1)
                ~recommended:Prescription.Routine.training_interval)) );
    ( "readiness is measured from the last finished workout",
      `Quick,
      fun () ->
        let book =
          Log.add Log.empty
            (logged ~workout:(prescribed 0) ~on:(day 1) ~stimuli:[])
        in
        Alcotest.(check bool)
          "one day later, still recovering" false
          (Recovery.is_ready
             (Log.readiness book ~now:(day 2)
                ~recommended:Prescription.Routine.training_interval));
        Alcotest.(check bool)
          "two days later, ready" true
          (Recovery.is_ready
             (Log.readiness book ~now:(day 3)
                ~recommended:Prescription.Routine.training_interval)) );
    ( "an unfinished workout leaves nothing to recover from",
      `Quick,
      fun () ->
        let unfinished =
          Workout.start (prescribed 0) ~clearance:cleared ~started_at:(day 1)
        in
        let book = Log.add Log.empty unfinished in
        Alcotest.(check bool)
          "ready" true
          (Recovery.is_ready
             (Log.readiness book ~now:(day 1)
                ~recommended:Prescription.Routine.training_interval)) );
  ]

let completion_feedback_tests =
  [
    ( "feedback rejects duplicate signal categories",
      `Quick,
      fun () ->
        let open Feedback in
        match
          try
            ignore (make ~reported_at:(at 60) [ Sleep Poor; Sleep Good ]);
            None
          with Invalid error -> Some error
        with
        | Some (Duplicate_signal (Sleep Good)) -> ()
        | _ -> Alcotest.fail "expected duplicate sleep rejection" );
    ( "feedback retains its report time and signals",
      `Quick,
      fun () ->
        let open Feedback in
        let feedback =
          make ~reported_at:(at 60)
            [
              Sleep Good;
              Appetite Fair;
              Readiness Good;
              Motivation Good;
              Difficulty Fair;
              Preparation_insufficient;
            ]
        in
        Alcotest.(check int)
          "report time" 60
          (Recovery.timestamp_to_unix_seconds (reported_at feedback));
        Alcotest.(check int) "six signals" 6 (List.length (signals feedback)) );
  ]

let suite =
  [
    ("evidence.stimulus.outcome", outcome_tests);
    ("evidence.stimulus.delivery", stimulus_delivery_tests);
    ("evidence.workout.lifecycle", lifecycle_tests);
    ("evidence.workout.conformance", conformance_tests);
    ("evidence.workout.volume", volume_tests);
    ("evidence.workout.editing", editing_tests);
    ("evidence.workout.clearance", clearance_tests);
    ("evidence.workout.completion_feedback", completion_feedback_tests);
    ("evidence.log.basics", log_basic_tests);
    ("evidence.log.observations", observation_tests);
    ("evidence.log.readiness", readiness_tests);
  ]