From b5860b94326d834dbda9cc97555ea48e5ca31a36 Mon Sep 17 00:00:00 2001
From: Nicholas Clarke <nick@topos.org.uk>
Date: Mon, 30 Jun 2025 13:04:53 +0200
Subject: [PATCH 1/8] WIP Tree validator

Has support for lists so far
---
 src/Codec/CBOR/Cuddle/CBOR/Validator.hs | 181 +++++++++++++++++-------
 1 file changed, 133 insertions(+), 48 deletions(-)

diff --git a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
index f80884a..7dc60b4 100644
--- a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
+++ b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
@@ -20,7 +20,7 @@ import Data.Bits hiding (And)
 import Data.ByteString qualified as BS
 import Data.ByteString.Lazy qualified as BSL
 import Data.Function ((&))
-import Data.Functor ((<&>))
+import Data.Functor ((<&>), ($>))
 import Data.Functor.Identity
 import Data.IntSet qualified as IS
 import Data.List.NonEmpty qualified as NE
@@ -60,9 +60,9 @@ data CDDLResult
       -- | Rule we are trying
       Rule
       -- | List of expansions of rules
-      [[Rule]]
+      ExpansionTree
       -- | For each expansion, for each of the rules in the expansion, the result
-      [[(Rule, CBORTermResult)]]
+      (ExpansionTree' [(Rule, CBORTermResult)])
   | -- | All expansions failed
     --
     -- An expansion is: Given a CBOR @TMap@ of @N@ elements, we will expand the
@@ -71,7 +71,7 @@ data CDDLResult
       -- | Rule we are trying
       Rule
       -- | List of expansions
-      [[Rule]]
+      ExpansionTree
       -- | A list of matched items @(key, value, rule)@ and the unmatched item
       [([AMatchedItem], ANonMatchedItem)]
   | -- | The rule was valid but the control failed
@@ -655,58 +655,132 @@ flattenGroup cddl nodes =
     | rule <- nodes
     ]
 
