(.module:
  [lux #*
   [data
    text/format
    ["." name]]
   ["_" test (#+ Test)]
   [abstract/monad (#+ do)]
   [control
    pipe
    ["p" parser]]
   [data
    ["." error (#+ Error)]
    ["." text ("#@." equivalence)]
    [collection
     ["." list]]]
   [math
    ["r" random]]]
  {1
   ["." /]})

(def: (should-fail input)
  (All [a] (-> (Error a) Bit))
  (case input
    (#error.Failure _)
    true
    
    _
    false))

(def: (should-pass reference sample)
  (-> Text (Error Text) Bit)
  (|> sample
      (:: error.functor map (text@= reference))
      (error.default false)))

(def: #export test
  Test
  (<| (_.context (name.module (name-of /._)))
      ($_ _.and
          (_.test "Can detect the end of the input."
                  (|> (/.run /.end
                             "")
                      (case> (#.Right _) true _ false)))
          (do r.monad
            [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))
             sample (r.unicode size)
             non-sample (|> (r.unicode size)
                            (r.filter (|>> (text@= sample) not)))]
            ($_ _.and
                (_.test "Won't mistake non-empty text for no more input."
                        (|> (/.run /.end
                                   sample)
                            (case> (#.Left _) true _ false)))
                (_.test "Can find literal text fragments."
                        (and (|> (/.run (/.this sample)
                                        sample)
                                 (case> (#.Right []) true _ false))
                             (|> (/.run (/.this sample)
                                        non-sample)
                                 (case> (#.Left _) true _ false))))
                ))
          ($_ _.and
              (_.test "Can lex anything"
                      (and (should-pass "A" (/.run /.any
                                                   "A"))
                           (should-fail (/.run /.any
                                               ""))))

              (_.test "Can lex characters ranges."
                      (and (should-pass "Y" (/.run (/.range (char "X") (char "Z"))
                                                   "Y"))
                           (should-fail (/.run (/.range (char "X") (char "Z"))
                                               "M"))))
              
              (_.test "Can lex upper-case and lower-case letters."
                      (and (should-pass "Y" (/.run /.upper
                                                   "Y"))
                           (should-fail (/.run /.upper
                                               "m"))
                           
                           (should-pass "y" (/.run /.lower
                                                   "y"))
                           (should-fail (/.run /.lower
                                               "M"))))

              (_.test "Can lex numbers."
                      (and (should-pass "1" (/.run /.decimal
                                                   "1"))
                           (should-fail (/.run /.decimal
                                               " "))

                           (should-pass "7" (/.run /.octal
                                                   "7"))
                           (should-fail (/.run /.octal
                                               "8"))

                           (should-pass "1" (/.run /.hexadecimal
                                                   "1"))
                           (should-pass "a" (/.run /.hexadecimal
                                                   "a"))
                           (should-pass "A" (/.run /.hexadecimal
                                                   "A"))
                           (should-fail (/.run /.hexadecimal
                                               " "))
                           ))

              (_.test "Can lex alphabetic characters."
                      (and (should-pass "A" (/.run /.alpha
                                                   "A"))
                           (should-pass "a" (/.run /.alpha
                                                   "a"))
                           (should-fail (/.run /.alpha
                                               "1"))))

              (_.test "Can lex alphanumeric characters."
                      (and (should-pass "A" (/.run /.alpha-num
                                                   "A"))
                           (should-pass "a" (/.run /.alpha-num
                                                   "a"))
                           (should-pass "1" (/.run /.alpha-num
                                                   "1"))
                           (should-fail (/.run /.alpha-num
                                               " "))))

              (_.test "Can lex white-space."
                      (and (should-pass " " (/.run /.space
                                                   " "))
                           (should-fail (/.run /.space
                                               "8"))))
              )
          ($_ _.and
              (_.test "Can combine lexers sequentially."
                      (and (|> (/.run (p.and /.any /.any)
                                      "YO")
                               (case> (#.Right ["Y" "O"]) true
                                      _ false))
                           (should-fail (/.run (p.and /.any /.any)
                                               "Y"))))
              
              (_.test "Can create the opposite of a lexer."
                      (and (should-pass "a" (/.run (/.not (p.or /.decimal /.upper))
                                                   "a"))
                           (should-fail (/.run (/.not (p.or /.decimal /.upper))
                                               "A"))))
              
              (_.test "Can select from among a set of characters."
                      (and (should-pass "C" (/.run (/.one-of "ABC")
                                                   "C"))
                           (should-fail (/.run (/.one-of "ABC")
                                               "D"))))

              (_.test "Can avoid a set of characters."
                      (and (should-pass "D" (/.run (/.none-of "ABC")
                                                   "D"))
                           (should-fail (/.run (/.none-of "ABC")
                                               "C"))))
              
              (_.test "Can lex using arbitrary predicates."
                      (and (should-pass "D" (/.run (/.satisfies (function (_ c) true))
                                                   "D"))
                           (should-fail (/.run (/.satisfies (function (_ c) false))
                                               "C"))))
              
              (_.test "Can apply a lexer multiple times."
                      (and (should-pass "0123456789ABCDEF" (/.run (/.many /.hexadecimal)
                                                                  "0123456789ABCDEF"))
                           (should-fail (/.run (/.many /.hexadecimal)
                                               "yolo"))

                           (should-pass "" (/.run (/.some /.hexadecimal)
                                                  ""))))
              )
          )))