;; Parser Combinator tests

(defsuite
  "pc-primitives"
  (deftest
    "satisfy matches"
    (let
      ((r (run-parser (satisfy (fn (c) (= c "a")) "a") "abc")))
      (assert (ok? r))
      (assert= "a" (result-value r))
      (assert= 1 (result-pos r))))
  (deftest
    "satisfy fails"
    (let
      ((r (run-parser (satisfy (fn (c) (= c "x")) "x") "abc")))
      (assert (not (ok? r)))
      (assert= 0 (result-pos r))))
  (deftest
    "satisfy fails at eof"
    (let
      ((r (run-parser (satisfy (fn (c) true) "char") "")))
      (assert (not (ok? r)))))
  (deftest
    "parse-char matches"
    (let
      ((r (run-parser (parse-char "b") "bc")))
      (assert (ok? r))
      (assert= "b" (result-value r))))
  (deftest
    "parse-char fails"
    (let
      ((r (run-parser (parse-char "x") "bc")))
      (assert (not (ok? r)))))
  (deftest
    "any-char matches"
    (let
      ((r (run-parser any-char "hello")))
      (assert (ok? r))
      (assert= "h" (result-value r))))
  (deftest
    "any-char fails on empty"
    (assert (not (ok? (run-parser any-char "")))))
  (deftest
    "parse-string matches"
    (let
      ((r (run-parser (parse-string "hello") "hello world")))
      (assert (ok? r))
      (assert= "hello" (result-value r))
      (assert= 5 (result-pos r))))
  (deftest
    "parse-string fails on partial"
    (assert (not (ok? (run-parser (parse-string "hello") "hel")))))
  (deftest
    "parse-string fails on mismatch"
    (assert (not (ok? (run-parser (parse-string "hello") "world")))))
  (deftest "eof succeeds at end" (assert (ok? (run-parser eof ""))))
  (deftest
    "eof fails with remaining"
    (assert (not (ok? (run-parser eof "x"))))))

(defsuite
  "pc-core-combinators"
  (deftest
    "fmap transforms value"
    (let
      ((r (run-parser (fmap upper (parse-char "a")) "abc")))
      (assert (ok? r))
      (assert= "A" (result-value r))))
  (deftest
    "fmap propagates failure"
    (assert (not (ok? (run-parser (fmap upper (parse-char "x")) "abc")))))
  (deftest
    "seq two parsers"
    (let
      ((r (run-parser (seq (list (parse-char "a") (parse-char "b"))) "abc")))
      (assert (ok? r))
      (assert= (list "a" "b") (result-value r))
      (assert= 2 (result-pos r))))
  (deftest
    "seq fails on second"
    (assert
      (not
        (ok?
          (run-parser (seq (list (parse-char "a") (parse-char "x"))) "abc")))))
  (deftest
    "seq empty list"
    (let
      ((r (run-parser (seq (list)) "abc")))
      (assert (ok? r))
      (assert= (list) (result-value r))
      (assert= 0 (result-pos r))))
  (deftest
    "alt first succeeds"
    (let
      ((r (run-parser (alt (list (parse-char "a") (parse-char "b"))) "abc")))
      (assert (ok? r))
      (assert= "a" (result-value r))))
  (deftest
    "alt second succeeds"
    (let
      ((r (run-parser (alt (list (parse-char "x") (parse-char "a"))) "abc")))
      (assert (ok? r))
      (assert= "a" (result-value r))))
  (deftest
    "alt all fail"
    (assert
      (not
        (ok?
          (run-parser (alt (list (parse-char "x") (parse-char "y"))) "abc")))))
  (deftest
    "label overrides error"
    (let
      ((r (run-parser (label "my-thing" (parse-char "x")) "abc")))
      (assert (not (ok? r)))
      (assert= "my-thing" (result-expected r))))
  (deftest
    "parse-bind chains"
    (let
      ((p (parse-bind (parse-char "a") (fn (ch) (parse-char "b")))))
      (let
        ((r (run-parser p "abc")))
        (assert (ok? r))
        (assert= "b" (result-value r))
        (assert= 2 (result-pos r)))))
  (deftest
    "lazy-parser defers"
    (let
      ((p (lazy-parser (fn () (parse-char "a")))))
      (assert (ok? (run-parser p "abc"))))))

