(.module: {#.doc "Tools for unit & property-based/generative testing."}
  lux
  (lux [macro #+ with-gensyms]
       (macro ["s" syntax #+ syntax: Syntax]
              [code])
       (control [monad #+ do Monad]
                ["p" parser])
       (concurrency [promise #+ Promise])
       (data (coll [list "list/" Monad<List> Fold<List>])
             [product]
             [maybe]
             [text]
             text/format
             ["e" error])
       [io #+ IO io]
       (time [instant]
             [duration])
       ["r" math/random]))

## [Host]
(do-template [<name> <signal>]
  [(def: <name> (IO Bottom)
     (io ("lux io exit" <signal>)))]

  [exit 0]
  [die  1]
  )

## [Types]
(type: #export Counters [Nat Nat])

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

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

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

## [Values]
(def: success Counters [+1 +0])
(def: failure Counters [+0 +1])
(def: start Counters [+0 +0])

(def: (add-counters [s f] [ts tf])
  (-> Counters Counters Counters)
  [(n/+ s ts) (n/+ f tf)])

(def: #export (fail message)
  (All [a] (-> Text Test))
  (|> [failure (format "  [Error] " message)]
      (:: promise.Monad<Promise> wrap)
      (:: r.Monad<Random> wrap)))

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

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

(def: (run' tests)
  (-> (List [Text (IO Test) Text]) (Promise Counters))
  (do promise.Monad<Promise>
    [test-runs (|> tests
                   (list/map (: (-> [Text (IO Test) Text] (Promise Counters))
                                (function [[module test description]]
                                  (do @
                                    [#let [pre (io.run instant.now)
                                           seed (int-to-nat (instant.to-millis pre))]
                                     [counters documentation] (|> (io.run test)
                                                                  (r.run (r.pcg-32 [pcg-32-magic-inc seed]))
                                                                  product.right)
                                     #let [post (io.run instant.now)
                                           _ (log! (format "@ " module " "
                                                           "(" (%duration (instant.span pre post)) ")"
                                                           "\n"
                                                           description "\n"
                                                           "\n" documentation "\n"))]]
                                    (wrap counters)))))
                   (monad.seq @))]
    (wrap (list/fold add-counters start test-runs))))

(def: failed?
  (-> Counters Bool)
  (|>> product.right (n/> +0)))

(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: #export (times amount test)
  (-> Nat Test Test)
  (cond (n/= +0 amount)
        (fail "Cannot try a test 0 times.")

        (n/= +1 amount)
        test

        ## else
        (do r.Monad<Random>
          [seed r.nat]
          (function [prng]
            (let [[prng' instance] (r.run (r.pcg-32 [pcg-32-magic-inc seed]) test)]
              [prng' (do promise.Monad<Promise>
                       [[counters documentation] instance]
                       (if (failed? counters)
                         (wrap [counters (format "Failed with this seed: " (%n seed) "\n" documentation)])
                         (product.right (r.run prng' (times (n/dec amount) test)))))])))))

## [Syntax]
(syntax: #export (context: description test)
  {#.doc (doc "Macro for definint tests."
              (context: "Simple macros and constructs"
                ($_ seq
                    (test "Can write easy loops for iterative programming."
                          (i/= 1000
                               (loop [counter 0
                                      value 1]
                                 (if (i/< 3 counter)
                                   (recur (i/inc counter) (i/* 10 value))
                                   value))))

                    (test "Can create lists easily through macros."
                          (and (case (list 1 2 3)
                                 (#.Cons 1 (#.Cons 2 (#.Cons 3 #.Nil)))
                                 true

                                 _
                                 false)
                               
                               (case (list& 1 2 3 (list 4 5 6))
                                 (#.Cons 1 (#.Cons 2 (#.Cons 3 (#.Cons 4 (#.Cons 5 (#.Cons 6 #.Nil))))))
                                 true

                                 _
                                 false)))

                    (test "Can have defaults for Maybe values."
                          (and (is "yolo" (maybe.default "yolo"
                                                         #.None))
                               
                               (is "lol" (maybe.default "yolo"
                                                        (#.Some "lol")))))
                    ))
              
              "Also works with random generation of values for property-based testing."
              (context: "Addition & Substraction"
                (do @
                  [x (:: @ map <prep> rand-gen)
                   y (:: @ map <prep> rand-gen)]
                  (test ""
                        (and (|> x (- y) (+ y) (= x))
                             (|> x (+ y) (- y) (= x))))))
              
              "By default, random tests will be tried 100 times, you can specify the amount you want:"
              (context: "Addition & Substraction"
                (<| (times +1234)
                    (do @
                      [x (:: @ map <prep> rand-gen)
                       y (:: @ map <prep> rand-gen)]
                      (test ""
                            (and (|> x (- y) (+ y) (= x))
                                 (|> x (+ y) (- y) (= x)))))))
              
              "If a test fails, you'll be shown a seed that you can then use to reproduce a failing scenario."
              (context: "Addition & Substraction"
                (<| (seed +987654321)
                    (do @
                      [x (:: @ map <prep> rand-gen)
                       y (:: @ map <prep> rand-gen)]
                      (test ""
                            (and (|> x (- y) (+ y) (= x))
                                 (|> x (+ y) (- y) (= x)))))))
              )}
  (with-gensyms [g!context g!test g!error]
    (wrap (list (` (def: #export (~ g!context)
                     {#..test ((~! code.text) (~ description))}
                     (~! (IO Test))
                     ((~! io) (case ("lux try" ((~! io) ((~! do)
                                                         (~! r.Monad<Random>)
                                                         []
                                                         (~ test))))
                                (#.Right (~ g!test))
                                (~ g!test)

                                (#.Left (~ g!error))
                                (..fail (~ g!error))))))))))

(def: (exported-tests module-name)
  (-> Text (Meta (List [Text Text Text])))
  (do macro.Monad<Meta>
    [defs (macro.exports module-name)]
    (wrap (|> defs
              (list/map (function [[def-name [_ def-anns _]]]
                          (case (macro.get-text-ann (ident-for #..test) def-anns)
                            (#.Some description)
                            [true module-name def-name description]

                            _
                            [false module-name def-name ""])))
              (list.filter product.left)
              (list/map product.right)))))

(syntax: #export (run)
  {#.doc (doc "Runs all the tests defined on the current module, and in all imported modules."
              (run))}
  (with-gensyms [g!successes g!failures g!total-successes g!total-failures g!text/compose]
    (do @
      [current-module macro.current-module-name
       modules (macro.imported-modules current-module)
       tests (: (Meta (List [Text Text Text]))
                (|> (#.Cons current-module modules)
                    list.reverse
                    (monad.map @ exported-tests)
                    (:: @ map list/join)))
       #let [tests+ (list/map (function [[module-name test desc]]
                                (` [(~ (code.text module-name)) (~ (code.symbol [module-name test])) (~ (code.text desc))]))
                              tests)
             num-tests (list.size tests+)
             groups (list.split-all promise.concurrency-level tests+)]]
      (wrap (list (` (: (~! (IO Unit))
                        ((~! io) (exec ((~! do) (~! promise.Monad<Promise>)
                                        [(~' #let) [(~ g!total-successes) +0
                                                    (~ g!total-failures) +0]
                                         (~+ (list/join (list/map (function [group]
                                                                    (list (` [(~ g!successes) (~ g!failures)]) (` ((~! run') (list (~+ group))))
                                                                          (' #let) (` [(~ g!total-successes) (n/+ (~ g!successes) (~ g!total-successes))
                                                                                       (~ g!total-failures) (n/+ (~ g!failures) (~ g!total-failures))])))
                                                                  groups)))]
                                        (exec (let [(~ g!text/compose) (:: (~! text.Monoid<Text>) (~' compose))]
                                                (log! ($_ (~ g!text/compose)
                                                          "Test-suite finished."
                                                          "\n"
                                                          ((~! %i) (nat-to-int (~ g!total-successes)))
                                                          " out of "
                                                          ((~! %i) (nat-to-int (n/+ (~ g!total-failures)
                                                                                    (~ g!total-successes))))
                                                          " tests passed."
                                                          "\n"
                                                          ((~! %i) (nat-to-int (~ g!total-failures))) " tests failed.")))
                                          ((~! promise.future)
                                           (if (n/> +0 (~ g!total-failures))
                                             (~! ..die)
                                             (~! ..exit)))))
                                   [])))))))))

(def: #export (seq left right)
  {#.doc "Sequencing combinator."}
  (-> Test Test Test)
  (do r.Monad<Random>
    [left left
     right right]
    (wrap (do promise.Monad<Promise>
            [[l-counter l-documentation] left
             [r-counter r-documentation] right]
            (wrap [(add-counters l-counter r-counter)
                   (format l-documentation "\n" r-documentation)])))))