... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/.

(.require
 [library
  [lux (.except)
   [abstract
    ["[0]" monad (.only do)]]
   [control
    ["[0]" io]
    ["[0]" try (.only Try)]
    ["[0]" exception]]
   [data
    ["[0]" product]
    ["[0]" bit]
    ["[0]" text (.only)
     ["%" \\injection]]]
   [math
    [number (.only hex)]
    ["[0]" random (.only Random) (.use "[1]#[0]" monad)]]
   ["[0]" meta (.only)
    ["[0]" code (.only)
     ["<[1]>" \\projection]]
    [macro
     ["[0]" syntax]
     ["[0]" expansion]]]
   [world
    [time
     ["[0]" date (.only Date)]
     ["[0]" instant]
     ["[0]" duration]]]
   [test
    ["_" property (.only Test)]]]]
 [\\library
  ["[0]" /]])

(the deadline (Random Date) (of random.functor each instant.date instant.random))
(the message (Random Text) (random#each bit.as_text random.bit))
(the focus (Random Code) (random#each code.bit random.bit))

(the (memory macro deadline message focus)
  (-> Symbol Date Text (Maybe Code) Code)
  (` ((, (code.symbol macro))
      (, (code.text (date.as_text deadline)))
      (, (code.text message))
      (,* (when focus
            {.#None} (list)
            {.#Some focus} (list focus))))))

(the (attempt computation)
  (for_any (_ a)
    (-> (Meta a)
        (Meta (Try a))))
  (function (_ compiler)
    (when (computation compiler)
      {try.#Success [compiler output]}
      {try.#Success [compiler {try.#Success output}]}

      {try.#Failure error}
      {try.#Success [compiler {try.#Failure error}]})))

(the (test_failure deadline message focus failure)
  (-> Date Text (Maybe Code) Text Bit)
  (and (text.contains? (date.as_text deadline) failure)
       (text.contains? message failure)
       (when focus
         {.#None}
         true
         
         {.#Some focus}
         (text.contains? (code.as_text focus) failure))))

(the test_macro
  (syntax.macro (_ [macro <code>.symbol
                    extra <code>.text])
    (let [now (io.value instant.now)
          today (instant.date now)
          yesterday (instant.date (instant.after (duration.inverse duration.week) now))
          tomorrow (instant.date (instant.after duration.week now))
          prng (is random.PCG_32
                   [(hex "0123456789ABCDEF")
                    (instant.millis now)])
          [_ message] (random.value random.pcg_32 prng ..message)
          [_ expected] (random.value random.pcg_32 prng ..focus)]
      (do meta.monad
        [should_fail0 (..attempt (expansion.complete (..memory macro yesterday message {.#None})))
         should_fail1 (..attempt (expansion.complete (..memory macro yesterday message {.#Some expected})))
         should_succeed0 (..attempt (expansion.complete (..memory macro tomorrow message {.#None})))
         should_succeed1 (..attempt (expansion.complete (..memory macro tomorrow message {.#Some expected})))]
        (in (list (code.bit (and (when should_fail0
                                   {try.#Failure error}
                                   (and (test_failure yesterday message {.#None} error)
                                        (text.contains? extra error))

                                   _
                                   false)
                                 (when should_fail1
                                   {try.#Failure error}
                                   (and (test_failure yesterday message {.#Some expected} error)
                                        (text.contains? extra error))

                                   _
                                   false)
                                 (when should_succeed0
                                   {try.#Success (list)}
                                   true

                                   _
                                   false)
                                 (when should_succeed1
                                   {try.#Success (list actual)}
                                   (same? expected actual)

                                   _
                                   false)
                                 ))))))))

(the .public test
  Test
  (<| (_.covering /._)
      (do random.monad
        [deadline ..deadline
         message ..message
         focus ..focus]
        (all _.and
             (_.coverage [/.must_remember]
               (and (test_failure deadline message {.#None}
                                  (exception.error /.must_remember [deadline deadline message {.#None}]))
                    (test_failure deadline message {.#Some focus}
                                  (exception.error /.must_remember [deadline deadline message {.#Some focus}]))))
             (_.coverage [/.remember]
               (..test_macro /.remember ""))
             (_.coverage [/.to_do]
               (..test_macro /.to_do "TODO"))
             (_.coverage [/.fix_me]
               (..test_macro /.fix_me "FIXME"))
             ))))