(defsuite
  "pc-repetition"
  (deftest
    "many zero matches"
    (let
      ((r (run-parser (many (parse-char "x")) "abc")))
      (assert (ok? r))
      (assert= (list) (result-value r))
      (assert= 0 (result-pos r))))
  (deftest
    "many multiple matches"
    (let
      ((r (run-parser (many (parse-char "a")) "aaab")))
      (assert (ok? r))
      (assert= (list "a" "a" "a") (result-value r))
      (assert= 3 (result-pos r))))
  (deftest
    "many1 one match"
    (let
      ((r (run-parser (many1 (parse-char "a")) "ab")))
      (assert (ok? r))
      (assert= (list "a") (result-value r))))
  (deftest
    "many1 fails on zero"
    (assert (not (ok? (run-parser (many1 (parse-char "a")) "bc")))))
  (deftest
    "optional present"
    (let
      ((r (run-parser (optional (parse-char "a")) "abc")))
      (assert (ok? r))
      (assert= "a" (result-value r))))
  (deftest
    "optional absent"
    (let
      ((r (run-parser (optional (parse-char "x")) "abc")))
      (assert (ok? r))
      (assert= nil (result-value r))
      (assert= 0 (result-pos r))))
  (deftest
    "skip-many consumes"
    (let
      ((r (run-parser (skip-many (parse-char " ")) "   abc")))
      (assert (ok? r))
      (assert= 3 (result-pos r)))))

(defsuite
  "pc-structural"
  (deftest
    "between parens"
    (let
      ((r (run-parser (between (parse-char "(") (parse-char ")") (parse-char "x")) "(x)")))
      (assert (ok? r))
      (assert= "x" (result-value r))))
  (deftest
    "sep-by with items"
    (let
      ((r (run-parser (sep-by (parse-char "a") (parse-char ",")) "a,a,a")))
      (assert (ok? r))
      (assert= (list "a" "a" "a") (result-value r))))
  (deftest
    "sep-by empty"
    (let
      ((r (run-parser (sep-by (parse-char "a") (parse-char ",")) "xyz")))
      (assert (ok? r))
      (assert= (list) (result-value r))))
  (deftest
    "sep-by1 with items"
    (let
      ((r (run-parser (sep-by1 digit (parse-char ",")) "1,2,3")))
      (assert (ok? r))
      (assert= (list "1" "2" "3") (result-value r))))
  (deftest
    "sep-by1 fails on empty"
    (assert
      (not (ok? (run-parser (sep-by1 digit (parse-char ",")) "xyz")))))
  (deftest
    "skip-left discards first"
    (let
      ((r (run-parser (skip-left (parse-char " ") (parse-char "x")) " x")))
      (assert (ok? r))
      (assert= "x" (result-value r))))
  (deftest
    "skip-right discards second"
    (let
      ((r (run-parser (skip-right (parse-char "x") (parse-char " ")) "x ")))
      (assert (ok? r))
      (assert= "x" (result-value r))))
  (deftest
    "not-followed-by succeeds on failure"
    (let
      ((r (run-parser (not-followed-by (parse-char "x")) "abc")))
      (assert (ok? r))
      (assert= 0 (result-pos r))))
  (deftest
    "not-followed-by fails on success"
    (assert
      (not (ok? (run-parser (not-followed-by (parse-char "a")) "abc")))))
  (deftest
    "look-ahead preserves position"
    (let
      ((r (run-parser (look-ahead (parse-char "a")) "abc")))
      (assert (ok? r))
      (assert= "a" (result-value r))
      (assert= 0 (result-pos r)))))

(defsuite
  "pc-char-classes"
  (deftest "digit matches" (assert (ok? (run-parser digit "5"))))
  (deftest
    "digit fails on letter"
    (assert (not (ok? (run-parser digit "a")))))
  (deftest "letter matches" (assert (ok? (run-parser letter "a"))))
  (deftest
    "letter fails on digit"
    (assert (not (ok? (run-parser letter "5")))))
  (deftest
    "alpha-num matches digit"
    (assert (ok? (run-parser alpha-num "5"))))
  (deftest
    "alpha-num matches letter"
    (assert (ok? (run-parser alpha-num "z"))))
  (deftest
    "skip-spaces skips"
    (let
      ((r (run-parser skip-spaces "  \t\nabc")))
      (assert (ok? r))
      (assert= 4 (result-pos r))))
  (deftest
    "skip-spaces on no spaces"
    (let
      ((r (run-parser skip-spaces "abc")))
      (assert (ok? r))
      (assert= 0 (result-pos r)))))

(defsuite
  "pc-literals"
  (deftest
    "number integer"
    (let
      ((r (run-parser number-literal "42abc")))
      (assert (ok? r))
      (assert= 42 (result-value r))
      (assert= 2 (result-pos r))))
  (deftest
    "number decimal"
    (let
      ((r (run-parser number-literal "3.14rest")))
      (assert (ok? r))
      (assert= 3.14 (result-value r))))
  (deftest
    "number negative"
    (let
      ((r (run-parser number-literal "-7x")))
      (assert (ok? r))
      (assert= -7 (result-value r))))
  (deftest
    "number fails on non-digit"
    (assert (not (ok? (run-parser number-literal "abc")))))
  (deftest
    "string-literal basic"
    (let
      ((r (run-parser string-literal "\"hello\" rest")))
      (assert (ok? r))
      (assert= "hello" (result-value r))))
  (deftest
    "string-literal with escapes"
    (let
      ((r (run-parser string-literal "\"a\\nb\"")))
      (assert (ok? r))
      (assert= "a\nb" (result-value r))))
  (deftest
    "string-literal fails without quote"
    (assert (not (ok? (run-parser string-literal "hello")))))
  (deftest
    "identifier basic"
    (let
      ((r (run-parser identifier "hello-world rest")))
      (assert (ok? r))
      (assert= "hello-world" (result-value r))))
  (deftest
    "identifier with special chars"
    (let
      ((r (run-parser identifier "empty? x")))
      (assert (ok? r))
      (assert= "empty?" (result-value r)))))

