1 module Decode = Hito_web.Decode 2 module Form = Dream_html.Form 3 4 let exercise id = 5 match Exercise.find_id id with 6 | Some exercise -> exercise 7 | None -> Alcotest.failf "catalog is missing %S" id 8 9 let single = 10 Prescription.Stimulus.make 11 ~delivery:(Prescription.Stimulus.Single (exercise "laterals")) 12 ~rep_range:(Prescription.Rep_range.make ~min:6 ~max:10) 13 ~allowed_substitutes:[] 14 15 let stimulus_tests = 16 [ 17 ( "decoder", 18 [ 19 ( "accepts a single working stimulus", 20 `Quick, 21 fun () -> 22 match 23 Form.validate (Decode.stimulus single) 24 [ ("load", "30"); ("reps", "8"); ("extension", "") ] 25 with 26 | Ok _ -> () 27 | Error errors -> 28 Alcotest.failf "unexpected validation errors: %a" Form.pp_error 29 errors ); 30 ( "rejects an unknown extension", 31 `Quick, 32 fun () -> 33 match 34 Form.validate (Decode.stimulus single) 35 [ ("load", "30"); ("reps", "8"); ("extension", "invented") ] 36 with 37 | Error [ ("extension", "error.extension") ] -> () 38 | Error errors -> 39 Alcotest.failf "unexpected errors: %a" Form.pp_error errors 40 | Ok _ -> Alcotest.fail "expected extension validation failure" ); 41 ( "accepts a zero load for bodyweight effort", 42 `Quick, 43 fun () -> 44 match 45 Form.validate (Decode.stimulus single) 46 [ ("load", "0"); ("reps", "8"); ("extension", "") ] 47 with 48 | Ok stimulus -> 49 let effort = List.hd (Evidence.Stimulus.efforts stimulus) in 50 Alcotest.(check (float 0.001)) 51 "zero load" 0. 52 (Evidence.Stimulus.Effort.load effort) 53 | Error errors -> 54 Alcotest.failf "unexpected validation errors: %a" Form.pp_error 55 errors ); 56 ( "rejects a negative load", 57 `Quick, 58 fun () -> 59 match 60 Form.validate (Decode.stimulus single) 61 [ ("load", "-1"); ("reps", "8"); ("extension", "") ] 62 with 63 | Error [ ("load", "error.load") ] -> () 64 | Error errors -> 65 Alcotest.failf "unexpected errors: %a" Form.pp_error errors 66 | Ok _ -> Alcotest.fail "expected load validation failure" ); 67 ] ); 68 ] 69 70 let suite = stimulus_tests 71