;; Guards and where-clauses — on fun-clauses, case alts, and
;; let-bindings (which now also accept funclause-style LHS like
;; `let f x = e` or `let f x | g = e | g = e`).

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

;; ── Guarded fun-clauses ──
(hk-test
  "simple guards (two branches)"
  (hk-parse-top "abs x | x < 0 = - x\n      | otherwise = x")
  (hk-prog
    (list
      :fun-clause
      "abs"
      (list (list :p-var "x"))
      (list
        :guarded
        (list
          (list
            :guard
            (list :op "<" (list :var "x") (list :int 0))
            (list :neg (list :var "x")))
          (list :guard (list :var "otherwise") (list :var "x")))))))

(hk-test
  "three-way guard"
  (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
        :guarded
        (list
          (list
            :guard
            (list :op ">" (list :var "n") (list :int 0))
            (list :int 1))
          (list
            :guard
            (list :op "<" (list :var "n") (list :int 0))
            (list :neg (list :int 1)))
          (list
            :guard
            (list :var "otherwise")
            (list :int 0)))))))

(hk-test
  "mixed: one eq clause plus one guarded clause"
  (hk-parse-top "sign 0 = 0\nsign n | n > 0 = 1\n       | otherwise = -1")
  (hk-prog
    (list
      :fun-clause
      "sign"
      (list (list :p-int 0))
      (list :int 0))
    (list
      :fun-clause
      "sign"
      (list (list :p-var "n"))
      (list
        :guarded
        (list
          (list
            :guard
            (list :op ">" (list :var "n") (list :int 0))
            (list :int 1))
          (list
            :guard
            (list :var "otherwise")
            (list :neg (list :int 1))))))))

;; ── where on fun-clauses ──
(hk-test
  "where with one binding"
  (hk-parse-top "f x = y + y\n  where y = x + 1")
  (hk-prog
    (list
      :fun-clause
      "f"
      (list (list :p-var "x"))
      (list
        :where
        (list :op "+" (list :var "y") (list :var "y"))
        (list
          (list
            :fun-clause
            "y"
            (list)
            (list :op "+" (list :var "x") (list :int 1))))))))

(hk-test
  "where with multiple bindings"
  (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
        :where
        (list :op "*" (list :var "y") (list :var "z"))
        (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))))))))

(hk-test
  "guards + where"
  (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
        :where
        (list
          :guarded
          (list
            (list
              :guard
              (list :op ">" (list :var "x") (list :int 0))
              (list :var "y"))
            (list
              :guard
              (list :var "otherwise")
              (list :int 0))))
        (list
          (list :fun-clause "y" (list) (list :int 99)))))))

;; ── Guards in case alts ──
(hk-test
  "case alt with guards"
  (hk-parse "case x of\n  Just y | y > 0 -> y\n         | otherwise -> 0\n  Nothing -> 0")
  (list
    :case
    (list :var "x")
    (list
      (list
        :alt
        (list :p-con "Just" (list (list :p-var "y")))
        (list
          :guarded
          (list
            (list
              :guard
              (list :op ">" (list :var "y") (list :int 0))
              (list :var "y"))
            (list
              :guard
              (list :var "otherwise")
              (list :int 0)))))
      (list :alt (list :p-con "Nothing" (list)) (list :int 0)))))

(hk-test
  "case alt with where"
  (hk-parse "case x of\n  Just y -> y + z where z = 5\n  Nothing -> 0")
  (list
    :case
    (list :var "x")
    (list
      (list
        :alt
        (list :p-con "Just" (list (list :p-var "y")))
        (list
          :where
          (list :op "+" (list :var "y") (list :var "z"))
          (list
            (list :fun-clause "z" (list) (list :int 5)))))
      (list :alt (list :p-con "Nothing" (list)) (list :int 0)))))

;; ── let-bindings: funclause form, guards, where ──
(hk-test
  "let with funclause shorthand"
  (hk-parse "let f x = x + 1 in f 5")
  (list
    :let
    (list
      (list
        :fun-clause
        "f"
        (list (list :p-var "x"))
        (list :op "+" (list :var "x") (list :int 1))))
    (list :app (list :var "f") (list :int 5))))

(hk-test
  "let with guards"
  (hk-parse "let f x | x > 0 = x\n        | otherwise = 0\nin f 3")
  (list
    :let
    (list
      (list
        :fun-clause
        "f"
        (list (list :p-var "x"))
        (list
          :guarded
          (list
            (list
              :guard
              (list :op ">" (list :var "x") (list :int 0))
              (list :var "x"))
            (list
              :guard
              (list :var "otherwise")
              (list :int 0))))))
    (list :app (list :var "f") (list :int 3))))

(hk-test
  "let funclause + where"
  (hk-parse "let f x = y where y = x + 1\nin f 7")
  (list
    :let
    (list
      (list
        :fun-clause
        "f"
        (list (list :p-var "x"))
        (list
          :where
          (list :var "y")
          (list
            (list
              :fun-clause
              "y"
              (list)
              (list :op "+" (list :var "x") (list :int 1)))))))
    (list :app (list :var "f") (list :int 7))))

;; ── Nested: where inside where (via recursive hk-parse-decl) ──
(hk-test
  "where block can contain a type signature"
  (hk-parse-top "f x = y\n  where y :: Int\n        y = x")
  (hk-prog
    (list
      :fun-clause
      "f"
      (list (list :p-var "x"))
      (list
        :where
        (list :var "y")
        (list
          (list :type-sig (list "y") (list :t-con "Int"))
          (list
            :fun-clause
            "y"
            (list)
            (list :var "x")))))))

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