Rule lookup as a trie

JBFL_DOCS.md

@@ -74,6 +74,24 @@ Typical use cases include:
 - `TrailingComma: None` strips trailing commas. `Force` always adds them. `Preserve` (default) keeps whatever the source file had.
 - `TrailingComma` is resolved at the child level, so `.* { TrailingComma: None; }` also strips the trailing comma in the root object.
 
+### How far a property reaches
+
+A pattern names one level. Some properties then apply only to what sits exactly
+there, and others also apply to everything nested below it, so a rule on `.*`
+can still decide how a value five levels down is printed.
+
+| Reaches                     | Properties                                                                                      |
+|-----------------------------|-------------------------------------------------------------------------------------------------|
+| The matched value only      | `AutoPad`, `AlignObjectKeys`, `AutoPadSubObjects`                                                |
+| The matched value and below | `PadDecimals`, `PadAmount`, `Indent`, `ComplexNewLine`, `TrailingComma`, `PreserveNumberFormat`  |
+
+The three in the first row all describe how one array or object lays out its own
+children, so inheriting them would align structures the rule never mentioned.
+
+This is why `.* { Indent: 2; }` indents the whole file while `.* { AutoPad: true; }`
+only pads the root object, and why the shipped `minimal.jbfl` can set
+`PadDecimals` on `.*.nodes[*][*]` or on a parent and get the same result.
+
 ## Detailed Rules Examples
 
 ### Pattern: `.*.nodes[*][*]`

cabal.project.dev

@@ -14,7 +14,8 @@ package jbeam-edit
   ghc-options:
     -haddock
     -Wno-invalid-haddock
+    -XPartialTypeSignatures
 
   documentation: False
   tests: True
-  flags: +dump-ast +transformation -windows-example-paths
+  flags: -modern-containers +dump-ast +transformation -windows-example-paths

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.hs

