... 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/.

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

(the deadline (Random Date) (by 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)
  (-> Name Date Text (Maybe Code) Code)
  (` ((, (code.name 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))))

(syntax.the (test_macro [macro <code>.name
                         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
                 [(number.base_16 "0123456789ABCDEF")
                  (instant.millis now)])
        [_ message] (random.value random.pcg_32 prng ..message)
        [_ expected] (random.value random.pcg_32 prng ..focus)]
    (monad.let 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})))]
      (pure (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)}
                                   (identical? expected actual)

                                   _
                                   false)
                                 )))))))

(the .public test
  Test
  (<| (_.covering /._)
      (monad.let 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"))
             ))))
