diff --git a/src/JbeamEdit/Core/NodePath.hs b/src/JbeamEdit/Core/NodePath.hs index 342817b3..c6b214bf 100644 --- a/src/JbeamEdit/Core/NodePath.hs +++ b/src/JbeamEdit/Core/NodePath.hs @@ -9,9 +9,10 @@ module JbeamEdit.Core.NodePath ( ) where import Data.Either.Extra (maybeToEither) +import Data.Function (on) import Data.Sequence (Seq (..)) import Data.Text (Text) -import Data.Text qualified as T (isPrefixOf, show) +import Data.Text qualified as T (isPrefixOf, length, show) import Data.Vector (Vector) import Data.Vector qualified as V import GHC.IsList (IsList (..)) @@ -29,7 +30,16 @@ data NodeSelector | ObjectKey Text | ObjectPrefixKey Text | ObjectIndex Int - deriving (Eq, Ord, Read, Show) + deriving (Eq, Read, Show) + +instance Ord NodeSelector where + compare = on compare rank + where + rank :: NodeSelector -> (Int, Int, Text) + rank (ObjectKey key) = (0, 0, key) + rank (ArrayIndex index) = (1, index, "") + rank (ObjectIndex i) = (2, i, "") + rank (ObjectPrefixKey prefix) = (3, negate (T.length prefix), prefix) {- | node path A NodePath is a Sequence of selectors to that point out a certain point in a Node tree, either to point at as something when fetching it from Node or to point to something compare that I at a certain point when doing updates. diff --git a/src/JbeamEdit/Formatting/Rules.hs b/src/JbeamEdit/Formatting/Rules.hs index 59f68477..80c759b1 100644 --- a/src/JbeamEdit/Formatting/Rules.hs +++ b/src/JbeamEdit/Formatting/Rules.hs @@ -40,7 +40,7 @@ import Data.Text qualified as T import Data.Type.Equality ((:~:) (Refl)) import JbeamEdit.Core.Node import JbeamEdit.Core.NodeCursor qualified as NC -import JbeamEdit.Core.NodePath (NodeSelector (..)) +import JbeamEdit.Core.NodePath qualified as NP (NodeSelector (..)) import JbeamEdit.Formatting.Rules.ComplexNewLine (ComplexNewLine) import JbeamEdit.Formatting.Rules.ComplexNewLine qualified as CNL import JbeamEdit.Formatting.Rules.TrailingComma (TrailingComma) @@ -49,26 +49,26 @@ import Text.Read qualified as TR data NodePatternSelector = AnyObjectKey | AnyArrayIndex - | Selector NodeSelector - deriving stock (Eq, Read, Show) - -instance Ord NodePatternSelector where - compare a b = compare (rank a) (rank b) - where - rank :: NodePatternSelector -> (Int, Maybe NodeSelector) - rank AnyArrayIndex = (2, Nothing) - rank AnyObjectKey = (1, Nothing) - rank (Selector s) = (0, Just s) + | Selector NP.NodeSelector + deriving stock (Eq, Ord, Read, Show) newtype NodePattern = NodePattern (Seq NodePatternSelector) deriving stock (Eq, Read, Show) instance Monoid RuleSet where - mempty = RuleSet M.empty + mempty = RuleSet M.empty [] mempty mempty M.empty M.empty instance Semigroup RuleSet where - (RuleSet rs1) <> (RuleSet rs2) = RuleSet (M.unionWith M.union rs1 rs2) + (RuleSet rs1 ps1 aok1 aai1 h1 b1) <> (RuleSet rs2 ps2 aok2 aai2 h2 b2) = + RuleSet + (M.union rs1 rs2) + (ps1 <> ps2) + (liftUnion aok1 aok2) + (liftUnion aai1 aai2) + (h1 <> h2) + (b1 <> b2) + where liftUnion = liftA2 (<>) instance Ord NodePattern where compare (NodePattern a) (NodePattern b) = @@ -213,8 +213,15 @@ deprecatedAliases = type Rule = Map SomeKey SomeProperty -newtype RuleSet - = RuleSet (Map NodePattern Rule) +data RuleSet + = RuleSet + { rsBySelectors :: Map NP.NodeSelector (Maybe RuleSet) + , rsPrefixes :: [(Text, RuleSet)] + , rsAnyObjectKey :: Maybe RuleSet + , rsAnyArrayIndex :: Maybe RuleSet + , rsHere :: Rule + , rsBelow :: Rule + } deriving stock (Eq, Read, Show) lookupProp :: (Eq a, Read a, Show a) => PropertyKey a -> Rule -> Maybe a @@ -285,5 +292,4 @@ sameBy matchMode f = go -- TODO: when possible upgrade to containers 0.8 and migrate to M.filterKeys findPropertiesForCursor :: MatchMode -> NC.NodeCursor -> RuleSet -> Rule -findPropertiesForCursor matchMode cursor (RuleSet rs) = - fold (M.filterWithKey (const . compareCursorAndPattern matchMode cursor) rs) +findPropertiesForCursor = undefined diff --git a/test/Formatting/RulesSpec.hs b/test/Formatting/RulesSpec.hs index a40c7565..d0e23448 100644 --- a/test/Formatting/RulesSpec.hs +++ b/test/Formatting/RulesSpec.hs @@ -1,12 +1,17 @@ module Formatting.RulesSpec (spec) where +import Data.Text qualified as T import GHC.IsList (fromList) +import JbeamEdit.Core.NodeCursor (NodeBreadcrumb (..), NodeCursor (..)) +import JbeamEdit.Core.NodePath qualified as NP import JbeamEdit.Formatting import JbeamEdit.Formatting.Rules import SpecHelper spec :: Spec spec = do + precedenceSpec + describe "SomeKey & SomeProperty" $ do it "Eq works for same PropertyKey" $ SomeKey PadAmount == SomeKey PadAmount `shouldBe` True @@ -34,3 +39,168 @@ spec = do ] it "applies PadAmount and PadDecimals" $ applyPadLogic (formatScalarNode False) ruleSet fakeNode `shouldBe` "123.50 " + + -- A pattern matches only once it has been consumed whole, and leftover + -- breadcrumbs are allowed under PrefixMatch alone. A lookup that answers at + -- the wrong depth silently changes formatting everywhere, since every + -- property the formatter reads comes through one of the two modes. + describe "matching a pattern against a cursor" $ do + let cursorAt crumbs = NodeCursor (fromList crumbs) + nodesCursor = + cursorAt [ObjectIndexAndKey 0 "part", ObjectIndexAndKey 0 "nodes"] + ruleSetFor p = + RuleSet + ( fromList + [ + ( NodePattern (fromList p) + , fromList [(SomeKey PadAmount, SomeProperty PadAmount 7)] + ) + ] + ) + found mode p = lookupPropertyForCursor mode PadAmount (ruleSetFor p) + + it "matches a pattern of the same length in both modes" $ do + let p = [AnyObjectKey, Selector (NP.ObjectKey "nodes")] + found PrefixMatch p nodesCursor `shouldBe` Just 7 + found ExactMatch p nodesCursor `shouldBe` Just 7 + + it "matches a shorter pattern only as a prefix" $ do + let p = [AnyObjectKey] + found PrefixMatch p nodesCursor `shouldBe` Just 7 + found ExactMatch p nodesCursor `shouldBe` Nothing + + it "never matches a pattern longer than the cursor" $ do + let p = + [ AnyObjectKey + , Selector (NP.ObjectKey "nodes") + , AnyArrayIndex + ] + found PrefixMatch p nodesCursor `shouldBe` Nothing + found ExactMatch p nodesCursor `shouldBe` Nothing + + -- `.test*` is documented JBFL (JBFL_DOCS.md) and cannot be looked up by + -- equality, since the stored key is a prefix of the breadcrumb rather than + -- the same text. It is the one selector a trie has to solve rather than + -- key on directly. + it "matches a prefix key against the rest of the breadcrumb" $ do + let p k = [AnyObjectKey, Selector (NP.ObjectPrefixKey k)] + atDeformGroups = + cursorAt + [ObjectIndexAndKey 0 "part", ObjectIndexAndKey 0 "deformGroups"] + found ExactMatch (p "deform") atDeformGroups `shouldBe` Just 7 + found ExactMatch (p "deformGroups") atDeformGroups `shouldBe` Just 7 + found ExactMatch (p "deformGroupsAndMore") atDeformGroups `shouldBe` Nothing + found ExactMatch (p "eform") atDeformGroups `shouldBe` Nothing + + it "keeps the two wildcards apart" $ do + let atArray = cursorAt [ObjectIndexAndKey 0 "part", ArrayIndex 0] + atKey = cursorAt [ObjectIndexAndKey 0 "part", ObjectIndexAndKey 0 "k"] + anyKeyThen w = [AnyObjectKey, w] + found ExactMatch (anyKeyThen AnyArrayIndex) atArray `shouldBe` Just 7 + found ExactMatch (anyKeyThen AnyObjectKey) atArray `shouldBe` Nothing + found ExactMatch (anyKeyThen AnyObjectKey) atKey `shouldBe` Just 7 + found ExactMatch (anyKeyThen AnyArrayIndex) atKey `shouldBe` Nothing + +{- | When several patterns match the same node, the more specific one supplies +the property. Specificity is how many nodes a selector can match at that level: +a named key first, then a positional index, then a prefix key with the longer +prefix winning, then the wildcards. + +Written as JBFL source and formatted output on purpose. Both ends survive the +rule lookup becoming a trie, while `NodePattern` and `MatchMode` do not. +-} +precedenceSpec :: Spec +precedenceSpec = do + let cell :: Int -> Node + cell n = Number (mkNumberValue (T.pack (show n)) (fromIntegral n)) + -- Three levels deep, so Indent set two breadcrumbs down still shows. + pair a b = mkArray (fromList [mkArray (fromList [a, b]), mkArray (fromList [b, a])]) + -- Complex enough to be broken across lines, so Indent shows in the output. + topNode = + mkObject + ( fromList + [ ObjectKey + ( String "deformGroups" + , mkArray + ( fromList + [ pair (cell 1) (cell 2) + , pair (cell 3) (cell 4) + ] + ) + ) + ] + ) + rulesFrom = rulesFromSource + formatWith = flip formatNode topNode . rulesFrom + -- The second assertion is what stops the first passing for two rules that + -- happen to format the same way. + beats winner loser = do + formatWith (winner <> "\n" <> loser) `shouldBe` formatWith winner + formatWith winner `shouldNotBe` formatWith loser + named = ".deformGroups { Indent : 1; }" + positional = ".0 { Indent : 2; }" + longPrefix = ".deform* { Indent : 3; }" + shortPrefix = ".de* { Indent : 5; }" + wildcard = ".* { Indent : 6; }" + + describe "which of several matching patterns supplies a property" $ do + it "prefers a named key over a positional index" $ named `beats` positional + it "prefers a positional index over a prefix key" $ + positional `beats` longPrefix + it "prefers the longer of two prefix keys" $ longPrefix `beats` shortPrefix + it "prefers a prefix key over a wildcard" $ shortPrefix `beats` wildcard + + -- Precedence settles one property at a time. Every shipped ruleset is + -- written this way: `.*` carries Indent and TrailingComma for the whole + -- file and narrower patterns add to it, so a winner that supplied its + -- properties wholesale would strip the broad ones off every node it matched. + -- `[4]` is the last row of the selector table in JBFL_DOCS.md, and the only + -- one no shipped ruleset uses, so nothing else would notice it going away. + -- A prefix key has to reach below the node it names, like any other + -- selector under a prefix match. It is also the one a trie cannot key on + -- directly, so it is the likeliest of them to lose that reach. + it "cascades from a prefix key the same way a named key does" $ do + let byPrefix = formatWith ".deform* { Indent : 1; }" + byPrefix `shouldBe` formatWith ".deformGroups { Indent : 1; }" + byPrefix `shouldNotBe` formatWith ".deformGroups { Indent : 6; }" + + -- Length is settled before specificity, and it is the one rung with no + -- shorthand: the two patterns reach different sets of nodes, so the winner + -- alone cannot be the expected value. The outer array is indented by the + -- shorter rule, the inner ones by the longer. + it "settles length before specificity" $ do + let shorter = ".deformGroups { Indent : 7; }" + longer = ".deformGroups[*] { Indent : 1; }" + both = shorter <> "\n" <> longer + formatWith both + `shouldBe` "{\n \"deformGroups\" : [\n [\n [1, 2],\n [2, 1]\n ],\n [\n [3, 4],\n [4, 3]\n ]\n ]\n}\n" + formatWith both `shouldNotBe` formatWith shorter + formatWith both `shouldNotBe` formatWith longer + + it "matches a literal array index and prefers it over the wildcard" $ + ".deformGroups[0] { Indent : 1; }" `beats` ".deformGroups[*] { Indent : 4; }" + + it "still takes properties the winner does not set from the loser" $ do + let winnerOnly = ".deformGroups { Indent : 1; }" + loserOnly = ".de* { TrailingComma : Force; }" + formatWith (winnerOnly <> "\n" <> loserOnly) + `shouldNotBe` formatWith winnerOnly + formatWith (winnerOnly <> "\n" <> loserOnly) + `shouldNotBe` formatWith loserOnly + + -- A user's rules.jbfl is laid over the shipped one with `rs <> defaultRs` + -- (`Formatting/Config.hs`), so this is how every configured install resolves + -- its rules. The union is left-biased twice over, per pattern and per + -- property, and a trie has to reproduce both. + describe "combining a user ruleset with the shipped one" $ do + let user = rulesFrom ".deformGroups { Indent : 1; }" + shipped = rulesFrom ".deformGroups { Indent : 7; TrailingComma : Force; }" + format = flip formatNode topNode + + it "takes the user's value and keeps the rest of the shipped one" $ do + let merged = rulesFrom ".deformGroups { Indent : 1; TrailingComma : Force; }" + format (user <> shipped) `shouldBe` format merged + -- Guards the line above: without these the two rulesets could be + -- indistinguishable and the merge would prove nothing. + format user `shouldNotBe` format shipped + format merged `shouldNotBe` format user diff --git a/test/FormattingSpec.hs b/test/FormattingSpec.hs index 20dd571d..1b91a984 100644 --- a/test/FormattingSpec.hs +++ b/test/FormattingSpec.hs @@ -83,9 +83,62 @@ dynamicJbflTests = do expected <- T.pack <$> readFile outFile pure (outFile, formatted, expected) +{- | Which mode a property is read in is hardcoded in the formatter. Three come +from an exact match, AutoPad, AlignObjectKeys and AutoPadSubObjects, and they +are the ones about how a container lays out its own children. The other six +cascade and come from a prefix match: ComplexNewLine, TrailingComma, Indent, +PreserveNumberFormat, PadAmount and PadDecimals. + +Moving one across changes formatting and no fixture notices. This pins the split +as it stands before `>` (see #187), which is meant to replace it, so expect to +rewrite this when that lands. +-} +matchModeSpec :: Spec +matchModeSpec = do + let row cells = mkArray (fromList cells) + -- The first column has to vary in width for AutoPad to show, since + -- trailing spaces on the last one are trimmed either way. + rows = + row + [ row [String "a_long_name", Number (mkNumberValue "1" 1)] + , row [String "n1", Number (mkNumberValue "2" 2)] + ] + topNode = + mkObject + ( fromList + [ ObjectKey + ( String "part" + , mkObject (fromList [ObjectKey (String "rows", rows)]) + ) + ] + ) + -- The rows array sits two breadcrumbs deep, so `.*` is a prefix of its + -- cursor and `.*.rows` matches it exactly. + formatWith src = formatNode (rulesFromSource src) topNode + shortPattern prop = ".* { " <> prop <> " }" + exactPattern prop = ".*.rows { " <> prop <> " }" + + -- The only difference is the run of spaces before the 2, which is the + -- second column padded out to the width of the first row. + wrap body = "{\"part\" : {\n \"rows\" : [\n" <> body <> "\n ]\n}}\n" + baseline = wrap " [\"a_long_name\", 1],\n [\"n1\", 2]" + padded = wrap " [\"a_long_name\", 1],\n [\"n1\", 2]" + + describe "which match mode a property is read in" $ do + it "reads AutoPad from an exact match only" $ do + formatWith (exactPattern "AutoPad : true;") `shouldBe` padded + -- Without this line the assertion below also passes for a shortPattern + -- that matches nothing at all, which is not what is being claimed. + formatWith (shortPattern "ComplexNewLine : Force;") `shouldNotBe` baseline + formatWith (shortPattern "AutoPad : true;") `shouldBe` baseline + + it "reads ComplexNewLine from a prefix match" $ + formatWith (shortPattern "ComplexNewLine : Force;") `shouldNotBe` baseline + spec :: Spec spec = do mapM_ formatNodeSpec specs + matchModeSpec dynamicTests <- runIO dynamicJbflTests forM_ dynamicTests $ \(outFile, formatted, expected) -> diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index 483f95ef..8b257671 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -1,5 +1,6 @@ module SpecHelper ( textToLazyByteString, + rulesFromSource, applySpecOnInput, works, listFilesInDir, @@ -15,6 +16,8 @@ import Data.List (isPrefixOf, isSuffixOf) import Data.Text qualified as T import Data.Text.Encoding (encodeUtf8) import JbeamEdit.Core.Node +import JbeamEdit.Formatting.Rules (RuleSet) +import JbeamEdit.Parsing.DSL (parseDSL) import System.Directory (getDirectoryContents) import Test.Hspec @@ -45,3 +48,9 @@ works = it "works" textToLazyByteString :: String -> ByteString textToLazyByteString = BS.fromStrict . encodeUtf8 . T.pack + +rulesFromSource :: String -> RuleSet +rulesFromSource src = + case parseDSL (textToLazyByteString src) of + Right rs -> rs + Left err -> error ("bad JBFL in spec: " ++ T.unpack err)