;; Desugar tests — surface AST → core AST.
;;   :guarded   →  nested :if
;;   :where     →  :let
;;   :list-comp →  concatMap-based tree

(define
  hk-prog
  (fn (&rest decls) (list :program decls)))

;; ── Guards → if ──
(hk-test
  "two-way guarded rhs"
  (hk-desugar (hk-parse-top "abs x | x < 0 = - x\n      | otherwise = x"))
  (hk-prog
    (list
      :fun-clause
      "abs"
      (list (list :p-var "x"))
      (list
        :if
        (list :op "<" (list :var "x") (list :int 0))
        (list :neg (list :var "x"))
        (list
          :if
          (list :var "otherwise")
          (list :var "x")
          (list
            :app
            (list :var "error")
            (list :string "Non-exhaustive guards")))))))

(hk-test
  "three-way guarded rhs"
  (hk-desugar
    (hk-parse-top "sign n | n > 0 = 1\n       | n < 0 = -1\n       | otherwise = 0"))
  (hk-prog
    (list
      :fun-clause
      "sign"
      (list (list :p-var "n"))
      (list
        :if
        (list :op ">" (list :var "n") (list :int 0))
        (list :int 1)
        (list
          :if
          (list :op "<" (list :var "n") (list :int 0))
          (list :neg (list :int 1))
          (list
            :if
            (list :var "otherwise")
            (list :int 0)
            (list
              :app
              (list :var "error")
              (list :string "Non-exhaustive guards"))))))))

(hk-test
  "case-alt guards desugared too"
  (hk-desugar
    (hk-parse "case x of\n  Just y | y > 0 -> y\n         | otherwise -> 0\n  Nothing -> -1"))
  (list
    :case
    (list :var "x")
    (list
      (list
        :alt
        (list :p-con "Just" (list (list :p-var "y")))
        (list
          :if
          (list :op ">" (list :var "y") (list :int 0))
          (list :var "y")
          (list
            :if
            (list :var "otherwise")
            (list :int 0)
            (list
              :app
              (list :var "error")
              (list :string "Non-exhaustive guards")))))
      (list
        :alt
        (list :p-con "Nothing" (list))
        (list :neg (list :int 1))))))

;; ── Where → let ──
(hk-test
  "where with single binding"
  (hk-desugar (hk-parse-top "f x = y\n  where y = x + 1"))
  (hk-prog
    (list
      :fun-clause
      "f"
      (list (list :p-var "x"))
      (list
        :let
        (list
          (list
            :fun-clause
            "y"
            (list)
            (list :op "+" (list :var "x") (list :int 1))))
        (list :var "y")))))

(hk-test
  "where with two bindings"
  (hk-desugar
    (hk-parse-top "f x = y + z\n  where y = x + 1\n        z = x - 1"))
  (hk-prog
    (list
      :fun-clause
      "f"
      (list (list :p-var "x"))
      (list
        :let
        (list
          (list
            :fun-clause
            "y"
            (list)
            (list :op "+" (list :var "x") (list :int 1)))
          (list
            :fun-clause
            "z"
            (list)
            (list :op "-" (list :var "x") (list :int 1))))
        (list :op "+" (list :var "y") (list :var "z"))))))

(hk-test
  "guards + where — guarded body inside let"
  (hk-desugar
    (hk-parse-top "f x | x > 0 = y\n    | otherwise = 0\n  where y = 99"))
  (hk-prog
    (list
      :fun-clause
      "f"
      (list (list :p-var "x"))
      (list
        :let
        (list (list :fun-clause "y" (list) (list :int 99)))
        (list
          :if
          (list :op ">" (list :var "x") (list :int 0))
          (list :var "y")
          (list
            :if
            (list :var "otherwise")
            (list :int 0)
            (list
              :app
              (list :var "error")
              (list :string "Non-exhaustive guards"))))))))

;; ── List comprehensions → concatMap / if / let ──
(hk-test
  "list-comp: single generator"
  (hk-core-expr "[x | x <- xs]")
  (list
    :app
    (list
      :app
      (list :var "concatMap")
      (list
        :lambda
        (list (list :p-var "x"))
        (list :list (list (list :var "x")))))
    (list :var "xs")))

(hk-test
  "list-comp: generator then guard"
  (hk-core-expr "[x * 2 | x <- xs, x > 0]")
  (list
    :app
    (list
      :app
      (list :var "concatMap")
      (list
        :lambda
        (list (list :p-var "x"))
        (list
          :if
          (list :op ">" (list :var "x") (list :int 0))
          (list
            :list
            (list (list :op "*" (list :var "x") (list :int 2))))
          (list :list (list)))))
    (list :var "xs")))

(hk-test
  "list-comp: generator then let"
  (hk-core-expr "[y | x <- xs, let y = x + 1]")
  (list
    :app
    (list
      :app
      (list :var "concatMap")
      (list
        :lambda
        (list (list :p-var "x"))
        (list
          :let
          (list
            (list
              :bind
              (list :p-var "y")
              (list :op "+" (list :var "x") (list :int 1))))
          (list :list (list (list :var "y"))))))
    (list :var "xs")))

(hk-test
  "list-comp: two generators (nested concatMap)"
  (hk-core-expr "[(x, y) | x <- xs, y <- ys]")
  (list
    :app
    (list
      :app
      (list :var "concatMap")
      (list
        :lambda
        (list (list :p-var "x"))
        (list
          :app
          (list
            :app
            (list :var "concatMap")
            (list
              :lambda
              (list (list :p-var "y"))
              (list
                :list
                (list
                  (list
                    :tuple
                    (list (list :var "x") (list :var "y")))))))
          (list :var "ys"))))
    (list :var "xs")))

;; ── Pass-through cases ──
(hk-test
  "plain int literal unchanged"
  (hk-core-expr "42")
  (list :int 42))

(hk-test
  "lambda + if passes through"
  (hk-core-expr "\\x -> if x > 0 then x else - x")
  (list
    :lambda
    (list (list :p-var "x"))
    (list
      :if
      (list :op ">" (list :var "x") (list :int 0))
      (list :var "x")
      (list :neg (list :var "x")))))

(hk-test
  "simple fun-clause (no guards/where) passes through"
  (hk-desugar (hk-parse-top "id x = x"))
  (hk-prog
    (list
      :fun-clause
      "id"
      (list (list :p-var "x"))
      (list :var "x"))))

(hk-test
  "data decl passes through"
  (hk-desugar (hk-parse-top "data Maybe a = Nothing | Just a"))
  (hk-prog
    (list
      :data
      "Maybe"
      (list "a")
      (list
        (list :con-def "Nothing" (list))
        (list :con-def "Just" (list (list :t-var "a")))))))

(hk-test
  "module header passes through, body desugared"
  (hk-desugar
    (hk-parse-top "module M where\nf x | x > 0 = 1\n    | otherwise = 0"))
  (list
    :module
    "M"
    nil
    (list)
    (list
      (list
        :fun-clause
        "f"
        (list (list :p-var "x"))
        (list
          :if
          (list :op ">" (list :var "x") (list :int 0))
          (list :int 1)
          (list
            :if
            (list :var "otherwise")
            (list :int 0)
            (list
              :app
              (list :var "error")
              (list :string "Non-exhaustive guards"))))))))

{:fails hk-test-fails :pass hk-test-pass :fail hk-test-fail}