(.module: {#.doc "Tools for unit & property-based/generative testing."}
  [lux (#- and)
   [abstract
    ["." monad (#+ Monad do)]]
   [control
    ["ex" exception (#+ exception:)]
    ["." io]
    [concurrency
     ["." promise (#+ Promise) ("#;." monad)]]]
   [data
    ["." product]
    [number
     ["n" nat]]
    ["." text
     ["%" format (#+ format)]]
    [collection
     ["." list ("#;." functor)]]]
   [time
    ["." instant]
    ["." duration]]
   [math
    ["r" random ("#;." monad)]]])

(type: #export Counters
  {#successes Nat
   #failures Nat})

(def: (add-counters parameter subject)
  (-> Counters Counters Counters)
  {#successes (n.+ (get@ #successes parameter) (get@ #successes subject))
   #failures (n.+ (get@ #failures parameter) (get@ #failures subject))})

(def: start
  Counters
  {#successes 0
   #failures 0})

(template [<name> <category>]
  [(def: <name> Counters (update@ <category> .inc start))]

  [success #successes]
  [failure #failures]
  )

(type: #export Test
  (r.Random (Promise [Counters Text])))

(def: separator text.new-line)

(def: #export (and left right)
  {#.doc "Sequencing combinator."}
  (-> Test Test Test)
  (do r.monad
    [left left
     right right]
    (wrap (do promise.monad
            [[l-counter l-documentation] left
             [r-counter r-documentation] right]
            (wrap [(add-counters l-counter r-counter)
                   (format l-documentation ..separator r-documentation)])))))

(def: context-prefix text.tab)

(def: #export (context description)
  (-> Text Test Test)
  (r;map (promise;map (function (_ [counters documentation])
                        [counters (|> documentation
                                      (text.split-all-with ..separator)
                                      (list;map (|>> (format context-prefix)))
                                      (text.join-with ..separator)
                                      (format description ..separator))]))))

(def: failure-prefix "[Failure] ")
(def: success-prefix "[Success] ")

(def: #export fail
  (-> Text Test)
  (|>> (format ..failure-prefix)
       [failure]
       promise;wrap
       r;wrap))

(def: #export (assert message condition)
  {#.doc "Check that a condition is #1, and fail with the given message otherwise."}
  (-> Text Bit (Promise [Counters Text]))
  (<| promise;wrap
      (if condition
        [success (format ..success-prefix message)]
        [failure (format ..failure-prefix message)])))

(def: #export (test message condition)
  {#.doc "Check that a condition is #1, and fail with the given message otherwise."}
  (-> Text Bit Test)
  (:: r.monad wrap (assert message condition)))

(def: pcg-32-magic-inc Nat 12345)

(type: #export Seed
  {#.doc "The seed value used for random testing (if that feature is used)."}
  Nat)

(def: #export (seed value test)
  (-> Seed Test Test)
  (function (_ prng)
    (let [[_ result] (r.run (r.pcg-32 [..pcg-32-magic-inc value])
                            test)]
      [prng result])))

(def: failed?
  (-> Counters Bit)
  (|>> product.right (n.> 0)))

(def: (times-failure seed documentation)
  (-> Seed Text Text)
  (format documentation ..separator ..separator
          "Failed with this seed: " (%.nat seed)))

(exception: #export (must-try-test-at-least-once) "")

(def: #export (times amount test)
  (-> Nat Test Test)
  (cond (n.= 0 amount)
        (fail (ex.construct must-try-test-at-least-once []))

        (n.= 1 amount)
        test

        ## else
        (do r.monad
          [seed r.nat]
          (function (_ prng)
            (let [[prng' instance] (r.run (r.pcg-32 [..pcg-32-magic-inc seed]) test)]
              [prng' (do promise.monad
                       [[counters documentation] instance]
                       (if (failed? counters)
                         (wrap [counters (times-failure seed documentation)])
                         (product.right (r.run prng' (times (dec amount) test)))))])))))

(def: (tally counters)
  (-> Counters Text)
  (let [successes (get@ #successes counters)
        failures (get@ #failures counters)]
    (ex.report ["Tests" (%.nat (n.+ successes failures))]
               ["Successes" (%.nat successes)]
               ["Failures" (%.nat failures)])))

(def: failure-exit-code -1)
(def: success-exit-code +0)

(def: #export (run! test)
  (-> Test (Promise Nothing))
  (do promise.monad
    [pre (promise.future instant.now)
     #let [seed (instant.to-millis pre)
           prng (r.pcg-32 [..pcg-32-magic-inc seed])]
     [counters documentation] (|> test (r.run prng) product.right)
     post (promise.future instant.now)
     #let [duration (instant.span pre post)
           _ (log! (format documentation text.new-line text.new-line
                           "(" (%.duration duration) ")" text.new-line
                           (tally counters)))]]
    (promise.future (io.exit (case (get@ #failures counters)
                               0 ..success-exit-code
                               _ ..failure-exit-code)))))