+-- | A filter on a subtree in an expansion. How this is used will depend on the
+-- contenxt in which this expansion is used. For maps, we filter based on the
+-- key, which can be in any position. For arrays, we filter based on the first
+-- value.
+data Filter
+  = NoFilter
+  | Filter {mapFilter :: Rule, arrayFilter :: Rule}
+  deriving Show
+
+-- | A tree of possible expansions of a rule matching the size of a container to
+-- validate. This tree contains filters at each node, such that we can
+-- short-circuit the branch.
+--
+-- Note that, for simplicity's sake, the gates do not actually consume tokens,
+-- so once we reach a leaf we must match it entire against the input.
+--
+-- The leaves of an expansion tree may be of different lengths until we merge
+-- them.
+data ExpansionTree' r
+  = -- | A leaf represents the full sequence of rules which must be matched
+    Leaf r
+  | -- | Multiple possibilities for matching
+    Branch [ExpansionTree' r]
+  | -- | Set of possibilities guarded by a filter
+    FilterBranch Filter (ExpansionTree' r)
+  deriving (Functor, Show)
+
+-- | Merge trees
+--
+-- We merge from the left, folding a copy of the second tree into each interior
+-- node in the first.
+mergeTrees :: [ExpansionTree] -> ExpansionTree
+mergeTrees [] = Branch []
+mergeTrees (a : as) = foldl' go a as
+  where
+    go (Leaf xs) b = prependRules xs b
+    go (Branch xs) b = Branch $ fmap (flip go b) xs
+    go (FilterBranch f x) b = FilterBranch f $ go x b
+
+-- | Clamp a tree to contain only expressions with a fixed number of elements.
+clampTree :: Int -> ExpansionTree -> ExpansionTree
+clampTree sz a = maybe (Branch []) id (go a)
+  where
+    go l@(Leaf x) = if length x == sz then Just l else Nothing
+    go (Branch xs) = case catMaybes (go <$> xs) of
+      [] -> Nothing
+      ys -> Just $ Branch ys
+    go (FilterBranch f x) = FilterBranch f <$> go x
+
+type ExpansionTree = ExpansionTree' [Rule]
+
+prependRule :: Rule -> ExpansionTree -> ExpansionTree
+prependRule r t = (r :) <$> t
+
+-- | Prepend the given rules atop each leaf node in the tree
+prependRules :: [Rule] -> ExpansionTree -> ExpansionTree
+prependRules rs t = (rs <>) <$> t
+
+filterOn :: Rule -> Reader CDDL Filter
+filterOn rule =
+  getRule rule >>= \case
+    KV k v _ -> pure $ Filter k v
+    _ -> pure NoFilter
+
 -- | Expand rules to reach exactly the wanted length, which must be the number
 -- of items in the container. For example, if we want to validate 3 elements,
 -- and we have the following CDDL:
 --
 -- > a = [* int, * bool]
 --
--- this will be expanded to `[int, int, int], [int, int, bool], [int, bool,
--- bool], [bool, bool, bool]`.
+-- this will be expanded to
+-- ```
+--                [int, int, bool]
+--          int
+--                [int, int, int]
+--    int
+--          bool
+--                [int, bool, bool]
+-- *
+--    bool
+--          [bool, bool, bool]
+--
+-- ```
 --
 -- Essentially the rules we will parse is the choice among the expansions of the
 -- original rules.
-expandRules :: Int -> [Rule] -> Reader CDDL [[Rule]]
+expandRules :: Int -> [Rule] -> Reader CDDL ExpansionTree
 expandRules remainingLen []
-  | remainingLen /= 0 = pure []
-expandRules _ [] = pure [[]]
+  | remainingLen /= 0 = pure $ Branch []
+expandRules _ [] = pure $ Branch []
 expandRules remainingLen _
-  | remainingLen < 0 = pure []
-  | remainingLen == 0 = pure [[]]
-expandRules remainingLen (x : xs) = do
-  y <- expandRule remainingLen x
-  concat
-    <$> mapM
-      ( \y' -> do
-          suffixes <- expandRules (remainingLen - length y') xs
-          pure [y' ++ ys' | ys' <- suffixes]
-      )
-      y
+  | remainingLen < 0 = pure $ Branch []
+  | remainingLen == 0 = pure $ Branch []
+expandRules remainingLen xs = do
+  ys <- traverse (expandRule remainingLen) xs
+  pure . clampTree remainingLen $ mergeTrees ys
 
-expandRule :: Int -> Rule -> Reader CDDL [[Rule]]
+expandRule :: Int -> Rule -> Reader CDDL ExpansionTree
 expandRule maxLen _
-  | maxLen < 0 = pure []
+  | maxLen < 0 = pure $ Branch []
 expandRule maxLen rule =
   getRule rule >>= \case
-    Occur o OIOptional -> pure $ [] : [[o] | maxLen > 0]
-    Occur o OIZeroOrMore -> ([] :) <$> expandRule maxLen (MIt (Occur o OIOneOrMore))
+    -- For an optional branch, there is no point including a separate filter
+    Occur o OIOptional -> pure $ Branch [Leaf [o] | maxLen > 0]
+    Occur o OIZeroOrMore -> do
+      f <- filterOn o
+      FilterBranch f <$> expandRule maxLen (MIt (Occur o OIOneOrMore))
     Occur o OIOneOrMore ->
       if maxLen > 0
-        then ([o] :) . map (o :) <$> expandRule (maxLen - 1) (MIt (Occur o OIOneOrMore))
-        else pure []
+        then do
+          f <- filterOn o
+          FilterBranch f . prependRule o <$> expandRule (maxLen - 1) (MIt (Occur o OIOneOrMore))
+        else pure $ Branch []
     Occur o (OIBounded low high) -> case (low, high) of
       (Nothing, Nothing) -> expandRule maxLen (MIt (Occur o OIZeroOrMore))
       (Just (fromIntegral -> low'), Nothing) ->
         if maxLen >= low'
-          then map (replicate low' o ++) <$> expandRule (maxLen - low') (MIt (Occur o OIZeroOrMore))
-          else pure []
+          then (prependRules $ replicate low' o) <$> expandRule (maxLen - low') (MIt (Occur o OIZeroOrMore))
+          else pure $ Branch []
       (Nothing, Just (fromIntegral -> high')) ->
-        pure [replicate n o | n <- [0 .. min maxLen high']]
+        pure $ Branch [Leaf $ replicate n o | n <- [0 .. min maxLen high']]
       (Just (fromIntegral -> low'), Just (fromIntegral -> high')) ->
         if maxLen >= low'
-          then pure [replicate n o | n <- [low' .. min maxLen high']]
-          else pure []
-    _ -> pure [[rule | maxLen > 0]]
+          then pure $ Branch [Leaf $ replicate n o | n <- [low' .. min maxLen high']]
+          else pure $ Branch []
+    _ -> pure $ Branch [Leaf [rule] | maxLen > 0]
 
 -- | Which rules are optional?
 isOptional :: MonadReader CDDL m => Rule -> m Bool
@@ -725,9 +799,9 @@ isOptional rule =
 validateListWithExpandedRules ::
   forall m.
   MonadReader CDDL m =>
-  [Term] -> [Rule] -> m [(Rule, CBORTermResult)]
+  NE.NonEmpty Term -> [Rule] -> m [(Rule, CBORTermResult)]
 validateListWithExpandedRules terms rules =
-  go (zip terms rules)
+  go (zip (NE.toList terms) rules)
   where
     go ::
       [(Term, Rule)] -> m [(Rule, CBORTermResult)]
@@ -751,26 +825,37 @@ validateListWithExpandedRules terms rules =
 validateExpandedList ::
   forall m.
   MonadReader CDDL m =>
-  [Term] ->
-  [[Rule]] ->
+  NE.NonEmpty Term ->
+  ExpansionTree ->
   m (Rule -> CDDLResult)
 validateExpandedList terms rules = go rules
   where
-    go :: [[Rule]] -> m (Rule -> CDDLResult)
-    go [] = pure $ \r -> ListExpansionFail r rules []
-    go (choice : choices) = do
+    go :: ExpansionTree -> m (Rule -> CDDLResult)
+    go (Leaf choice) =  do
       res <- validateListWithExpandedRules terms choice
       case res of
         [] -> pure Valid
         _ -> case last res of
           (_, CBORTermResult _ (Valid _)) -> pure Valid
-          _ ->
-            go choices
-              >>= ( \case
-                      Valid _ -> pure Valid
-                      ListExpansionFail _ _ errors -> pure $ \r -> ListExpansionFail r rules (res : errors)
-                  )
-                . ($ dummyRule)
+          _ -> pure $ \r -> ListExpansionFail r rules (Leaf res)
+    go (FilterBranch f x) = validateTerm (NE.head terms) (arrayFilter f) >>= \case
+      (CBORTermResult _ (Valid _)) -> go x
+      -- In this case we insert a leaf since we haven't actually validated the
+      -- subnodes.
+      err -> pure $ \r -> ListExpansionFail r rules $ FilterBranch f $ Leaf [(r, err)]
+    go (Branch xs) = goBranch xs
+
+    goBranch [] = pure $ \r -> ListExpansionFail r rules $ Branch []
+    goBranch (x:xs) = go x <&> ($ dummyRule) >>= \case
+      Valid _ -> pure Valid
+      ListExpansionFail _ _ errors -> prependBranchErrors errors <$> goBranch xs
+
+    prependBranchErrors errors res = case res dummyRule of
+      Valid _ ->  Valid
+      ListExpansionFail _ _ errors2 -> \r ->
+        ListExpansionFail r rules $ errors <> errors2
+
+
 
 validateList ::
   MonadReader CDDL m => [Term] -> Rule -> m CDDLResult
@@ -781,11 +866,11 @@ validateList terms rule =
       Array rules ->
         case terms of
           [] -> ifM (and <$> mapM isOptional rules) (pure Valid) (pure InvalidRule)
-          _ ->
+          t:ts ->
             ask >>= \cddl ->
               let sequencesOfRules =
                     runReader (expandRules (length terms) $ flattenGroup cddl rules) cddl
-               in validateExpandedList terms sequencesOfRules
+               in validateExpandedList (t NE.:| ts) sequencesOfRules
       Choice opts -> validateChoice (validateList terms) opts
       _ -> pure UnapplicableRule
 

From 6dc1c6f6cc731b91de85b1e28583a0eee4e50e81 Mon Sep 17 00:00:00 2001
From: Nicholas Clarke <nick@topos.org.uk>
Date: Mon, 30 Jun 2025 16:54:08 +0200
Subject: [PATCH 2/8] Compiling

---
 src/Codec/CBOR/Cuddle/CBOR/Validator.hs | 105 ++++++++++++++++--------
 1 file changed, 73 insertions(+), 32 deletions(-)

diff --git a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
index 7dc60b4..a6ae985 100644
--- a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
+++ b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
@@ -19,8 +19,9 @@ import Data.Bifunctor
 import Data.Bits hiding (And)
 import Data.ByteString qualified as BS
 import Data.ByteString.Lazy qualified as BSL
+import Data.Either (lefts, rights)
 import Data.Function ((&))
-import Data.Functor ((<&>), ($>))
+import Data.Functor ((<&>))
 import Data.Functor.Identity
 import Data.IntSet qualified as IS
 import Data.List.NonEmpty qualified as NE
@@ -662,7 +663,7 @@ flattenGroup cddl nodes =
 data Filter
   = NoFilter
   | Filter {mapFilter :: Rule, arrayFilter :: Rule}
-  deriving Show
+  deriving (Show)
 
 -- | A tree of possible expansions of a rule matching the size of a container to
 -- validate. This tree contains filters at each node, such that we can
@@ -694,6 +695,14 @@ mergeTrees (a : as) = foldl' go a as
     go (Branch xs) b = Branch $ fmap (flip go b) xs
     go (FilterBranch f x) b = FilterBranch f $ go x b
 
+-- | Merge two trees by adding them as choices at the top-level using the
+--  `Branch` constructor.
+mergeTopBranch :: ExpansionTree' a -> ExpansionTree' a -> ExpansionTree' a
+mergeTopBranch (Branch t1) (Branch t2) = Branch $ t1 <> t2
+mergeTopBranch (Branch t1) t2 = Branch (t1 <> [t2])
+mergeTopBranch t1 (Branch t2) = Branch (t1 : t2)
+mergeTopBranch t1 t2 = Branch [t1, t2]
+
 -- | Clamp a tree to contain only expressions with a fixed number of elements.
 clampTree :: Int -> ExpansionTree -> ExpansionTree
 clampTree sz a = maybe (Branch []) id (go a)
@@ -831,31 +840,31 @@ validateExpandedList ::
 validateExpandedList terms rules = go rules
   where
     go :: ExpansionTree -> m (Rule -> CDDLResult)
-    go (Leaf choice) =  do
+    go (Leaf choice) = do
       res <- validateListWithExpandedRules terms choice
       case res of
         [] -> pure Valid
         _ -> case last res of
           (_, CBORTermResult _ (Valid _)) -> pure Valid
           _ -> pure $ \r -> ListExpansionFail r rules (Leaf res)
-    go (FilterBranch f x) = validateTerm (NE.head terms) (arrayFilter f) >>= \case
-      (CBORTermResult _ (Valid _)) -> go x
-      -- In this case we insert a leaf since we haven't actually validated the
-      -- subnodes.
-      err -> pure $ \r -> ListExpansionFail r rules $ FilterBranch f $ Leaf [(r, err)]
+    go (FilterBranch f x) =
+      validateTerm (NE.head terms) (arrayFilter f) >>= \case
+        (CBORTermResult _ (Valid _)) -> go x
+        -- In this case we insert a leaf since we haven't actually validated the
+        -- subnodes.
+        err -> pure $ \r -> ListExpansionFail r rules $ FilterBranch f $ Leaf [(r, err)]
     go (Branch xs) = goBranch xs
 
     goBranch [] = pure $ \r -> ListExpansionFail r rules $ Branch []
-    goBranch (x:xs) = go x <&> ($ dummyRule) >>= \case
-      Valid _ -> pure Valid
-      ListExpansionFail _ _ errors -> prependBranchErrors errors <$> goBranch xs
+    goBranch (x : xs) =
+      go x <&> ($ dummyRule) >>= \case
+        Valid _ -> pure Valid
+        ListExpansionFail _ _ errors -> prependBranchErrors errors <$> goBranch xs
 
     prependBranchErrors errors res = case res dummyRule of
-      Valid _ ->  Valid
+      Valid _ -> Valid
       ListExpansionFail _ _ errors2 -> \r ->
-        ListExpansionFail r rules $ errors <> errors2
-
-
+        ListExpansionFail r rules $ mergeTopBranch errors errors2
 
 validateList ::
   MonadReader CDDL m => [Term] -> Rule -> m CDDLResult
@@ -866,7 +875,7 @@ validateList terms rule =
       Array rules ->
         case terms of
           [] -> ifM (and <$> mapM isOptional rules) (pure Valid) (pure InvalidRule)
-          t:ts ->
+          t : ts ->
             ask >>= \cddl ->
               let sequencesOfRules =
                     runReader (expandRules (length terms) $ flattenGroup cddl rules) cddl
@@ -877,6 +886,29 @@ validateList terms rule =
 --------------------------------------------------------------------------------
 -- Maps
 
+-- | Does the map comtain a key matching this rule?
+--
+-- If so, return the matching term. Otherwise, return the list of all the terms
+-- that failed to match
+containsMatchingKey ::
+  forall m.
+  MonadReader CDDL m =>
+  NE.NonEmpty (Term, Term) ->
+  Rule ->
+  m (Either [ANonMatchedItem] AMatchedItem)
+containsMatchingKey terms rule = do
+    let tryKey (k, v) = do
+          result <- validateTerm k rule
+          case result of
+            CBORTermResult _ (Valid _) -> pure $ Right (AMatchedItem k v rule)
+            CBORTermResult _ res -> pure $ Left (ANonMatchedItem k v [Left (rule, res)])
+
+    results <- traverse tryKey (NE.toList terms)
+    case rights results of
+      (m:_) -> pure $ Right m
+      [] -> pure $ Left $ lefts results
+
+
 validateMapWithExpandedRules ::
   forall m.
   MonadReader CDDL m =>
@@ -916,25 +948,34 @@ validateMapWithExpandedRules =
 validateExpandedMap ::
   forall m.
   MonadReader CDDL m =>
-  [(Term, Term)] ->
-  [[Rule]] ->
+  NE.NonEmpty (Term, Term) ->
+  ExpansionTree ->
   m (Rule -> CDDLResult)
 validateExpandedMap terms rules = go rules
   where
-    go :: [[Rule]] -> m (Rule -> CDDLResult)
-    go [] = pure $ \r -> MapExpansionFail r rules []
-    go (choice : choices) = do
-      res <- validateMapWithExpandedRules terms choice
+    go :: ExpansionTree -> m (Rule -> CDDLResult)
+    go (Leaf choice) = do
+      res <- validateMapWithExpandedRules (NE.toList terms) choice
       case res of
         (_, Nothing) -> pure Valid
-        (matches, Just notMatched) ->
-          go choices
-            >>= ( \case
-                    Valid _ -> pure Valid
-                    MapExpansionFail _ _ errors ->
-                      pure $ \r -> MapExpansionFail r rules ((matches, notMatched) : errors)
-                )
-              . ($ dummyRule)
+        (matches, Just notMatched) -> pure $ \r ->
+          MapExpansionFail r rules [(matches, notMatched)]
+    go (FilterBranch f x) =
+      containsMatchingKey terms (mapFilter f) >>= \case
+        Right _  -> go x
+        Left errs -> pure $ \r -> MapExpansionFail r rules $ ([], ) <$> errs
+    go (Branch xs) = goBranch xs
+
+    goBranch [] = pure $ \r -> MapExpansionFail r rules []
+    goBranch (x : xs) =
+      go x <&> ($ dummyRule) >>= \case
+        Valid _ -> pure Valid
+        MapExpansionFail _ _ errors -> prependBranchErrors errors <$> goBranch xs
+
+    prependBranchErrors errors res = case res dummyRule of
+      Valid _ -> Valid
+      MapExpansionFail _ _ errors2 -> \r ->
+        MapExpansionFail r rules $ errors <> errors2
 
 validateMap ::
   MonadReader CDDL m =>
@@ -946,11 +987,11 @@ validateMap terms rule =
       Map rules ->
         case terms of
           [] -> ifM (and <$> mapM isOptional rules) (pure Valid) (pure InvalidRule)
-          _ ->
+          x:xs ->
             ask >>= \cddl ->
               let sequencesOfRules =
                     runReader (expandRules (length terms) $ flattenGroup cddl rules) cddl
-               in validateExpandedMap terms sequencesOfRules
+               in validateExpandedMap (x NE.:| xs) sequencesOfRules
       Choice opts -> validateChoice (validateMap terms) opts
       _ -> pure UnapplicableRule
 

From 2c785ee1c7b7244ca6a310182e6678121cca9f18 Mon Sep 17 00:00:00 2001
From: Nicholas Clarke <nick@topos.org.uk>
Date: Wed, 2 Jul 2025 12:50:08 +0200
Subject: [PATCH 3/8] Formatting

---
 flake.lock                              | 24 ++++++++++++------------
 project.ncl                             |  6 +++---
 src/Codec/CBOR/Cuddle/CBOR/Validator.hs | 25 ++++++++++++-------------
 3 files changed, 27 insertions(+), 28 deletions(-)

diff --git a/flake.lock b/flake.lock
index cbf5a37..fc719d3 100644
--- a/flake.lock
+++ b/flake.lock
@@ -6,11 +6,11 @@
         "rust-analyzer-src": "rust-analyzer-src"
       },
       "locked": {
-        "lastModified": 1745303921,
-        "narHash": "sha256-zYucemS2QvJUR5GKJ/u3eZAoe82AKhcxMtNVZDERXsw=",
+        "lastModified": 1749105720,
+        "narHash": "sha256-R3mjXc+LF74COXMDfJLuKEUPliXqOqe0wgErgTOFovI=",
         "owner": "nix-community",
         "repo": "fenix",
-        "rev": "14850d5984f3696a2972f85f19085e5fb46daa95",
+        "rev": "fd217600040e0e7c7ea844af027f3dc1f4b35e6c",
         "type": "github"
       },
       "original": {
@@ -55,11 +55,11 @@
     },
     "nixpkgs": {
       "locked": {
-        "lastModified": 1744932701,
-        "narHash": "sha256-fusHbZCyv126cyArUwwKrLdCkgVAIaa/fQJYFlCEqiU=",
+        "lastModified": 1748929857,
+        "narHash": "sha256-lcZQ8RhsmhsK8u7LIFsJhsLh/pzR9yZ8yqpTzyGdj+Q=",
         "owner": "nixos",
         "repo": "nixpkgs",
-        "rev": "b024ced1aac25639f8ca8fdfc2f8c4fbd66c48ef",
+        "rev": "c2a03962b8e24e669fb37b7df10e7c79531ff1a4",
         "type": "github"
       },
       "original": {
@@ -71,11 +71,11 @@
     },
     "nixpkgs_2": {
       "locked": {
-        "lastModified": 1744932701,
-        "narHash": "sha256-fusHbZCyv126cyArUwwKrLdCkgVAIaa/fQJYFlCEqiU=",
+        "lastModified": 1748929857,
+        "narHash": "sha256-lcZQ8RhsmhsK8u7LIFsJhsLh/pzR9yZ8yqpTzyGdj+Q=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "b024ced1aac25639f8ca8fdfc2f8c4fbd66c48ef",
+        "rev": "c2a03962b8e24e669fb37b7df10e7c79531ff1a4",
         "type": "github"
       },
       "original": {
@@ -129,11 +129,11 @@
     "rust-analyzer-src": {
       "flake": false,
       "locked": {
-        "lastModified": 1745247864,
-        "narHash": "sha256-QA1Ba8Flz5K+0GbG03HwiX9t46mh/jjKgwavbuKtwMg=",
+        "lastModified": 1749033758,
+        "narHash": "sha256-Ie003Weeg3Lsly9QuFJtw8W1JXnxoYD3FeV9KIxE+Ss=",
         "owner": "rust-lang",
         "repo": "rust-analyzer",
-        "rev": "31dbec70c68e97060916d4754c687a3e93c2440f",
+        "rev": "55b733103efa59f3504e308629b59d49da69bd9a",
         "type": "github"
       },
       "original": {
diff --git a/project.ncl b/project.ncl
index 0e16988..82889ed 100644
--- a/project.ncl
+++ b/project.ncl
@@ -10,8 +10,8 @@ let shellFor = fun ghcver =>
       haskell-language-server = hspkg "haskell-language-server",
       fourmolu = hspkg "fourmolu",
       ghc = organist.import_nix "nixpkgs#haskell.compiler.%{ghcver}",
-      cabal-install = hspkg "cabal-install",
-      cabal-fmt = hspkg "cabal-fmt",
+      # cabal-install = hspkg "cabal-install",
+      # cabal-fmt = hspkg "cabal-fmt",
       cddl = organist.import_nix "nixpkgs#cddl",
     },
   } in
@@ -24,7 +24,7 @@ let shellFor = fun ghcver =>
       packages = {},
     },
 
-    shells.dev = shellFor "ghc964",
+    shells.dev = shellFor "ghc912",
   }
 }
   | organist.OrganistExpression
diff --git a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
index a6ae985..791454e 100644
--- a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
+++ b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
@@ -897,17 +897,16 @@ containsMatchingKey ::
   Rule ->
   m (Either [ANonMatchedItem] AMatchedItem)
 containsMatchingKey terms rule = do
-    let tryKey (k, v) = do
-          result <- validateTerm k rule
-          case result of
-            CBORTermResult _ (Valid _) -> pure $ Right (AMatchedItem k v rule)
-            CBORTermResult _ res -> pure $ Left (ANonMatchedItem k v [Left (rule, res)])
-
-    results <- traverse tryKey (NE.toList terms)
-    case rights results of
-      (m:_) -> pure $ Right m
-      [] -> pure $ Left $ lefts results
+  let tryKey (k, v) = do
+        result <- validateTerm k rule
+        case result of
+          CBORTermResult _ (Valid _) -> pure $ Right (AMatchedItem k v rule)
+          CBORTermResult _ res -> pure $ Left (ANonMatchedItem k v [Left (rule, res)])
 
+  results <- traverse tryKey (NE.toList terms)
+  case rights results of
+    (m : _) -> pure $ Right m
+    [] -> pure $ Left $ lefts results
 
 validateMapWithExpandedRules ::
   forall m.
@@ -962,8 +961,8 @@ validateExpandedMap terms rules = go rules
           MapExpansionFail r rules [(matches, notMatched)]
     go (FilterBranch f x) =
       containsMatchingKey terms (mapFilter f) >>= \case
-        Right _  -> go x
-        Left errs -> pure $ \r -> MapExpansionFail r rules $ ([], ) <$> errs
+        Right _ -> go x
+        Left errs -> pure $ \r -> MapExpansionFail r rules $ ([],) <$> errs
     go (Branch xs) = goBranch xs
 
     goBranch [] = pure $ \r -> MapExpansionFail r rules []
@@ -987,7 +986,7 @@ validateMap terms rule =
       Map rules ->
         case terms of
           [] -> ifM (and <$> mapM isOptional rules) (pure Valid) (pure InvalidRule)
-          x:xs ->
+          x : xs ->
             ask >>= \cddl ->
               let sequencesOfRules =
                     runReader (expandRules (length terms) $ flattenGroup cddl rules) cddl

From f8d86feee9657eca45a763f9fa1b0d6791a35f7b Mon Sep 17 00:00:00 2001
From: Nicholas Clarke <nick@topos.org.uk>
Date: Mon, 7 Jul 2025 18:33:49 +0200
Subject: [PATCH 4/8] WIP Validator tree

---
 cuddle.cabal                                  |  3 +
 src/Codec/CBOR/Cuddle/CBOR/Validator.hs       | 30 ++++++---
 test/Main.hs                                  |  2 +
 test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs | 61 +++++++++++++++++++
 4 files changed, 86 insertions(+), 10 deletions(-)
 create mode 100644 test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs

diff --git a/cuddle.cabal b/cuddle.cabal
index aadaecc..4c148e3 100644
--- a/cuddle.cabal
+++ b/cuddle.cabal
@@ -139,6 +139,7 @@ test-suite cuddle-test
     Test.Codec.CBOR.Cuddle.CDDL.Gen
     Test.Codec.CBOR.Cuddle.CDDL.Parser
     Test.Codec.CBOR.Cuddle.CDDL.Pretty
+    Test.Codec.CBOR.Cuddle.CBOR.Validator
     Test.Codec.CBOR.Cuddle.Huddle
 
   type: exitcode-stdio-1.0
@@ -149,11 +150,13 @@ test-suite cuddle-test
     QuickCheck ^>=2.15,
     base,
     bytestring,
+    containers,
     cuddle,
     data-default-class,
     hspec ^>=2.11,
     hspec-megaparsec ^>=2.2,
     megaparsec,
+    mtl ^>=2.3.1,
     prettyprinter,
     string-qq ^>=0.0.6,
     text,
diff --git a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
index 791454e..3f94fc5 100644
--- a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
+++ b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
@@ -35,6 +35,7 @@ import System.Exit
 import System.IO
 import Text.Regex.TDFA
 
+import Debug.Trace (traceShow, traceShowM )
 type CDDL = CTreeRoot' Identity MonoRef
 type Rule = Node MonoRef
 type ResolvedRule = CTree MonoRef
@@ -661,8 +662,8 @@ flattenGroup cddl nodes =
 -- key, which can be in any position. For arrays, we filter based on the first
 -- value.
 data Filter
-  = NoFilter
-  | Filter {mapFilter :: Rule, arrayFilter :: Rule}
+  = ArrayFilter { arrayFilter :: Rule }
+  | MapFilter {mapFilter :: Rule, arrayFilter :: Rule}
   deriving (Show)
 
 -- | A tree of possible expansions of a rule matching the size of a container to
@@ -725,8 +726,8 @@ prependRules rs t = (rs <>) <$> t
 filterOn :: Rule -> Reader CDDL Filter
 filterOn rule =
   getRule rule >>= \case
-    KV k v _ -> pure $ Filter k v
-    _ -> pure NoFilter
+    KV k v _ -> pure $ MapFilter k v
+    _ -> pure $ ArrayFilter rule
 
 -- | Expand rules to reach exactly the wanted length, which must be the number
 -- of items in the container. For example, if we want to validate 3 elements,
@@ -750,6 +751,9 @@ filterOn rule =
 --
 -- Essentially the rules we will parse is the choice among the expansions of the
 -- original rules.
+--
+-- Important: the "rules" here are the various elements of a list,
+-- not true top-level rules.
 expandRules :: Int -> [Rule] -> Reader CDDL ExpansionTree
 expandRules remainingLen []
   | remainingLen /= 0 = pure $ Branch []
@@ -758,14 +762,14 @@ expandRules remainingLen _
   | remainingLen < 0 = pure $ Branch []
   | remainingLen == 0 = pure $ Branch []
 expandRules remainingLen xs = do
-  ys <- traverse (expandRule remainingLen) xs
-  pure . clampTree remainingLen $ mergeTrees ys
+  ys <- traceShow ("xs", xs) $ traverse (expandRule remainingLen) xs
+  traceShow ("ys:", ys) $ pure . clampTree remainingLen $ mergeTrees ys
 
 expandRule :: Int -> Rule -> Reader CDDL ExpansionTree
 expandRule maxLen _
   | maxLen < 0 = pure $ Branch []
 expandRule maxLen rule =
-  getRule rule >>= \case
+  traceShow (maxLen, rule) $ getRule rule >>= \case
     -- For an optional branch, there is no point including a separate filter
     Occur o OIOptional -> pure $ Branch [Leaf [o] | maxLen > 0]
     Occur o OIZeroOrMore -> do
@@ -960,9 +964,15 @@ validateExpandedMap terms rules = go rules
         (matches, Just notMatched) -> pure $ \r ->
           MapExpansionFail r rules [(matches, notMatched)]
     go (FilterBranch f x) =
-      containsMatchingKey terms (mapFilter f) >>= \case
-        Right _ -> go x
-        Left errs -> pure $ \r -> MapExpansionFail r rules $ ([],) <$> errs
+      case f of
+        MapFilter kf _ ->
+          containsMatchingKey terms kf >>= \case
+            Right _ -> go x
+            Left errs -> pure $ \r -> MapExpansionFail r rules $ ([],) <$> errs
+        ArrayFilter _ ->
+          -- We cannot really work with this. Ignore the filter and let the code
+          -- below blow up when it tries to match a map with an array
+          go x
     go (Branch xs) = goBranch xs
 
     goBranch [] = pure $ \r -> MapExpansionFail r rules []
diff --git a/test/Main.hs b/test/Main.hs
index cecc028..9512958 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -2,6 +2,7 @@ module Main (main) where
 
 import System.IO (BufferMode (..), hSetBuffering, hSetEncoding, stdout, utf8)
 import Test.Codec.CBOR.Cuddle.CDDL.Examples qualified as Examples
+import Test.Codec.CBOR.Cuddle.CBOR.Validator (cborValidatorSpec)
 import Test.Codec.CBOR.Cuddle.CDDL.Parser (parserSpec)
 import Test.Codec.CBOR.Cuddle.Huddle (huddleSpec)
 import Test.Hspec
@@ -21,3 +22,4 @@ main = do
     describe "cddlParser" parserSpec
     describe "Huddle" huddleSpec
     describe "Examples" Examples.spec
+    describe "CBOR Validation" cborValidatorSpec
diff --git a/test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs b/test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs
new file mode 100644
index 0000000..db357e8
--- /dev/null
+++ b/test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Test.Codec.CBOR.Cuddle.CBOR.Validator where
+
+import Test.Hspec
+import qualified Codec.CBOR.Cuddle.CBOR.Validator as CV
+import Codec.CBOR.Cuddle.Huddle
+import Codec.CBOR.Cuddle.CDDL (Name)
+import Codec.CBOR.Cuddle.CDDL.Resolve (MonoRef(MIt), fullResolveCDDL)
+import Control.Monad.Reader
+import Codec.CBOR.Cuddle.CDDL.CTree
+import Data.Functor.Identity
+import Data.Map.Strict qualified as Map
+
+cborValidatorSpec :: Spec
+cborValidatorSpec = do
+  expandRuleSpec
+
+expandRuleSpec :: Spec
+expandRuleSpec = describe "Expand Rule should generate appropriate expansion trees" $ do
+    it "should expand a simple rule" $ do
+          -- Test expanding a rule [* int, * bool]
+          -- Should generate an expansion tree that allows:
+          -- - Zero or more integers followed by zero or more booleans
+          -- - Each element can appear 0 to unbounded times
+          -- - The total length, however, must be 3
+          let rule = arr [0 <+ a VInt, 0 <+ a VBool]
+              expandedRules = withHuddleRule ["test" =:= rule] "test" $
+                CV.expandRules 3
+          print $ expandedRules
+          -- length expandedRules `shouldBe` 1
+          -- -- The expansion should contain branches for different combinations
+          -- -- of integers and booleans in the array
+          -- case expandedRules of
+          --   [tree] -> do
+          --     -- Check that the tree has the expected structure for repeated elements
+          --     tree `shouldSatisfy` (\t -> case t of
+          --       CV.Branch [] -> True
+          --       _ -> False)
+            -- _ -> expectationFailure "Expected exactly one expansion tree"
+    it "should expand a rule with choices" $ do
+      pending
+    it "should expand a rule with groups" $ do
+      pending
+    it "should handle optional elements" $ do
+      pending
+
+--------------------------------------------------------------------------------
+-- Utility
+--
+
+withHuddleRule :: Huddle -> Name -> ([CV.Rule] -> Reader CV.CDDL a) -> a
+withHuddleRule hdl n rdr = runReader (rdr groupProductions) cddl
+  where
+    cddl@(CTreeRoot tree) = case fullResolveCDDL (toCDDLNoRoot hdl) of
+      Left e -> error $ show e
+      Right c -> c
+    groupProductions = case runIdentity $ tree Map.! n of
+      MIt (Array elts) -> elts
+      MIt (Map elts) -> elts
+      _ -> error "Rule does not identify an array or map"

From d48244a282c63144c091d4f2f4f2f88839a9ae35 Mon Sep 17 00:00:00 2001
From: Nicholas Clarke <nick@topos.org.uk>
Date: Tue, 8 Jul 2025 13:09:47 +0200
Subject: [PATCH 5/8] WIP Validator trees

---
 src/Codec/CBOR/Cuddle/CBOR/Validator.hs       | 109 ++++++++++--------
 src/Codec/CBOR/Cuddle/CDDL/CTree.hs           |   3 +
 src/Codec/CBOR/Cuddle/CDDL/Resolve.hs         |   4 +-
 test/Main.hs                                  |   2 +-
 test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs |  84 +++++++++-----
 5 files changed, 117 insertions(+), 85 deletions(-)

diff --git a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
index 3f94fc5..749ca5f 100644
--- a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
+++ b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
@@ -35,7 +35,8 @@ import System.Exit
 import System.IO
 import Text.Regex.TDFA
 
-import Debug.Trace (traceShow, traceShowM )
+import Debug.Trace (traceShow, traceShowId)
+
 type CDDL = CTreeRoot' Identity MonoRef
 type Rule = Node MonoRef
 type ResolvedRule = CTree MonoRef
@@ -64,7 +65,7 @@ data CDDLResult
       -- | List of expansions of rules
       ExpansionTree
       -- | For each expansion, for each of the rules in the expansion, the result
-      (ExpansionTree' [(Rule, CBORTermResult)])
+      (ExpansionTree' (Rule, CBORTermResult))
   | -- | All expansions failed
     --
     -- An expansion is: Given a CBOR @TMap@ of @N@ elements, we will expand the
@@ -661,10 +662,10 @@ flattenGroup cddl nodes =
 -- contenxt in which this expansion is used. For maps, we filter based on the
 -- key, which can be in any position. For arrays, we filter based on the first
 -- value.
-data Filter
-  = ArrayFilter { arrayFilter :: Rule }
-  | MapFilter {mapFilter :: Rule, arrayFilter :: Rule}
-  deriving (Show)
+data Filter r
+  = ArrayFilter {arrayFilter :: r}
+  | MapFilter {mapFilter :: r, arrayFilter :: r}
+  deriving (Eq, Functor, Show)
 
 -- | A tree of possible expansions of a rule matching the size of a container to
 -- validate. This tree contains filters at each node, such that we can
@@ -677,20 +678,20 @@ data Filter
 -- them.
 data ExpansionTree' r
   = -- | A leaf represents the full sequence of rules which must be matched
-    Leaf r
+    Leaf [r]
   | -- | Multiple possibilities for matching
     Branch [ExpansionTree' r]
   | -- | Set of possibilities guarded by a filter
-    FilterBranch Filter (ExpansionTree' r)
-  deriving (Functor, Show)
+    FilterBranch (Filter r) (ExpansionTree' r)
+  deriving (Eq, Show)
 
 -- | Merge trees
 --
 -- We merge from the left, folding a copy of the second tree into each interior
 -- node in the first.
-mergeTrees :: [ExpansionTree] -> ExpansionTree
+mergeTrees :: [ExpansionTree' a] -> ExpansionTree' a
 mergeTrees [] = Branch []
-mergeTrees (a : as) = foldl' go a as
+mergeTrees (a : as) = Branch [a, foldl' go a as]
   where
     go (Leaf xs) b = prependRules xs b
     go (Branch xs) b = Branch $ fmap (flip go b) xs
@@ -714,16 +715,20 @@ clampTree sz a = maybe (Branch []) id (go a)
       ys -> Just $ Branch ys
     go (FilterBranch f x) = FilterBranch f <$> go x
 
-type ExpansionTree = ExpansionTree' [Rule]
+type ExpansionTree = ExpansionTree' Rule
 
-prependRule :: Rule -> ExpansionTree -> ExpansionTree
-prependRule r t = (r :) <$> t
+-- | Prepend a rule at all leaf nodes
+prependRule :: a -> ExpansionTree' a -> ExpansionTree' a
+prependRule r = prependRules [r]
 
 -- | Prepend the given rules atop each leaf node in the tree
-prependRules :: [Rule] -> ExpansionTree -> ExpansionTree
-prependRules rs t = (rs <>) <$> t
+prependRules :: [r] -> ExpansionTree' r -> ExpansionTree' r
+prependRules rs t = case t of
+  Leaf a -> Leaf $ rs <> a
+  Branch xs -> Branch $ fmap (prependRules rs) xs
+  FilterBranch f x -> FilterBranch f $ prependRules rs x
 
-filterOn :: Rule -> Reader CDDL Filter
+filterOn :: Rule -> Reader CDDL (Filter Rule)
 filterOn rule =
   getRule rule >>= \case
     KV k v _ -> pure $ MapFilter k v
@@ -762,38 +767,42 @@ expandRules remainingLen _
   | remainingLen < 0 = pure $ Branch []
   | remainingLen == 0 = pure $ Branch []
 expandRules remainingLen xs = do
-  ys <- traceShow ("xs", xs) $ traverse (expandRule remainingLen) xs
-  traceShow ("ys:", ys) $ pure . clampTree remainingLen $ mergeTrees ys
-
-expandRule :: Int -> Rule -> Reader CDDL ExpansionTree
-expandRule maxLen _
-  | maxLen < 0 = pure $ Branch []
-expandRule maxLen rule =
-  traceShow (maxLen, rule) $ getRule rule >>= \case
-    -- For an optional branch, there is no point including a separate filter
-    Occur o OIOptional -> pure $ Branch [Leaf [o] | maxLen > 0]
-    Occur o OIZeroOrMore -> do
-      f <- filterOn o
-      FilterBranch f <$> expandRule maxLen (MIt (Occur o OIOneOrMore))
-    Occur o OIOneOrMore ->
-      if maxLen > 0
-        then do
-          f <- filterOn o
-          FilterBranch f . prependRule o <$> expandRule (maxLen - 1) (MIt (Occur o OIOneOrMore))
-        else pure $ Branch []
-    Occur o (OIBounded low high) -> case (low, high) of
-      (Nothing, Nothing) -> expandRule maxLen (MIt (Occur o OIZeroOrMore))
-      (Just (fromIntegral -> low'), Nothing) ->
-        if maxLen >= low'
-          then (prependRules $ replicate low' o) <$> expandRule (maxLen - low') (MIt (Occur o OIZeroOrMore))
-          else pure $ Branch []
-      (Nothing, Just (fromIntegral -> high')) ->
-        pure $ Branch [Leaf $ replicate n o | n <- [0 .. min maxLen high']]
-      (Just (fromIntegral -> low'), Just (fromIntegral -> high')) ->
-        if maxLen >= low'
-          then pure $ Branch [Leaf $ replicate n o | n <- [low' .. min maxLen high']]
-          else pure $ Branch []
-    _ -> pure $ Branch [Leaf [rule] | maxLen > 0]
+  ys <- traceShow ("xs", xs) $ traverse (\a -> expandRule remainingLen a []) xs
+  let ms = traceShowId $ mergeTrees ys
+  traceShow ("ys:", ys) $ pure . clampTree remainingLen $ ms
+
+expandRule :: Int -> Rule -> [Rule] -> Reader CDDL ExpansionTree
+expandRule maxLen _ acc
+  | maxLen <= 0 = pure $ Leaf $ reverse acc
+expandRule maxLen rule acc =
+  traceShow (maxLen, rule) $
+    getRule rule >>= \case
+      -- For an optional branch, there is no point including a separate filter
+      Occur o OIOptional -> pure $ Branch [Leaf [o] | maxLen > 0]
+      Occur o OIZeroOrMore -> do
+        f <- filterOn o
+        FilterBranch f <$> expandRule maxLen (MIt (Occur o OIOneOrMore)) (o : acc)
+      Occur o OIOneOrMore ->
+        if maxLen > 0
+          then do
+            f <- filterOn o
+            FilterBranch f . prependRule o <$> expandRule (maxLen - 1) (MIt (Occur o OIOneOrMore)) (o : acc)
+          else pure $ Leaf acc
+      Occur o (OIBounded low high) -> case (low, high) of
+        (Nothing, Nothing) -> expandRule maxLen (MIt (Occur o OIZeroOrMore)) (o : acc)
+        (Just (fromIntegral -> low'), Nothing) ->
+          if maxLen >= low'
+            then
+              (prependRules $ replicate low' o)
+                <$> expandRule (maxLen - low') (MIt (Occur o OIZeroOrMore)) (o : acc)
+            else pure $ Leaf acc
+        (Nothing, Just (fromIntegral -> high')) ->
+          pure $ Branch [Leaf $ replicate n o <> acc | n <- [0 .. min maxLen high']]
+        (Just (fromIntegral -> low'), Just (fromIntegral -> high')) ->
+          if maxLen >= low'
+            then pure $ Branch [Leaf $ replicate n o <> acc | n <- [low' .. min maxLen high']]
+            else pure $ Leaf acc
+      _ -> pure . Leaf . reverse $ rule : acc
 
 -- | Which rules are optional?
 isOptional :: MonadReader CDDL m => Rule -> m Bool
@@ -856,7 +865,7 @@ validateExpandedList terms rules = go rules
         (CBORTermResult _ (Valid _)) -> go x
         -- In this case we insert a leaf since we haven't actually validated the
         -- subnodes.
-        err -> pure $ \r -> ListExpansionFail r rules $ FilterBranch f $ Leaf [(r, err)]
+        err -> pure $ \r -> ListExpansionFail r rules $ FilterBranch ((,err) <$> f) $ Leaf [(r, err)]
     go (Branch xs) = goBranch xs
 
     goBranch [] = pure $ \r -> ListExpansionFail r rules $ Branch []
diff --git a/src/Codec/CBOR/Cuddle/CDDL/CTree.hs b/src/Codec/CBOR/Cuddle/CDDL/CTree.hs
index 176c147..0765771 100644
--- a/src/Codec/CBOR/Cuddle/CDDL/CTree.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL/CTree.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module Codec.CBOR.Cuddle.CDDL.CTree where
 
@@ -46,6 +47,8 @@ data CTree f
   | Tag Word64 (Node f)
   deriving (Generic)
 
+deriving instance Eq (Node f) => Eq (CTree f)
+
 -- | Traverse the CTree, carrying out the given operation at each node
 traverseCTree :: Monad m => (Node f -> m (Node g)) -> CTree f -> m (CTree g)
 traverseCTree _ (Literal a) = pure $ Literal a
diff --git a/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs b/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
index 96a0f9a..0e5a72f 100644
--- a/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
@@ -342,8 +342,6 @@ instance Hashable a => Hashable (DistRef a)
 
 deriving instance Show (CTree DistRef)
 
-deriving instance Eq (CTree DistRef)
-
 instance Hashable (CTree DistRef)
 
 deriving instance Show (CTreeRoot DistRef)
@@ -398,7 +396,7 @@ buildResolvedCTree (CTreeRoot ct) = CTreeRoot <$> traverse go ct
 data MonoRef a
   = MIt a
   | MRuleRef Name
-  deriving (Functor, Show)
+  deriving (Eq, Functor, Show)
 
 deriving instance Show (CTree MonoRef)
 
diff --git a/test/Main.hs b/test/Main.hs
index 9512958..d5a406e 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,8 +1,8 @@
 module Main (main) where
 
 import System.IO (BufferMode (..), hSetBuffering, hSetEncoding, stdout, utf8)
-import Test.Codec.CBOR.Cuddle.CDDL.Examples qualified as Examples
 import Test.Codec.CBOR.Cuddle.CBOR.Validator (cborValidatorSpec)
+import Test.Codec.CBOR.Cuddle.CDDL.Examples qualified as Examples
 import Test.Codec.CBOR.Cuddle.CDDL.Parser (parserSpec)
 import Test.Codec.CBOR.Cuddle.Huddle (huddleSpec)
 import Test.Hspec
diff --git a/test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs b/test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs
index db357e8..29bc725 100644
--- a/test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs
+++ b/test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs
@@ -1,49 +1,71 @@
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
+
 module Test.Codec.CBOR.Cuddle.CBOR.Validator where
 
-import Test.Hspec
-import qualified Codec.CBOR.Cuddle.CBOR.Validator as CV
-import Codec.CBOR.Cuddle.Huddle
+import Codec.CBOR.Cuddle.CBOR.Validator qualified as CV
 import Codec.CBOR.Cuddle.CDDL (Name)
-import Codec.CBOR.Cuddle.CDDL.Resolve (MonoRef(MIt), fullResolveCDDL)
-import Control.Monad.Reader
 import Codec.CBOR.Cuddle.CDDL.CTree
+import Codec.CBOR.Cuddle.CDDL.Resolve (MonoRef (MIt), fullResolveCDDL)
+import Codec.CBOR.Cuddle.Huddle
+import Control.Monad.Reader
 import Data.Functor.Identity
 import Data.Map.Strict qualified as Map
+import Test.Hspec
 
 cborValidatorSpec :: Spec
 cborValidatorSpec = do
+  utilitySpec
   expandRuleSpec
 
+utilitySpec :: Spec
+utilitySpec = describe "Utility functions should work" $ do
+  describe "mergeTrees" $ do
+    it "Should prepend things to a leaf" $
+      CV.mergeTrees @Bool [
+        CV.Leaf [True],
+        CV.Leaf [False]
+      ] `shouldBe` CV.Leaf [True, False]
+    it "Should should nest things" $
+      CV.mergeTrees @Bool [
+        CV.FilterBranch (CV.ArrayFilter True) (CV.Leaf [True, True]),
+        CV.FilterBranch (CV.ArrayFilter False) (CV.Leaf [False, False])
+      ] `shouldBe`
+      CV.Branch [
+        CV.FilterBranch (CV.ArrayFilter True)
+          (CV.FilterBranch (CV.ArrayFilter True) (CV.Leaf [True, True])),
+          CV.Branch [CV.FilterBranch (CV.ArrayFilter False) (CV.Leaf [True, True, False, False])]
+      ]
+
 expandRuleSpec :: Spec
 expandRuleSpec = describe "Expand Rule should generate appropriate expansion trees" $ do
-    it "should expand a simple rule" $ do
-          -- Test expanding a rule [* int, * bool]
-          -- Should generate an expansion tree that allows:
-          -- - Zero or more integers followed by zero or more booleans
-          -- - Each element can appear 0 to unbounded times
-          -- - The total length, however, must be 3
-          let rule = arr [0 <+ a VInt, 0 <+ a VBool]
-              expandedRules = withHuddleRule ["test" =:= rule] "test" $
-                CV.expandRules 3
-          print $ expandedRules
-          -- length expandedRules `shouldBe` 1
-          -- -- The expansion should contain branches for different combinations
-          -- -- of integers and booleans in the array
-          -- case expandedRules of
-          --   [tree] -> do
-          --     -- Check that the tree has the expected structure for repeated elements
-          --     tree `shouldSatisfy` (\t -> case t of
-          --       CV.Branch [] -> True
-          --       _ -> False)
-            -- _ -> expectationFailure "Expected exactly one expansion tree"
-    it "should expand a rule with choices" $ do
-      pending
-    it "should expand a rule with groups" $ do
-      pending
-    it "should handle optional elements" $ do
-      pending
+  it "should expand a simple rule" $ do
+    -- Test expanding a rule [* int, * bool]
+    -- Should generate an expansion tree that allows:
+    -- - Zero or more integers followed by zero or more booleans
+    -- - Each element can appear 0 to unbounded times
+    -- - The total length, however, must be 3
+    let rule = arr [0 <+ a VInt, 0 <+ a VBool]
+        expandedRules =
+          withHuddleRule ["test" =:= rule] "test" $
+            CV.expandRules 3
+    print $ expandedRules
+  -- length expandedRules `shouldBe` 1
+  -- -- The expansion should contain branches for different combinations
+  -- -- of integers and booleans in the array
+  -- case expandedRules of
+  --   [tree] -> do
+  --     -- Check that the tree has the expected structure for repeated elements
+  --     tree `shouldSatisfy` (\t -> case t of
+  --       CV.Branch [] -> True
+  --       _ -> False)
+  -- _ -> expectationFailure "Expected exactly one expansion tree"
+  it "should expand a rule with choices" $ do
+    pending
+  it "should expand a rule with groups" $ do
+    pending
+  it "should handle optional elements" $ do
+    pending
 
 --------------------------------------------------------------------------------
 -- Utility

From ec9d043c470c6c387b9e8b024c474d1a328c024a Mon Sep 17 00:00:00 2001
From: Nicholas Clarke <nick@topos.org.uk>
Date: Thu, 10 Jul 2025 09:16:19 +0200
Subject: [PATCH 6/8] Additional testing

---
 src/Codec/CBOR/Cuddle/CBOR/Validator.hs       |  8 +++-
 test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs | 37 +++++++++++++++----
 2 files changed, 36 insertions(+), 9 deletions(-)

diff --git a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
index 749ca5f..69f0976 100644
--- a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
+++ b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
@@ -689,9 +689,13 @@ data ExpansionTree' r
 --
 -- We merge from the left, folding a copy of the second tree into each interior
 -- node in the first.
+--
+-- The trees to be merged are the expansions of each item in the top-level
+-- group to be matched. Thus the resulting tree should match a group
+-- containing all the argument trees.
 mergeTrees :: [ExpansionTree' a] -> ExpansionTree' a
 mergeTrees [] = Branch []
-mergeTrees (a : as) = Branch [a, foldl' go a as]
+mergeTrees (a : as) = foldl' go a as
   where
     go (Leaf xs) b = prependRules xs b
     go (Branch xs) b = Branch $ fmap (flip go b) xs
@@ -706,7 +710,7 @@ mergeTopBranch t1 (Branch t2) = Branch (t1 : t2)
 mergeTopBranch t1 t2 = Branch [t1, t2]
 
 -- | Clamp a tree to contain only expressions with a fixed number of elements.
-clampTree :: Int -> ExpansionTree -> ExpansionTree
+clampTree :: Int -> ExpansionTree' a  -> ExpansionTree' a
 clampTree sz a = maybe (Branch []) id (go a)
   where
     go l@(Leaf x) = if length x == sz then Just l else Nothing
diff --git a/test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs b/test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs
index 29bc725..5104106 100644
--- a/test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs
+++ b/test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE OverloadedLists #-}
+
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 module Test.Codec.CBOR.Cuddle.CBOR.Validator where
 
@@ -26,16 +28,28 @@ utilitySpec = describe "Utility functions should work" $ do
         CV.Leaf [True],
         CV.Leaf [False]
       ] `shouldBe` CV.Leaf [True, False]
-    it "Should should nest things" $
+    it "Should nest things" $
       CV.mergeTrees @Bool [
-        CV.FilterBranch (CV.ArrayFilter True) (CV.Leaf [True, True]),
-        CV.FilterBranch (CV.ArrayFilter False) (CV.Leaf [False, False])
+        CV.FilterBranch (CV.ArrayFilter True) (CV.Leaf [True]),
+        CV.FilterBranch (CV.ArrayFilter False) (CV.Leaf [False])
       ] `shouldBe`
-      CV.Branch [
         CV.FilterBranch (CV.ArrayFilter True)
-          (CV.FilterBranch (CV.ArrayFilter True) (CV.Leaf [True, True])),
-          CV.Branch [CV.FilterBranch (CV.ArrayFilter False) (CV.Leaf [True, True, False, False])]
-      ]
+          (CV.FilterBranch (CV.ArrayFilter False) (CV.Leaf [True, False]))
+    it "Should work 2 levels deep" $
+      CV.mergeTrees @Bool [
+          F (AF True) (B [L [True], F (AF True) (L [True, True])]),
+          F (AF False) (B [L [False], F (AF False) (L [False, False])])
+      ] `shouldBe`
+      F (AF True) (B [
+          F (AF False) (B [L [True, False], F (AF False) (L [True, False, False])]),
+          F (AF True) (F (AF False) (B [L [True, True, False], F (AF False) (L [True, True, False, False])]))
+      ])
+  describe "clampTree" $ do
+    it "Should exclude too long possibilities" $
+      CV.clampTree 2 (L [1..10]) `shouldBe` B []
+    it "Should work within branches" $
+      CV.clampTree 2 (B [L [1,2], L [2,3,4], L [3,4]]) `shouldBe`
+        B [L [1,2], L [ 3,4]]
 
 expandRuleSpec :: Spec
 expandRuleSpec = describe "Expand Rule should generate appropriate expansion trees" $ do
@@ -81,3 +95,12 @@ withHuddleRule hdl n rdr = runReader (rdr groupProductions) cddl
       MIt (Array elts) -> elts
       MIt (Map elts) -> elts
       _ -> error "Rule does not identify an array or map"
+
+pattern F :: forall {r}. CV.Filter r -> CV.ExpansionTree' r -> CV.ExpansionTree' r
+pattern F f e = CV.FilterBranch f e
+pattern L :: forall {r}. [r] -> CV.ExpansionTree' r
+pattern L rs = CV.Leaf rs
+pattern B :: forall {r}. [CV.ExpansionTree' r] -> CV.ExpansionTree' r
+pattern B xs = CV.Branch xs
+pattern AF :: forall {r}. r -> CV.Filter r
+pattern AF f = CV.ArrayFilter f

From 4bf461a3a774ae2c7712683d4f6a18f1e066be0a Mon Sep 17 00:00:00 2001
From: Nicholas Clarke <nick@topos.org.uk>
Date: Fri, 11 Jul 2025 23:54:04 +0200
Subject: [PATCH 7/8] Rewrite 'expandRule`

This now operates correctly. Just need to test the validation with the
tree
---
 src/Codec/CBOR/Cuddle/CBOR/Validator.hs       | 142 ++++++++++++------
 test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs |  84 ++++++-----
 2 files changed, 141 insertions(+), 85 deletions(-)

diff --git a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
index 69f0976..ffc5cdb 100644
--- a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
+++ b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
@@ -13,7 +13,7 @@ import Codec.CBOR.Cuddle.CDDL.Resolve
 import Codec.CBOR.Read
 import Codec.CBOR.Term
 import Control.Exception
-import Control.Monad ((>=>))
+import Control.Monad ((>=>), join)
 import Control.Monad.Reader
 import Data.Bifunctor
 import Data.Bits hiding (And)
@@ -35,8 +35,6 @@ import System.Exit
 import System.IO
 import Text.Regex.TDFA
 
-import Debug.Trace (traceShow, traceShowId)
-
 type CDDL = CTreeRoot' Identity MonoRef
 type Rule = Node MonoRef
 type ResolvedRule = CTree MonoRef
@@ -701,6 +699,19 @@ mergeTrees (a : as) = foldl' go a as
     go (Branch xs) b = Branch $ fmap (flip go b) xs
     go (FilterBranch f x) b = FilterBranch f $ go x b
 
+-- | Normalise a tree
+--
+-- - Remove single node branches
+-- - Inline subbranches into higher branches
+normaliseTree :: ExpansionTree' a -> ExpansionTree' a
+normaliseTree (Branch [a]) = normaliseTree a
+normaliseTree (Branch xs) = Branch . join $ unwindBranches <$> xs
+  where
+    unwindBranches (Branch xs') = normaliseTree <$> xs'
+    unwindBranches a = [normaliseTree a]
+normaliseTree (FilterBranch f a) = FilterBranch f $ normaliseTree a
+normaliseTree a = a
+
 -- | Merge two trees by adding them as choices at the top-level using the
 --  `Branch` constructor.
 mergeTopBranch :: ExpansionTree' a -> ExpansionTree' a -> ExpansionTree' a
@@ -710,7 +721,7 @@ mergeTopBranch t1 (Branch t2) = Branch (t1 : t2)
 mergeTopBranch t1 t2 = Branch [t1, t2]
 
 -- | Clamp a tree to contain only expressions with a fixed number of elements.
-clampTree :: Int -> ExpansionTree' a  -> ExpansionTree' a
+clampTree :: Int -> ExpansionTree' a -> ExpansionTree' a
 clampTree sz a = maybe (Branch []) id (go a)
   where
     go l@(Leaf x) = if length x == sz then Just l else Nothing
@@ -719,12 +730,6 @@ clampTree sz a = maybe (Branch []) id (go a)
       ys -> Just $ Branch ys
     go (FilterBranch f x) = FilterBranch f <$> go x
 
-type ExpansionTree = ExpansionTree' Rule
-
--- | Prepend a rule at all leaf nodes
-prependRule :: a -> ExpansionTree' a -> ExpansionTree' a
-prependRule r = prependRules [r]
-
 -- | Prepend the given rules atop each leaf node in the tree
 prependRules :: [r] -> ExpansionTree' r -> ExpansionTree' r
 prependRules rs t = case t of
@@ -732,6 +737,8 @@ prependRules rs t = case t of
   Branch xs -> Branch $ fmap (prependRules rs) xs
   FilterBranch f x -> FilterBranch f $ prependRules rs x
 
+type ExpansionTree = ExpansionTree' Rule
+
 filterOn :: Rule -> Reader CDDL (Filter Rule)
 filterOn rule =
   getRule rule >>= \case
@@ -768,45 +775,86 @@ expandRules remainingLen []
   | remainingLen /= 0 = pure $ Branch []
 expandRules _ [] = pure $ Branch []
 expandRules remainingLen _
-  | remainingLen < 0 = pure $ Branch []
-  | remainingLen == 0 = pure $ Branch []
+  | remainingLen <= 0 = pure $ Branch []
 expandRules remainingLen xs = do
-  ys <- traceShow ("xs", xs) $ traverse (\a -> expandRule remainingLen a []) xs
-  let ms = traceShowId $ mergeTrees ys
-  traceShow ("ys:", ys) $ pure . clampTree remainingLen $ ms
-
-expandRule :: Int -> Rule -> [Rule] -> Reader CDDL ExpansionTree
-expandRule maxLen _ acc
-  | maxLen <= 0 = pure $ Leaf $ reverse acc
-expandRule maxLen rule acc =
-  traceShow (maxLen, rule) $
-    getRule rule >>= \case
-      -- For an optional branch, there is no point including a separate filter
-      Occur o OIOptional -> pure $ Branch [Leaf [o] | maxLen > 0]
-      Occur o OIZeroOrMore -> do
-        f <- filterOn o
-        FilterBranch f <$> expandRule maxLen (MIt (Occur o OIOneOrMore)) (o : acc)
-      Occur o OIOneOrMore ->
-        if maxLen > 0
-          then do
+  ys <- traverse (\a -> expandRule remainingLen a) xs
+  let ms = mergeTrees ys
+  pure . normaliseTree . clampTree remainingLen $ ms
+
+expandRule :: Int -> Rule -> Reader CDDL ExpansionTree
+expandRule = go []
+  where
+    go acc maxLen _ | maxLen <= 0 = pure $ Leaf $ reverse acc
+    go acc maxLen rule =
+      getRule rule >>= \case
+        Occur o OIOptional ->
+          -- If the rule is optional, then we have two cases - one just the acc,
+          -- and one with the new element as well. But there's little point guarding
+          -- that second branch with a filter.
+          pure $ Branch [Leaf (reverse $ o : acc), Leaf (reverse acc)]
+        Occur o OIZeroOrMore -> do
+          -- In the zero or more case, we allow the acc, and then another branch -
+          -- guarded by the element - which recurses decreasing the maxLen
+          rest <- go (o : acc) (maxLen - 1) rule
+          f <- filterOn o
+          pure $
+            Branch
+              [ FilterBranch f rest
+              , Leaf (reverse acc)
+              ]
+        Occur o OIOneOrMore -> do
+          -- In the one or more case, we filter directly on the element and then
+          -- recurse with a ZeroOrMore
+          f <- filterOn o
+          FilterBranch f <$> go (o : acc) (maxLen - 1) (MIt (Occur o OIZeroOrMore))
+        Occur o (OIBounded low high) -> case (low, high) of
+          (Nothing, Nothing) ->
+            -- This is basically the zero or more case again
+            go acc maxLen (MIt (Occur o OIZeroOrMore))
+          (Just (fromIntegral -> low'), Nothing) ->
+            -- We have a lower bound, so things must show up at least that number
+            -- of times.
+            if maxLen < low'
+              then
+                -- No way for this to work, so we yield an empty branch
+                pure $ Branch []
+              else do
+                -- We'll gate a single branch
+                let acc' = replicate low' o <> acc
+                f <- filterOn o
+                rest <- go acc' (maxLen - low') (MIt (Occur o OIZeroOrMore))
+                pure $ FilterBranch f rest
+          (Nothing, Just (fromIntegral -> high')) -> do
+            -- We have an upper bound but no lower bound. That's fine - we yield
+            -- a branch with just the acc and a branch where we consume one element
+            -- and decrease the upper bound.
+            rest <-
+              go
+                (o : acc)
+                (maxLen - 1)
+                (MIt (Occur o (OIBounded Nothing (Just $ high' - 1))))
             f <- filterOn o
-            FilterBranch f . prependRule o <$> expandRule (maxLen - 1) (MIt (Occur o OIOneOrMore)) (o : acc)
-          else pure $ Leaf acc
-      Occur o (OIBounded low high) -> case (low, high) of
-        (Nothing, Nothing) -> expandRule maxLen (MIt (Occur o OIZeroOrMore)) (o : acc)
-        (Just (fromIntegral -> low'), Nothing) ->
-          if maxLen >= low'
-            then
-              (prependRules $ replicate low' o)
-                <$> expandRule (maxLen - low') (MIt (Occur o OIZeroOrMore)) (o : acc)
-            else pure $ Leaf acc
-        (Nothing, Just (fromIntegral -> high')) ->
-          pure $ Branch [Leaf $ replicate n o <> acc | n <- [0 .. min maxLen high']]
-        (Just (fromIntegral -> low'), Just (fromIntegral -> high')) ->
-          if maxLen >= low'
-            then pure $ Branch [Leaf $ replicate n o <> acc | n <- [low' .. min maxLen high']]
-            else pure $ Leaf acc
-      _ -> pure . Leaf . reverse $ rule : acc
+            pure $
+              Branch
+                [ FilterBranch f rest
+                , Leaf (reverse acc)
+                ]
+          (Just (fromIntegral -> low'), Just (fromIntegral -> high')) -> do
+            -- Upper and lower bounds.
+            if maxLen < low'
+              then
+                -- No way for this to work, so we yield an empty branch
+                pure $ Branch []
+              else do
+                -- We'll gate a single branch
+                let acc' = replicate low' o <> acc
+                f <- filterOn o
+                rest <- go acc' (maxLen - low')
+                  (MIt (Occur o (OIBounded Nothing (Just $ high' - fromIntegral low'))))
+                pure $ FilterBranch f rest
+        _ ->
+          -- This is a rule without an occurence indicator, so it must be included
+          pure $ Leaf $ reverse (rule : acc)
 
 -- | Which rules are optional?
 isOptional :: MonadReader CDDL m => Rule -> m Bool
diff --git a/test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs b/test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs
index 5104106..013d069 100644
--- a/test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs
+++ b/test/Test/Codec/CBOR/Cuddle/CBOR/Validator.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE OverloadedLists #-}
-
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 
@@ -10,6 +9,7 @@ import Codec.CBOR.Cuddle.CDDL (Name)
 import Codec.CBOR.Cuddle.CDDL.CTree
 import Codec.CBOR.Cuddle.CDDL.Resolve (MonoRef (MIt), fullResolveCDDL)
 import Codec.CBOR.Cuddle.Huddle
+import Codec.CBOR.Cuddle.CDDL.Postlude (PTerm(PTInt, PTBool))
 import Control.Monad.Reader
 import Data.Functor.Identity
 import Data.Map.Strict qualified as Map
@@ -24,36 +24,48 @@ utilitySpec :: Spec
 utilitySpec = describe "Utility functions should work" $ do
   describe "mergeTrees" $ do
     it "Should prepend things to a leaf" $
-      CV.mergeTrees @Bool [
-        CV.Leaf [True],
-        CV.Leaf [False]
-      ] `shouldBe` CV.Leaf [True, False]
+      CV.mergeTrees @Bool
+        [ CV.Leaf [True]
+        , CV.Leaf [False]
+        ]
+        `shouldBe` CV.Leaf [True, False]
     it "Should nest things" $
-      CV.mergeTrees @Bool [
-        CV.FilterBranch (CV.ArrayFilter True) (CV.Leaf [True]),
-        CV.FilterBranch (CV.ArrayFilter False) (CV.Leaf [False])
-      ] `shouldBe`
-        CV.FilterBranch (CV.ArrayFilter True)
+      CV.mergeTrees @Bool
+        [ CV.FilterBranch (CV.ArrayFilter True) (CV.Leaf [True])
+        , CV.FilterBranch (CV.ArrayFilter False) (CV.Leaf [False])
+        ]
+        `shouldBe` CV.FilterBranch
+          (CV.ArrayFilter True)
           (CV.FilterBranch (CV.ArrayFilter False) (CV.Leaf [True, False]))
     it "Should work 2 levels deep" $
-      CV.mergeTrees @Bool [
-          F (AF True) (B [L [True], F (AF True) (L [True, True])]),
-          F (AF False) (B [L [False], F (AF False) (L [False, False])])
-      ] `shouldBe`
-      F (AF True) (B [
-          F (AF False) (B [L [True, False], F (AF False) (L [True, False, False])]),
-          F (AF True) (F (AF False) (B [L [True, True, False], F (AF False) (L [True, True, False, False])]))
-      ])
+      CV.mergeTrees @Bool
+        [ F (AF True) (B [L [True], F (AF True) (L [True, True])])
+        , F (AF False) (B [L [False], F (AF False) (L [False, False])])
+        ]
+        `shouldBe` F
+          (AF True)
+          ( B
+              [ F (AF False) (B [L [True, False], F (AF False) (L [True, False, False])])
+              , F (AF True) (F (AF False) (B [L [True, True, False], F (AF False) (L [True, True, False, False])]))
+              ]
+          )
   describe "clampTree" $ do
     it "Should exclude too long possibilities" $
-      CV.clampTree 2 (L [1..10]) `shouldBe` B []
+      CV.clampTree 2 (L [1  :: Int .. 10]) `shouldBe` B []
     it "Should work within branches" $
-      CV.clampTree 2 (B [L [1,2], L [2,3,4], L [3,4]]) `shouldBe`
-        B [L [1,2], L [ 3,4]]
+      CV.clampTree 2 (B [L [1 :: Int, 2], L [2, 3, 4], L [3, 4]])
+        `shouldBe` B [L [1, 2], L [3, 4]]
 
 expandRuleSpec :: Spec
 expandRuleSpec = describe "Expand Rule should generate appropriate expansion trees" $ do
   it "should expand a simple rule" $ do
+    let rule = arr [0 <+ a VInt]
+        expandedRules =
+          withHuddleRule ["test" =:= rule] "test" $
+            CV.expandRules 1
+    expandedRules `shouldBe`
+      F (AF (MIt (Postlude PTInt))) (L [MIt (Postlude PTInt)])
+  it "should expand a rule with multiple productions" $ do
     -- Test expanding a rule [* int, * bool]
     -- Should generate an expansion tree that allows:
     -- - Zero or more integers followed by zero or more booleans
@@ -63,23 +75,19 @@ expandRuleSpec = describe "Expand Rule should generate appropriate expansion tre
         expandedRules =
           withHuddleRule ["test" =:= rule] "test" $
             CV.expandRules 3
-    print $ expandedRules
-  -- length expandedRules `shouldBe` 1
-  -- -- The expansion should contain branches for different combinations
-  -- -- of integers and booleans in the array
-  -- case expandedRules of
-  --   [tree] -> do
-  --     -- Check that the tree has the expected structure for repeated elements
-  --     tree `shouldSatisfy` (\t -> case t of
-  --       CV.Branch [] -> True
-  --       _ -> False)
-  -- _ -> expectationFailure "Expected exactly one expansion tree"
-  it "should expand a rule with choices" $ do
-    pending
-  it "should expand a rule with groups" $ do
-    pending
-  it "should handle optional elements" $ do
-    pending
+        mI = (MIt (Postlude PTInt))
+        mB = (MIt (Postlude PTBool))
+    expandedRules `shouldBe`
+      B [
+          F (AF mI) (B [
+            F (AF mI) (B [
+              F (AF mI) (L [mI, mI, mI])
+            , F (AF mB) (L [mI, mI, mB])
+            ])
+          , F (AF mB) (F (AF mB) (L [mI, mB, mB]))
+          ])
+        , F (AF mB) (F (AF mB) (F (AF mB) (L [mB, mB, mB])))
+        ]
 
 --------------------------------------------------------------------------------
 -- Utility

From aaf3d1d098d1a9a170fce9c53ea9e14d0012cba4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Tue, 26 Aug 2025 17:06:26 +0300
Subject: [PATCH 8/8] Made the project compile on GHC-9.6.7

---
 project.ncl                             | 2 +-
 src/Codec/CBOR/Cuddle/CBOR/Validator.hs | 1 +
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/project.ncl b/project.ncl
index 82889ed..f608240 100644
--- a/project.ncl
+++ b/project.ncl
@@ -24,7 +24,7 @@ let shellFor = fun ghcver =>
       packages = {},
     },
 
-    shells.dev = shellFor "ghc912",
+    shells.dev = shellFor "ghc967",
   }
 }
   | organist.OrganistExpression
diff --git a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
index ffc5cdb..fbcaba4 100644
--- a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
+++ b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
@@ -34,6 +34,7 @@ import GHC.Float
 import System.Exit
 import System.IO
 import Text.Regex.TDFA
+import Data.Foldable (Foldable(..))
 
 type CDDL = CTreeRoot' Identity MonoRef
 type Rule = Node MonoRef