ExprSpec.hs

module Seihou.Core.ExprSpec (tests) where

import Data.Map.Strict qualified as Map
import Seihou.Core.Expr (evalExpr, exprRefs, parseExpr, renderExpr)
import Seihou.Core.Types
import Test.Hspec
import Test.Tasty
import Test.Tasty.Hspec (testSpec)

tests :: IO TestTree
tests = testSpec "Seihou.Core.Expr" spec

spec :: Spec
spec = do
  describe "parseExpr" $ do
    it "parses true literal" $ do
      parseExpr "true" `shouldBe` Right (ExprLit True)

    it "parses false literal" $ do
      parseExpr "false" `shouldBe` Right (ExprLit False)

    it "parses IsSet atom" $ do
      parseExpr "IsSet license" `shouldBe` Right (ExprIsSet "license")

    it "parses IsSet with dotted var name" $ do
      parseExpr "IsSet project.name" `shouldBe` Right (ExprIsSet "project.name")

    it "parses Eq with quoted value" $ do
      parseExpr "Eq license \"MIT\""
        `shouldBe` Right (ExprEq "license" (VText "MIT"))

    it "parses Eq with bare word value" $ do
      parseExpr "Eq license MIT"
        `shouldBe` Right (ExprEq "license" (VText "MIT"))

    it "parses Eq with bare word true as VBool" $ do
      parseExpr "Eq enabled true"
        `shouldBe` Right (ExprEq "enabled" (VBool True))

    it "parses Eq with bare word false as VBool" $ do
      parseExpr "Eq enabled false"
        `shouldBe` Right (ExprEq "enabled" (VBool False))

    it "parses Eq with all-digit bare word as VInt" $ do
      parseExpr "Eq count 3"
        `shouldBe` Right (ExprEq "count" (VInt 3))

    it "parses Eq with negative integer bare word as VInt" $ do
      parseExpr "Eq offset -5"
        `shouldBe` Right (ExprEq "offset" (VInt (-5)))

    it "parses Eq with quoted digits as VText (not VInt)" $ do
      parseExpr "Eq count \"3\""
        `shouldBe` Right (ExprEq "count" (VText "3"))

    it "parses && expression" $ do
      parseExpr "IsSet a && IsSet b"
        `shouldBe` Right (ExprAnd (ExprIsSet "a") (ExprIsSet "b"))

    it "parses || expression" $ do
      parseExpr "IsSet a || IsSet b"
        `shouldBe` Right (ExprOr (ExprIsSet "a") (ExprIsSet "b"))

    it "parses ! negation" $ do
      parseExpr "!true"
        `shouldBe` Right (ExprNot (ExprLit True))

    it "parses negation with space" $ do
      parseExpr "! false"
        `shouldBe` Right (ExprNot (ExprLit False))

    it "parses parenthesized expression" $ do
      parseExpr "(true)"
        `shouldBe` Right (ExprLit True)

    it "respects operator precedence: && binds tighter than ||" $ do
      parseExpr "IsSet a && IsSet b || IsSet c"
        `shouldBe` Right (ExprOr (ExprAnd (ExprIsSet "a") (ExprIsSet "b")) (ExprIsSet "c"))

    it "parentheses override precedence" $ do
      parseExpr "IsSet a && (IsSet b || IsSet c)"
        `shouldBe` Right (ExprAnd (ExprIsSet "a") (ExprOr (ExprIsSet "b") (ExprIsSet "c")))

    it "parses compound expression from design doc" $ do
      parseExpr "IsSet license && Eq license \"MIT\""
        `shouldBe` Right
          ( ExprAnd
              (ExprIsSet "license")
              (ExprEq "license" (VText "MIT"))
          )

    it "rejects empty expression" $ do
      parseExpr "" `shouldBe` Left "empty expression"

    it "rejects malformed expression" $ do
      case parseExpr "@#$" of
        Left _ -> pure ()
        Right r -> expectationFailure ("Expected parse error, got: " <> show r)

    it "handles whitespace" $ do
      parseExpr "  true  " `shouldBe` Right (ExprLit True)

  describe "evalExpr" $ do
    let vars =
          Map.fromList
            [ (VarName "license", VText "MIT"),
              (VarName "project.name", VText "my-app"),
              (VarName "enabled", VBool True)
            ]

    it "evaluates ExprLit True" $ do
      evalExpr vars (ExprLit True) `shouldBe` True

    it "evaluates ExprLit False" $ do
      evalExpr vars (ExprLit False) `shouldBe` False

    it "evaluates ExprIsSet for present variable" $ do
      evalExpr vars (ExprIsSet "license") `shouldBe` True

    it "evaluates ExprIsSet for absent variable" $ do
      evalExpr vars (ExprIsSet "missing") `shouldBe` False

    it "evaluates ExprEq when values match" $ do
      evalExpr vars (ExprEq "license" (VText "MIT")) `shouldBe` True

    it "evaluates ExprEq when values differ" $ do
      evalExpr vars (ExprEq "license" (VText "BSD")) `shouldBe` False

    it "evaluates ExprEq with VBool True" $ do
      evalExpr vars (ExprEq "enabled" (VBool True)) `shouldBe` True

    it "evaluates ExprEq with VBool False against VBool True" $ do
      evalExpr vars (ExprEq "enabled" (VBool False)) `shouldBe` False

    it "evaluates a parsed int Eq against a VInt binding" $ do
      let intVars = Map.fromList [(VarName "count", VInt 3)]
      case parseExpr "Eq count 3" of
        Right expr -> evalExpr intVars expr `shouldBe` True
        Left err -> expectationFailure ("Expected parse, got: " <> show err)

    it "evaluates ExprNot" $ do
      evalExpr vars (ExprNot (ExprLit True)) `shouldBe` False
      evalExpr vars (ExprNot (ExprLit False)) `shouldBe` True

    it "evaluates ExprAnd" $ do
      evalExpr vars (ExprAnd (ExprLit True) (ExprLit True)) `shouldBe` True
      evalExpr vars (ExprAnd (ExprLit True) (ExprLit False)) `shouldBe` False

    it "evaluates ExprOr" $ do
      evalExpr vars (ExprOr (ExprLit True) (ExprLit False)) `shouldBe` True
      evalExpr vars (ExprOr (ExprLit False) (ExprLit False)) `shouldBe` False

    it "evaluates compound expression from design doc" $ do
      let expr = ExprAnd (ExprIsSet "license") (ExprEq "license" (VText "MIT"))
      evalExpr vars expr `shouldBe` True
      evalExpr Map.empty expr `shouldBe` False

  describe "renderExpr" $ do
    it "renders each atom in the surface syntax" $ do
      renderExpr (ExprLit True) `shouldBe` "true"
      renderExpr (ExprLit False) `shouldBe` "false"
      renderExpr (ExprIsSet "license") `shouldBe` "IsSet license"
      renderExpr (ExprEq "license" (VText "MIT")) `shouldBe` "Eq license \"MIT\""
      renderExpr (ExprEq "enabled" (VBool True)) `shouldBe` "Eq enabled true"
      renderExpr (ExprEq "count" (VInt 3)) `shouldBe` "Eq count 3"

    it "quotes text values so a bareword keyword is not reclassified" $ do
      renderExpr (ExprEq "x" (VText "true")) `shouldBe` "Eq x \"true\""
      parseExpr (renderExpr (ExprEq "x" (VText "true")))
        `shouldBe` Right (ExprEq "x" (VText "true"))

    it "quotes text values containing a delimiter" $ do
      let expr = ExprEq "x" (VText "a b) c")
      parseExpr (renderExpr expr) `shouldBe` Right expr

    it "renders binary operators without needless parentheses" $ do
      renderExpr (ExprAnd (ExprIsSet "a") (ExprIsSet "b"))
        `shouldBe` "IsSet a && IsSet b"
      renderExpr (ExprOr (ExprIsSet "a") (ExprIsSet "b"))
        `shouldBe` "IsSet a || IsSet b"
      renderExpr (ExprNot (ExprIsSet "a")) `shouldBe` "!IsSet a"

    it "parenthesizes only where precedence would reassociate" $ do
      renderExpr (ExprAnd (ExprOr (ExprIsSet "a") (ExprIsSet "b")) (ExprIsSet "c"))
        `shouldBe` "(IsSet a || IsSet b) && IsSet c"
      renderExpr (ExprOr (ExprAnd (ExprIsSet "a") (ExprIsSet "b")) (ExprIsSet "c"))
        `shouldBe` "IsSet a && IsSet b || IsSet c"
      renderExpr (ExprNot (ExprAnd (ExprIsSet "a") (ExprIsSet "b")))
        `shouldBe` "!(IsSet a && IsSet b)"

    it "round-trips through parseExpr for every constructor and two nesting levels" $ do
      mapM_ roundTrips roundTripCases

  describe "exprRefs" $ do
    it "returns the compared literal for Eq with a bareword bool" $ do
      exprRefs (ExprEq "x" (VBool True)) `shouldBe` [("x", Just (VBool True))]

    it "returns the compared literal for Eq with a quoted string" $ do
      exprRefs (ExprEq "x" (VText "true")) `shouldBe` [("x", Just (VText "true"))]

    it "returns a Nothing literal for IsSet" $ do
      exprRefs (ExprIsSet "y") `shouldBe` [("y", Nothing)]

    it "collects refs across && with mixed atoms" $ do
      exprRefs (ExprAnd (ExprIsSet "y") (ExprEq "z" (VInt 1)))
        `shouldBe` [("y", Nothing), ("z", Just (VInt 1))]

    it "recurses through Or and Not" $ do
      exprRefs (ExprOr (ExprNot (ExprIsSet "a")) (ExprEq "b" (VBool False)))
        `shouldBe` [("a", Nothing), ("b", Just (VBool False))]

    it "returns nothing for a literal" $ do
      exprRefs (ExprLit True) `shouldBe` []