@@ -41,13 +41,12 @@ import JbeamEdit.Core.Node (
 import JbeamEdit.Core.NodeCursor (newCursor)
 import JbeamEdit.Core.NodeCursor qualified as NC
 import JbeamEdit.Formatting.Rules (
-  MatchMode (..),
   PropertyKey (..),
   RuleSet (..),
   applyPadLogic,
   findPropertiesForCursor,
+  lookupProperty,
   lookupPropertyForCursor,
-  lookupRule,
  )
 import JbeamEdit.Formatting.Rules.ComplexNewLine qualified as CNL
 import JbeamEdit.Formatting.Rules.TrailingComma qualified as TC
@@ -238,7 +237,7 @@ addDelimiters rs index rowIdx c complexChildren state acc ns@((node, nodeHadComm
               ( \childCursor _ ->
                   fromMaybe
                     TC.Preserve
-                    (lookupPropertyForCursor PrefixMatch TrailingComma rs childCursor)
+                    (lookupPropertyForCursor TrailingComma rs childCursor)
               )
               index
               node
@@ -320,17 +319,16 @@ doFormatNode
   -> Text
 doFormatNode rs cursor state elems =
   let nodes = V.map fst elems
-      prefixProps = findPropertiesForCursor PrefixMatch cursor rs
-      exactProps = findPropertiesForCursor ExactMatch cursor rs
+      props = findPropertiesForCursor cursor rs
 
-      autoPadEnabled = lookupRule AutoPad exactProps == Just True
-      alignObjectKeysEnabled = lookupRule AlignObjectKeys exactProps == Just True
-      autopadSubObjectsEnabled = lookupRule AutoPadSubObjects exactProps == Just True
+      autoPadEnabled = lookupProperty AutoPad props == Just True
+      alignObjectKeysEnabled = lookupProperty AlignObjectKeys props == Just True
+      autopadSubObjectsEnabled = lookupProperty AutoPadSubObjects props == Just True
 
       complexChildren =
-        lookupRule ComplexNewLine prefixProps == Just CNL.Force
+        lookupProperty ComplexNewLine props == Just CNL.Force
           || any (liftA2 (||) isSinglelineComment isComplexNode) nodes
-            && lookupRule ComplexNewLine prefixProps /= Just CNL.None
+            && lookupProperty ComplexNewLine props /= Just CNL.None
 
       (colWidths, formattedCache, headerWasExtracted) =
         maxColumnLengthsWithCache rs cursor nodes
@@ -397,7 +395,7 @@ doFormatNode rs cursor state elems =
           . V.toList
           $ elems
 
-      indentationAmount = fromMaybe 4 (lookupRule Indent prefixProps)
+      indentationAmount = fromMaybe 4 (lookupProperty Indent props)
    in if complexChildren
         then
           T.unlines
@@ -453,8 +451,8 @@ formatWithCursor rs state cursor (ObjectKey (k, v)) =
    in paddedKey <> " : " <> valueText
 formatWithCursor _ _ _ (Comment comment) = formatComment comment
 formatWithCursor rs _ cursor n =
-  let ps = findPropertiesForCursor PrefixMatch cursor rs
-      preserve = (Just True == lookupRule PreserveNumberFormat ps)
+  let ps = findPropertiesForCursor cursor rs
+      preserve = (Just True == lookupProperty PreserveNumberFormat ps)
    in applyPadLogic (formatScalarNode preserve) ps n
 
 formatNode :: RuleSet -> Node -> Text

src/JbeamEdit/Formatting/Rules.hs

@@ -1,13 +1,12 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeOperators #-}
 
 module JbeamEdit.Formatting.Rules (
-  MatchMode (..),
   NodePatternSelector (..),
-  NodePattern (..),
   SomeKey (..),
   SomeProperty (..),
   PropertyKey (..),
@@ -18,29 +17,29 @@ module JbeamEdit.Formatting.Rules (
   lookupKey,
   allProperties,
   deprecatedAliases,
+  prefixProperties,
   keyName,
   applyPadLogic,
   complexNewLine,
-  lookupRule,
+  lookupProperty,
   lookupPropertyForCursor,
   findPropertiesForCursor,
 ) where
 
 import Data.Bool (bool)
 import Data.Foldable (fold)
 import Data.Function (on)
-import Data.List (find)
+import Data.List (find, sortOn)
 import Data.Map (Map)
 import Data.Map qualified as M
 import Data.Ord (Down (..))
 import Data.Sequence (Seq (..))
-import Data.Sequence qualified as Seq (length, null)
 import Data.Text (Text)
 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,32 +48,21 @@ 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)
-
-newtype NodePattern
-  = NodePattern (Seq NodePatternSelector)
+  | Selector NP.NodeSelector
   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)
-
-instance Ord NodePattern where
-  compare (NodePattern a) (NodePattern b) =
-    case on compare (Down . Seq.length) a b of
-      EQ -> compare a b
-      c -> c
+  (RuleSet rs1 ps1 aok1 aai1 h1 b1) <> (RuleSet rs2 ps2 aok2 aai2 h2 b2) =
+    RuleSet
+      (M.unionWith (<>) rs1 rs2)
+      (mergePrefixes ps1 ps2)
+      (aok1 <> aok2)
+      (aai1 <> aai2)
+      (h1 <> h2)
+      (b1 <> b2)
 
 data PropertyKey a where
   AutoPad :: PropertyKey Bool
@@ -190,6 +178,18 @@ intProperties = map SomeKey [PadAmount, PadDecimals, Indent]
 allProperties :: [SomeKey]
 allProperties = boolProperties ++ enumProperties ++ intProperties
 
+mergePrefixes :: [(Text, RuleSet)] -> [(Text, RuleSet)] -> [(Text, RuleSet)]
+mergePrefixes ps1 ps2 =
+  sortOn (Down . T.length . fst) . M.toList . M.fromListWith (flip (<>)) $
+    ps1 <> ps2
+
+prefixProperties :: [SomeKey]
+prefixProperties =
+  SomeKey ComplexNewLine
+    : SomeKey TrailingComma
+    : SomeKey PreserveNumberFormat
+    : map SomeKey [PadAmount, PadDecimals, Indent]
+
 -- | Maps deprecated property names to (key, value-when-true, value-when-false).
 deprecatedAliases :: [(Text, (SomeKey, SomeProperty, SomeProperty))]
 deprecatedAliases =
@@ -213,22 +213,26 @@ deprecatedAliases =
 
 type Rule = Map SomeKey SomeProperty
 
-newtype RuleSet
-  = RuleSet (Map NodePattern Rule)
+data RuleSet
+  = RuleSet
+  { rsBySelectors :: Map NP.NodeSelector 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
-lookupProp targetKey m =
+lookupProperty :: (Eq a, Read a, Show a) => PropertyKey a -> Rule -> Maybe a
+lookupProperty targetKey m =
   case M.lookup (SomeKey targetKey) m of
     Just (SomeProperty key val) ->
       case eqKey key targetKey of
         Just Refl -> Just val
         Nothing -> Nothing
     Nothing -> Nothing
 
-lookupRule :: (Eq a, Read a, Show a) => PropertyKey a -> Rule -> Maybe a
-lookupRule = lookupProp
-
 applyDecimalPadding :: Int -> Text -> Text
 applyDecimalPadding padDecimals node
   | padDecimals /= 0
@@ -240,50 +244,43 @@ applyDecimalPadding padDecimals node
 
 applyPadLogic :: (Node -> Text) -> Rule -> Node -> Text
 applyPadLogic f rs n =
-  let padAmount = sum $ lookupProp PadAmount rs
-      padDecimals = sum $ lookupProp PadDecimals rs
+  let padAmount = sum $ lookupProperty PadAmount rs
+      padDecimals = sum $ lookupProperty PadDecimals rs
       decimalPaddedText
         | isNumberNode n = applyDecimalPadding padDecimals (f n)
         | otherwise = f n
    in bool (T.justifyLeft padAmount ' ' decimalPaddedText) (f n) (isComplexNode n)
 
 complexNewLine :: RuleSet -> NC.NodeCursor -> Maybe ComplexNewLine
 complexNewLine rs cursor =
-  let ps = findPropertiesForCursor PrefixMatch cursor rs
-   in lookupProp ComplexNewLine ps
-
-data MatchMode = PrefixMatch | ExactMatch deriving (Eq, Show)
+  let ps = findPropertiesForCursor cursor rs
+   in lookupProperty ComplexNewLine ps
 
 lookupPropertyForCursor
   :: (Eq a, Read a, Show a)
-  => MatchMode -> PropertyKey a -> RuleSet -> NC.NodeCursor -> Maybe a
-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
-
-sameBy
-  :: MatchMode
-  -> SelCrumbCompFun
-  -> Seq NodePatternSelector
-  -> Seq NC.NodeBreadcrumb
-  -> Bool
-sameBy matchMode f = go
+  => PropertyKey a -> RuleSet -> NC.NodeCursor -> Maybe a
+lookupPropertyForCursor key rs cursor =
+  lookupProperty key (findPropertiesForCursor cursor rs)
+
+findPropertiesForCursor :: NC.NodeCursor -> RuleSet -> Rule
+findPropertiesForCursor (NC.NodeCursor cursor) = go cursor
   where
-    go (p :<| ps) (b :<| bs) =
-      let res = f p b
-       in res && go ps bs
-    go ps bs = Seq.null ps && (Seq.null bs || PrefixMatch == matchMode)
-
--- TODO: migrate to M.filterKeys once the stack snapshot ships containers 0.8
-findPropertiesForCursor :: MatchMode -> NC.NodeCursor -> RuleSet -> Rule
-findPropertiesForCursor matchMode cursor (RuleSet rs) =
-  fold (M.filterWithKey (const . compareCursorAndPattern matchMode cursor) rs)
+    go Empty rs = rs.rsHere <> rs.rsBelow
+    go (NC.ObjectIndexAndKey i k :<| bs) rs =
+      go
+        bs
+        ( addBelowProps rs $
+            fold (M.lookup (NP.ObjectKey k) rs.rsBySelectors)
+              <> fold (M.lookup (NP.ObjectIndex i) rs.rsBySelectors)
+              <> matchingPrefixes k rs.rsPrefixes
+              <> fold rs.rsAnyObjectKey
+        )
+    go (NC.ArrayIndex i :<| bs) rs =
+      go
+        bs
+        ( addBelowProps rs $
+            fold (M.lookup (NP.ArrayIndex i) rs.rsBySelectors)
+              <> fold rs.rsAnyArrayIndex
+        )
+    addBelowProps rsAbove rs = rs {rsBelow = rs.rsBelow <> rsAbove.rsBelow}
+    matchingPrefixes k = foldMap snd . filter ((`T.isPrefixOf` k) . fst)