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

(def deadline (Random Date) random.date)
(def message (Random Text) (random#each %.bit random.bit))
(def focus (Random Code) (random#each code.bit random.bit))

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

(def (attempt computation)
  (All (_ 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}]})))

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

(def test_macro
  (syntax (_ [macro <code>.symbol
              extra <code>.text])
    (let [now (io.run! 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 (random.pcg_32 [(hex "0123456789ABCDEF")
                               (instant.millis now)])
          message (product.right (random.result prng ..message))
          expected (product.right (random.result 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)
                                 ))))))))

(def .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"))
             ))))