Rule lookup as a trie

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.

src/JbeamEdit/Formatting/Rules.hs

@@ -27,7 +27,7 @@
 ) where
 
 import Data.Bool (bool)
 import Data.Foldable (fold)
 import Data.Function (on)
 import Data.List (find)
 import Data.Map (Map)
@@ -40,7 +40,7 @@
 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 @@
 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 @@
 
 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
@@ -260,13 +267,13 @@
 lookupPropertyForCursor matchMode key rs cursor = lookupProp key (findPropertiesForCursor matchMode cursor rs)
 
 comparePC :: NodePatternSelector -> NC.NodeBreadcrumb -> Bool
 comparePC AnyObjectKey (NC.ObjectIndexAndKey _ _) = True
 comparePC AnyArrayIndex (NC.ArrayIndex _) = True
 comparePC (Selector s) bc = NC.compareSB s bc
 comparePC _ _ = False
 
 compareCursorAndPattern :: MatchMode -> NC.NodeCursor -> NodePattern -> Bool
 compareCursorAndPattern matchMode (NC.NodeCursor c) (NodePattern p) = sameBy matchMode comparePC p c
 
 type SelCrumbCompFun = NodePatternSelector -> NC.NodeBreadcrumb -> Bool
 
@@ -276,7 +283,7 @@
   -> Seq NodePatternSelector
   -> Seq NC.NodeBreadcrumb
   -> Bool
 sameBy matchMode f = go
   where
     go (p :<| ps) (b :<| bs) =
       let res = f p b
@@ -285,5 +292,4 @@
 
 -- 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

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

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) ->

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)