1 (** Tests for {!Hito_app.Codec} — the serialization boundary for stored facts. A 2 stored workout must rebuild identically, since the logbook is the only 3 source of evidence. *) 4 5 open Hito_app 6 module Stimulus = Evidence.Stimulus 7 module Workout = Evidence.Workout 8 9 let get id = 10 match Exercise.find_id id with 11 | Some e -> e 12 | None -> Alcotest.failf "catalog is missing %S" id 13 14 let at s = Recovery.timestamp_of_unix_seconds s 15 let find_routine = Catalog.find_by_name 16 17 let move ?(outcome = Stimulus.Positive_failure) id load reps = 18 Stimulus.Effort.make ~exercise:(get id) ~load ~reps ~outcome 19 20 let single id load reps = Stimulus.make (Stimulus.Single (move id load reps)) 21 let pair ~first ~second = Stimulus.make (Stimulus.Pair { first; second }) 22 23 (* A performed Day 1, including an extension, to exercise every branch. *) 24 let sample_workout ?(finished = true) () = 25 let clearance = Option.get (Recovery.clear Recovery.Ready) in 26 let day_one = 27 List.hd (Prescription.Routine.workouts Prescription.Routine.ideal) 28 in 29 let w = Workout.start day_one ~clearance ~started_at:(at 100) in 30 let w = 31 Workout.add_stimulus w 32 (pair 33 ~first:(move "dumbbell-flyes" 20. 9) 34 ~second:(move "incline-press" 60. 7)) 35 in 36 let w = 37 Workout.add_stimulus w 38 ( single "laterals" 12. 8 |> fun _ -> 39 Stimulus.make 40 (Stimulus.Single 41 (move "laterals" 12. 8 42 ~outcome: 43 (Stimulus.Beyond_failure 44 (Stimulus.Forced_reps, [ Stimulus.Negatives ])))) ) 45 in 46 if finished then Workout.finish w ~ended_at:(at 3700) else w 47 48 let describe w = 49 ( Prescription.Workout.name (Workout.prescription w), 50 Recovery.timestamp_to_unix_seconds (Workout.started_at w), 51 Option.map Recovery.timestamp_to_unix_seconds (Workout.ended_at w), 52 List.length (Workout.stimuli w), 53 Workout.is_finished w ) 54 55 let roundtrip w = 56 let encoded = Codec.encode_workout ~routine_name:"Ideal Routine" w in 57 match Codec.decode_workout ~find_routine encoded with 58 | Ok decoded -> decoded 59 | Error e -> Alcotest.failf "decode failed: %a" Codec.pp_error e 60 61 let timestamp_tests = 62 [ 63 ( "encodes Unix epoch in UTC Zulu form", 64 `Quick, 65 fun () -> 66 Alcotest.(check string) 67 "epoch" "1970-01-01T00:00:00Z" 68 (Timestamp.encode (at 0)) ); 69 ( "round-trips an ISO timestamp", 70 `Quick, 71 fun () -> 72 let original = at 1_700_000_000 in 73 match Timestamp.decode (Timestamp.encode original) with 74 | Ok decoded -> 75 Alcotest.(check int) 76 "same seconds" 77 (Recovery.timestamp_to_unix_seconds original) 78 (Recovery.timestamp_to_unix_seconds decoded) 79 | Error _ -> Alcotest.fail "expected a valid timestamp" ); 80 ( "rejects an invalid calendar date", 81 `Quick, 82 fun () -> 83 match Timestamp.decode "2024-02-30T00:00:00Z" with 84 | Error _ -> () 85 | Ok _ -> Alcotest.fail "expected an invalid date" ); 86 ] 87 88 let codec_tests = 89 [ 90 ( "a finished workout round-trips faithfully", 91 `Quick, 92 fun () -> 93 let w = sample_workout () in 94 let d = roundtrip w in 95 Alcotest.(check (list string)) 96 "same rendered stimuli" 97 (List.map (Format.asprintf "%a" Stimulus.pp) (Workout.stimuli w)) 98 (List.map (Format.asprintf "%a" Stimulus.pp) (Workout.stimuli d)); 99 let name, started, ended, count, finished = describe w in 100 let name', started', ended', count', finished' = describe d in 101 Alcotest.(check string) "name" name name'; 102 Alcotest.(check int) "started" started started'; 103 Alcotest.(check (option int)) "ended" ended ended'; 104 Alcotest.(check int) "count" count count'; 105 Alcotest.(check bool) "finished" finished finished' ); 106 ( "an in-progress workout has no end after round-trip", 107 `Quick, 108 fun () -> 109 let w = sample_workout ~finished:false () in 110 let d = roundtrip w in 111 Alcotest.(check bool) "still open" false (Workout.is_finished d) ); 112 ( "an overridden clearance round-trips as an override", 113 `Quick, 114 fun () -> 115 let readiness = 116 Recovery.Recovering 117 { rested = Recovery.hours 10; recommended = Recovery.hours 48 } 118 in 119 let clearance = Recovery.override readiness in 120 let day_one = 121 List.hd (Prescription.Routine.workouts Prescription.Routine.ideal) 122 in 123 let w = Workout.start day_one ~clearance ~started_at:(at 100) in 124 let d = roundtrip w in 125 match Recovery.basis (Workout.clearance d) with 126 | Recovery.Overridden { rested; recommended } -> 127 Alcotest.(check int) 128 "rested seconds" 129 (Recovery.duration_to_seconds (Recovery.hours 10)) 130 (Recovery.duration_to_seconds rested); 131 Alcotest.(check int) 132 "recommended seconds" 133 (Recovery.duration_to_seconds (Recovery.hours 48)) 134 (Recovery.duration_to_seconds recommended) 135 | Recovery.Recovered -> Alcotest.fail "expected Overridden" ); 136 ( "an unknown routine is reported, not raised", 137 `Quick, 138 fun () -> 139 let w = sample_workout () in 140 let encoded = Codec.encode_workout ~routine_name:"Nonexistent" w in 141 match Codec.decode_workout ~find_routine encoded with 142 | Error (Codec.Unknown_routine "Nonexistent") -> () 143 | _ -> Alcotest.fail "expected Unknown_routine" ); 144 ( "a malformed line is reported as malformed", 145 `Quick, 146 fun () -> 147 let encoded = 148 "routine\tIdeal Routine\nprescription\tDay 1\ngibberish\tvalue\n" 149 in 150 match Codec.decode_workout ~find_routine encoded with 151 | Error (Codec.Malformed _) -> () 152 | _ -> Alcotest.fail "expected Malformed" ); 153 ( "missing header fields are reported, not replayed", 154 `Quick, 155 fun () -> 156 (* A well-formed line, but no started/clearance: parse must refuse 157 before replay rather than build a partial workout. *) 158 let encoded = "routine\tIdeal Routine\nprescription\tDay 1\n" in 159 match Codec.decode_workout ~find_routine encoded with 160 | Error (Codec.Malformed _) -> () 161 | _ -> Alcotest.fail "expected Malformed for missing fields" ); 162 ( "a corrected slot round-trips, preserving the slot mapping", 163 `Quick, 164 fun () -> 165 (* Fill slot 1, then correct it: replace, not append. The encoding 166 carries the slot, so replay reproduces one filled slot, not two. *) 167 let day_one = 168 List.hd (Prescription.Routine.workouts Prescription.Routine.ideal) 169 in 170 let clearance = Option.get (Recovery.clear Recovery.Ready) in 171 let w = Workout.start day_one ~clearance ~started_at:(at 100) in 172 let w = Workout.add_stimulus w (single "laterals" 12. 8) in 173 let w = Workout.replace_stimulus w ~slot:1 (single "laterals" 14. 7) in 174 let d = roundtrip w in 175 Alcotest.(check int) 176 "one filled slot survives" 1 (Workout.filled_slots d); 177 Alcotest.(check (list int)) 178 "same slot mapping" 179 (List.map fst (Workout.performed w)) 180 (List.map fst (Workout.performed d)); 181 Alcotest.(check (float 0.001)) 182 "corrected load survives" 14. 183 (Stimulus.Effort.load 184 (List.hd (Stimulus.efforts (List.hd (Workout.stimuli d))))) ); 185 ] 186 187 let feedback_tests = 188 [ 189 ( "five-point feedback round-trips every score", 190 `Quick, 191 fun () -> 192 let open Evidence.Feedback in 193 let report = 194 make ~reported_at:(at 100) 195 [ 196 Sleep Very_poor; 197 Appetite Poor; 198 Readiness Fair; 199 Motivation Good; 200 Difficulty Very_good; 201 Pain; 202 ] 203 in 204 match Codec.decode_feedback (Codec.encode_feedback report) with 205 | Ok decoded -> 206 let show s = 207 let lvl l = string_of_int (level_to_score l) in 208 match s with 209 | Sleep l -> "sleep:" ^ lvl l 210 | Appetite l -> "appetite:" ^ lvl l 211 | Readiness l -> "readiness:" ^ lvl l 212 | Motivation l -> "motivation:" ^ lvl l 213 | Difficulty l -> "difficulty:" ^ lvl l 214 | Pain -> "pain" 215 | Injury -> "injury" 216 | Preparation_insufficient -> "preparation" 217 in 218 Alcotest.(check int) 219 "report time" 100 220 (Recovery.timestamp_to_unix_seconds (reported_at decoded)); 221 Alcotest.(check (list string)) 222 "same signals" 223 (List.map show (signals report)) 224 (List.map show (signals decoded)) 225 | Error e -> Alcotest.failf "decode failed: %a" Codec.pp_error e ); 226 ( "an out-of-range score is reported as malformed", 227 `Quick, 228 fun () -> 229 match Codec.decode_feedback "1970-01-01T00:00:00Z\tsleep:6" with 230 | Error (Codec.Malformed _) -> () 231 | _ -> Alcotest.fail "expected Malformed for score 6" ); 232 ] 233 234 let suite = 235 [ 236 ("timestamp", timestamp_tests); 237 ("codec", codec_tests); 238 ("feedback", feedback_tests); 239 ] 240