(defsuite
  "pc-sx-tokenizer"
  (deftest
    "tokenize number"
    (let
      ((tokens (result-value (run-parser sx-tokenize "42"))))
      (assert= 1 (len tokens))
      (assert= "number" (get (first tokens) "type"))
      (assert= 42 (get (first tokens) "value"))))
  (deftest
    "tokenize string"
    (let
      ((tokens (result-value (run-parser sx-tokenize "\"hi\""))))
      (assert= 1 (len tokens))
      (assert= "string" (get (first tokens) "type"))
      (assert= "hi" (get (first tokens) "value"))))
  (deftest
    "tokenize keyword"
    (let
      ((tokens (result-value (run-parser sx-tokenize ":ok"))))
      (assert= 1 (len tokens))
      (assert= "keyword" (get (first tokens) "type"))
      (assert= ":ok" (get (first tokens) "value"))))
  (deftest
    "tokenize symbol"
    (let
      ((tokens (result-value (run-parser sx-tokenize "define"))))
      (assert= 1 (len tokens))
      (assert= "symbol" (get (first tokens) "type"))
      (assert= "define" (get (first tokens) "value"))))
  (deftest
    "tokenize simple expression"
    (let
      ((tokens (result-value (run-parser sx-tokenize "(+ 1 2)"))))
      (assert= 5 (len tokens))
      (assert= "open-paren" (get (first tokens) "type"))
      (assert= "symbol" (get (nth tokens 1) "type"))
      (assert= "+" (get (nth tokens 1) "value"))
      (assert= "number" (get (nth tokens 2) "type"))
      (assert= "close-paren" (get (nth tokens 4) "type"))))
  (deftest
    "tokenize define expression"
    (let
      ((tokens (result-value (run-parser sx-tokenize "(define x 42)"))))
      (assert= 5 (len tokens))
      (assert= "symbol" (get (nth tokens 1) "type"))
      (assert= "define" (get (nth tokens 1) "value"))
      (assert= "number" (get (nth tokens 3) "type"))
      (assert= 42 (get (nth tokens 3) "value"))))
  (deftest
    "tokenize dict literal"
    (let
      ((tokens (result-value (run-parser sx-tokenize "{:ok true :value 42}"))))
      (assert= 6 (len tokens))
      (assert= "open-brace" (get (first tokens) "type"))
      (assert= "keyword" (get (nth tokens 1) "type"))
      (assert= "close-brace" (get (nth tokens 5) "type"))))
  (deftest
    "tokenize with comment"
    (let
      ((tokens (result-value (run-parser sx-tokenize ";; comment\n42"))))
      (assert= 1 (len tokens))
      (assert= "number" (get (first tokens) "type"))))
  (deftest
    "tokenize nested expression"
    (let
      ((tokens (result-value (run-parser sx-tokenize "(+ 1 (* 2 3))"))))
      (assert= 9 (len tokens))
      (assert= "open-paren" (get (first tokens) "type"))
      (assert= "open-paren" (get (nth tokens 3) "type"))
      (assert= "close-paren" (get (nth tokens 7) "type"))
      (assert= "close-paren" (get (nth tokens 8) "type")))))

(defsuite
  "pc-recursive"
  (deftest
    "lazy-parser enables recursion"
    (define
      nested-a
      (lazy-parser
        (fn
          ()
          (alt
            (list
              (parse-char "a")
              (fmap
                (fn (parts) (nth parts 1))
                (seq (list (parse-char "(") nested-a (parse-char ")")))))))))
    (assert (ok? (run-parser nested-a "a")))
    (assert= "a" (result-value (run-parser nested-a "a")))
    (assert= "a" (result-value (run-parser nested-a "(a)")))
    (assert= "a" (result-value (run-parser nested-a "((a))"))))
  (deftest
    "matched parens depth"
    (define
      paren-depth
      (lazy-parser
        (fn
          ()
          (alt
            (list
              (fmap
                (fn (parts) (+ 1 (nth parts 1)))
                (seq (list (parse-char "(") paren-depth (parse-char ")"))))
              (fn (input pos) (make-ok 0 pos)))))))
    (assert= 0 (result-value (run-parser paren-depth "")))
    (assert= 1 (result-value (run-parser paren-depth "()")))
    (assert= 3 (result-value (run-parser paren-depth "((()))")))))