-- | @parseExpr . renderExpr@ must be the identity on every expression
-- 'parseExpr' can produce.
roundTrips :: Expr -> Expectation
roundTrips expr = parseExpr (renderExpr expr) `shouldBe` Right expr

roundTripCases :: [Expr]
roundTripCases =
  [ ExprLit True,
    ExprLit False,
    ExprIsSet "license",
    ExprIsSet "project.name",
    ExprEq "license" (VText "MIT"),
    ExprEq "license" (VText "Apache 2.0"),
    ExprEq "license" (VText ""),
    ExprEq "enabled" (VBool True),
    ExprEq "enabled" (VBool False),
    ExprEq "count" (VInt 0),
    ExprEq "count" (VInt (-3)),
    ExprNot (ExprIsSet "a"),
    ExprNot (ExprNot (ExprIsSet "a")),
    ExprAnd (ExprIsSet "a") (ExprIsSet "b"),
    ExprOr (ExprIsSet "a") (ExprIsSet "b"),
    -- Two nesting levels, in both associations, for both operators.
    ExprAnd (ExprAnd (ExprIsSet "a") (ExprIsSet "b")) (ExprIsSet "c"),
    ExprAnd (ExprIsSet "a") (ExprAnd (ExprIsSet "b") (ExprIsSet "c")),
    ExprOr (ExprOr (ExprIsSet "a") (ExprIsSet "b")) (ExprIsSet "c"),
    ExprOr (ExprIsSet "a") (ExprOr (ExprIsSet "b") (ExprIsSet "c")),
    ExprAnd (ExprOr (ExprIsSet "a") (ExprIsSet "b")) (ExprIsSet "c"),
    ExprOr (ExprAnd (ExprIsSet "a") (ExprIsSet "b")) (ExprIsSet "c"),
    ExprNot (ExprAnd (ExprIsSet "a") (ExprIsSet "b")),
    ExprNot (ExprOr (ExprIsSet "a") (ExprIsSet "b")),
    ExprAnd (ExprNot (ExprIsSet "a")) (ExprEq "b" (VText "x y")),
    ExprOr
      (ExprNot (ExprEq "a" (VBool True)))
      (ExprAnd (ExprIsSet "b") (ExprEq "c" (VInt 7)))
  ]