(.using
 [library
  [lux "*"
   [abstract
    [monad {"+" do}]]
   [control
    ["[0]" io]
    ["[0]" exception]
    [concurrency
     ["[0]" async]
     ["[0]" atom {"+" Atom}]]]
   [data
    ["[0]" text ("[1]#[0]" equivalence)
     ["%" format]]
    [collection
     ["[0]" list]
     ["[0]" set]]]
   [math
    ["[0]" random]
    [number
     ["n" nat]]]]]
 [\\library
  ["[0]" /]])

(def: (verify expected_message/0 expected_message/1 successes failures [tally message])
  (-> Text Text Nat Nat [/.Tally Text] Bit)
  (and (text.contains? expected_message/0 message)
       (text.contains? expected_message/1 message)
       (n.= successes (value@ /.#successes tally))
       (n.= failures (value@ /.#failures tally))))

(def: assertion
  /.Test
  (do [! random.monad]
    [expected_message/0 (random.ascii/lower 5)
     expected_message/1 (random.only (|>> (text#= expected_message/0) not)
                                     (random.ascii/lower 5))]
    ($_ /.and
        (in (do async.monad
              [[success_tally success_message] (/.assertion expected_message/0 true)
               [failure_tally failure_message] (/.assertion expected_message/0 false)]
              (/.cover' [/.assertion /.Tally]
                        (and (text.ends_with? expected_message/0 success_message)
                             (text.ends_with? expected_message/0 failure_message)
                             (and (n.= 1 (value@ /.#successes success_tally))
                                  (n.= 0 (value@ /.#failures success_tally)))
                             (and (n.= 0 (value@ /.#successes failure_tally))
                                  (n.= 1 (value@ /.#failures failure_tally)))))))
        (in (do async.monad
              [tt (/.and' (/.assertion expected_message/0 true)
                          (/.assertion expected_message/1 true))
               ff (/.and' (/.assertion expected_message/0 false)
                          (/.assertion expected_message/1 false))
               tf (/.and' (/.assertion expected_message/0 true)
                          (/.assertion expected_message/1 false))
               ft (/.and' (/.assertion expected_message/0 false)
                          (/.assertion expected_message/1 true))]
              (/.cover' [/.and']
                        (and (..verify expected_message/0 expected_message/1 2 0 tt)
                             (..verify expected_message/0 expected_message/1 0 2 ff)
                             (..verify expected_message/0 expected_message/1 1 1 tf)
                             (..verify expected_message/0 expected_message/1 1 1 ft)))))
        )))

(def: seed
  /.Test
  (do [! random.monad]
    [seed random.nat
     .let [[read write] (: [(async.Async Nat) (async.Resolver Nat)]
                           (async.async []))]
     pre (<| (/.seed seed)
             (do !
               [sample random.nat
                .let [wrote? (io.run! (write sample))]]
               (/.test "" wrote?)))
     post (<| (/.seed seed)
              (do !
                [actual random.nat]
                (in (do async.monad
                      [expected read]
                      (/.assertion "" (n.= expected actual))))))]
    (in (do async.monad
          [[pre_tally pre_message] pre
           [post_tally post_message] post]
          (/.cover' [/.seed]
                    (and (and (n.= 1 (value@ /.#successes pre_tally))
                              (n.= 0 (value@ /.#failures pre_tally)))
                         (and (n.= 1 (value@ /.#successes post_tally))
                              (n.= 0 (value@ /.#failures post_tally)))))))))

(def: times
  /.Test
  ($_ /.and
      (do [! random.monad]
        [times_assertion (/.times 0 (/.test "" true))]
        (in (do async.monad
              [[tally error] times_assertion]
              (/.cover' [/.must_try_test_at_least_once]
                        (and (text.contains? (value@ exception.#label /.must_try_test_at_least_once) error)
                             (n.= 0 (value@ /.#successes tally))
                             (n.= 1 (value@ /.#failures tally)))))))
      (do [! random.monad]
        [expected (# ! each (|>> (n.% 10) ++) random.nat)
         .let [counter (: (Atom Nat)
                          (atom.atom 0))]
         times_assertion (<| (/.times expected)
                             (do !
                               [_ (in [])
                                .let [_ (io.run! (atom.update! ++ counter))]]
                               (/.test "" true)))]
        (in (do async.monad
              [[tally error] times_assertion
               actual (async.future (atom.read! counter))]
              (/.cover' [/.times]
                        (and (n.= expected actual)
                             (n.= 1 (value@ /.#successes tally))
                             (n.= 0 (value@ /.#failures tally)))))))
      ))

(def: in_parallel
  /.Test
  ($_ /.and
      (do [! random.monad]
        [expected (# ! each (|>> (n.% 10) ++) random.nat)
         .let [counter (: (Atom Nat)
                          (atom.atom 0))]
         assertion (<| /.in_parallel
                       (list.repeated expected)
                       (: /.Test)
                       (do !
                         [_ (in [])
                          .let [_ (io.run! (atom.update! ++ counter))]]
                         (/.test "" true)))]
        (in (do async.monad
              [[tally error] assertion
               actual (async.future (atom.read! counter))]
              (/.cover' [/.in_parallel]
                        (and (n.= expected actual)
                             (n.= expected (value@ /.#successes tally))
                             (n.= 0 (value@ /.#failures tally)))))))
      (do [! random.monad]
        [expected (# ! each (|>> (n.% 10) ++) random.nat)
         .let [counter (: (Atom Nat)
                          (atom.atom 0))]
         assertion (<| /.in_parallel
                       (list.repeated expected)
                       (: /.Test)
                       (do !
                         [_ (in [])
                          .let [_ (undefined)
                                _ (io.run! (atom.update! ++ counter))]]
                         (/.test "" true)))]
        (in (do async.monad
              [[tally error] assertion
               actual (async.future (atom.read! counter))]
              (/.cover' [/.error_during_execution]
                        (let [correct_error! (text.contains? (value@ exception.#label /.error_during_execution) error)
                              no_complete_run! (n.= 0 actual)
                              no_successes! (n.= 0 (value@ /.#successes tally))
                              ran_all_tests! (n.= expected (value@ /.#failures tally))]
                          (and correct_error!
                               no_complete_run!
                               no_successes!
                               ran_all_tests!))))))
      ))

(def: .public dummy_target
  "YOLO")

(def: coverage
  /.Test
  ($_ /.and
      (do random.monad
        [not_covering (/.test "" true)
         covering (/.covering .._ (/.test "" true))]
        (in (do async.monad
              [[not_covering _] not_covering
               [covering _] covering]
              (/.cover' [/.covering]
                        (and (and (set.empty? (value@ /.#expected_coverage not_covering))
                                  (set.empty? (value@ /.#actual_coverage not_covering)))
                             (and (not (set.empty? (value@ /.#expected_coverage covering)))
                                  (set.empty? (value@ /.#actual_coverage covering))))))))
      (do random.monad
        [not_covering (/.covering .._ (/.test "" true))
         covering (/.covering .._ (/.cover [..dummy_target] true))]
        (in (do async.monad
              [[not_covering _] not_covering
               [covering _] covering]
              (/.cover' [/.cover]
                        (and (and (not (set.empty? (value@ /.#expected_coverage not_covering)))
                                  (not (set.member? (value@ /.#actual_coverage not_covering) (symbol ..dummy_target))))
                             (and (not (set.empty? (value@ /.#expected_coverage covering)))
                                  (set.member? (value@ /.#actual_coverage covering) (symbol ..dummy_target))))))))
      (do random.monad
        [not_covering (/.covering .._ (/.test "" true))
         covering (/.covering .._ (in (/.cover' [..dummy_target] true)))]
        (in (do async.monad
              [[not_covering _] not_covering
               [covering _] covering]
              (/.cover' [/.cover']
                        (and (and (not (set.empty? (value@ /.#expected_coverage not_covering)))
                                  (not (set.member? (value@ /.#actual_coverage not_covering) (symbol ..dummy_target))))
                             (and (not (set.empty? (value@ /.#expected_coverage covering)))
                                  (set.member? (value@ /.#actual_coverage covering) (symbol ..dummy_target))))))))
      (do random.monad
        [not_covering (/.covering .._ (/.test "" true))
         covering (/.covering .._ (/.for [..dummy_target] (/.test "" true)))]
        (in (do async.monad
              [[not_covering _] not_covering
               [covering _] covering]
              (/.cover' [/.for]
                        (and (and (not (set.empty? (value@ /.#expected_coverage not_covering)))
                                  (not (set.member? (value@ /.#actual_coverage not_covering) (symbol ..dummy_target))))
                             (and (not (set.empty? (value@ /.#expected_coverage covering)))
                                  (set.member? (value@ /.#actual_coverage covering) (symbol ..dummy_target))))))))
      ))

(def: .public test
  /.Test
  (<| (/.covering /._)
      (/.for [/.Test])
      (do [! random.monad]
        [expected_context (random.ascii/lower 5)
         expected_message/0 (random.only (|>> (text#= expected_context) not)
                                         (random.ascii/lower 5))
         expected_message/1 (random.only (|>> (text#= expected_message/0) not)
                                         (random.ascii/lower 5))]
        ($_ /.and
            (/.for [/.Assertion]
                   ..assertion)
            (/.for [/.Seed]
                   seed)
            (do !
              [success_assertion (/.test expected_message/0 true)
               failure_assertion (/.test expected_message/0 false)]
              (in (do async.monad
                    [[success_tally success_message] success_assertion
                     [failure_tally failure_message] failure_assertion]
                    (/.cover' [/.test]
                              (and (text.ends_with? (%.text expected_message/0) success_message)
                                   (text.ends_with? (%.text expected_message/0) failure_message)
                                   (and (n.= 1 (value@ /.#successes success_tally))
                                        (n.= 0 (value@ /.#failures success_tally)))
                                   (and (n.= 0 (value@ /.#successes failure_tally))
                                        (n.= 1 (value@ /.#failures failure_tally))))))))
            (do !
              [tt (/.and (/.test expected_message/0 true)
                         (/.test expected_message/1 true))
               ff (/.and (/.test expected_message/0 false)
                         (/.test expected_message/1 false))
               tf (/.and (/.test expected_message/0 true)
                         (/.test expected_message/1 false))
               ft (/.and (/.test expected_message/0 false)
                         (/.test expected_message/1 true))]
              (in (do async.monad
                    [tt tt
                     ff ff
                     tf tf
                     ft ft]
                    (/.cover' [/.and]
                              (and (..verify expected_message/0 expected_message/1 2 0 tt)
                                   (..verify expected_message/0 expected_message/1 0 2 ff)
                                   (..verify expected_message/0 expected_message/1 1 1 tf)
                                   (..verify expected_message/0 expected_message/1 1 1 ft))))))
            (do !
              [success_assertion (/.context expected_context (/.test expected_message/0 true))
               failure_assertion (/.context expected_context (/.test expected_message/0 false))]
              (in (do async.monad
                    [[success_tally success_message] success_assertion
                     [failure_tally failure_message] failure_assertion]
                    (/.cover' [/.context]
                              (and (and (text.contains? expected_context success_message)
                                        (text.contains? expected_message/0 success_message))
                                   (and (text.contains? expected_context failure_message)
                                        (text.contains? expected_message/0 failure_message))
                                   (and (n.= 1 (value@ /.#successes success_tally))
                                        (n.= 0 (value@ /.#failures success_tally)))
                                   (and (n.= 0 (value@ /.#successes failure_tally))
                                        (n.= 1 (value@ /.#failures failure_tally))))))))
            (do !
              [failure_assertion (/.failure expected_message/0)]
              (in (do async.monad
                    [[failure_tally failure_message] failure_assertion]
                    (/.cover' [/.failure]
                              (and (text.contains? expected_message/0 failure_message)
                                   (and (n.= 0 (value@ /.#successes failure_tally))
                                        (n.= 1 (value@ /.#failures failure_tally))))))))
            (do !
              [success_assertion (/.lifted expected_message/0 (in true))
               failure_assertion (/.lifted expected_message/0 (in false))]
              (in (do async.monad
                    [[success_tally success_message] success_assertion
                     [failure_tally failure_message] failure_assertion]
                    (/.cover' [/.lifted]
                              (and (text.contains? expected_message/0 success_message)
                                   (text.contains? expected_message/0 failure_message)
                                   (and (n.= 1 (value@ /.#successes success_tally))
                                        (n.= 0 (value@ /.#failures success_tally)))
                                   (and (n.= 0 (value@ /.#successes failure_tally))
                                        (n.= 1 (value@ /.#failures failure_tally))))))))
            ..times
            ..in_parallel
            ..coverage
            ))))