seihou-core 0.7.0.0 → 0.8.0.0

raw patch · 3 files changed

+126/−2 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• seihou-core.cabal +1/−1
• src/Seihou/Core/Expr.hs +51/−0
• test/Seihou/Core/ExprSpec.hs +74/−1

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: seihou-core-version: 0.7.0.0+version: 0.8.0.0 synopsis: Core library for Seihou project scaffolding description:   Core library for Seihou, a composable project scaffolding system.

@@ -1,5 +1,6 @@ module Seihou.Core.Expr   ( parseExpr,+    renderExpr,     evalExpr,     exprRefs,   )@@ -35,6 +36,56 @@           Right (expr, rest)             | T.null (T.strip rest) -> Right expr             | otherwise -> Left ("unexpected trailing input: " <> rest)++-- | Render an 'Expr' back to the surface syntax 'parseExpr' accepts.+--+-- @parseExpr . renderExpr@ is the identity on every expression 'parseExpr' can+-- produce, which matters because the original condition text is not retained+-- anywhere: a @when@ clause is parsed out of Dhall and the string is discarded,+-- so any surface that wants to /show/ a condition has to rebuild it.+--+-- Sub-expressions are parenthesized exactly where the grammar\'s precedence+-- (@||@ loosest, then @&&@, then @!@, then atoms) would otherwise reassociate+-- them. A 'VText' value is always quoted, both because it may contain a space+-- or a delimiter and because an unquoted @true@ would come back as a 'VBool'.+--+-- One value has no surface syntax to render into: 'VList' cannot appear in an+-- expression 'parseExpr' produced, because the value grammar has no list+-- literal. It is rendered as a bracketed, comma-separated list for display, and+-- that one shape alone does not round-trip.+renderExpr :: Expr -> Text+renderExpr = go precLowest+  where+    go :: Int -> Expr -> Text+    go prec (ExprOr left right) =+      parenWhen (prec > precOr) (go precOr left <> " || " <> go precAnd right)+    go prec (ExprAnd left right) =+      parenWhen (prec > precAnd) (go precAnd left <> " && " <> go precNot right)+    go prec (ExprNot inner) =+      parenWhen (prec > precNot) ("!" <> go precAtom inner)+    go _ (ExprIsSet (VarName name)) = "IsSet " <> name+    go _ (ExprEq (VarName name) value) = "Eq " <> name <> " " <> renderVarValue value+    go _ (ExprLit True) = "true"+    go _ (ExprLit False) = "false"++    precLowest = 0 :: Int+    precOr = 0 :: Int+    precAnd = 1 :: Int+    precNot = 2 :: Int+    precAtom = 3 :: Int++    parenWhen True rendered = "(" <> rendered <> ")"+    parenWhen False rendered = rendered++-- | Render a 'VarValue' as an expression right-hand side. Text is always+-- quoted; see 'renderExpr' for why, and for the 'VList' caveat.+renderVarValue :: VarValue -> Text+renderVarValue (VText text) = "\"" <> text <> "\""+renderVarValue (VBool True) = "true"+renderVarValue (VBool False) = "false"+renderVarValue (VInt n) = T.pack (show n)+renderVarValue (VList values) =+  "[" <> T.intercalate ", " (renderVarValue <$> values) <> "]"  -- | Evaluate an expression against a map of variable bindings. evalExpr :: Map VarName VarValue -> Expr -> Bool

@@ -1,7 +1,7 @@ module Seihou.Core.ExprSpec (tests) where  import Data.Map.Strict qualified as Map-import Seihou.Core.Expr (evalExpr, exprRefs, parseExpr)+import Seihou.Core.Expr (evalExpr, exprRefs, parseExpr, renderExpr) import Seihou.Core.Types import Test.Hspec import Test.Tasty@@ -155,6 +155,42 @@       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))]@@ -175,3 +211,40 @@      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)))+  ]