From 9c909bc3ebadcdc60f504da500221013beea698f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Mon, 6 Oct 2025 15:00:18 +0300
Subject: [PATCH 01/15] WIP

---
 cuddle.cabal                          |   1 -
 src/Codec/CBOR/Cuddle/CDDL.hs         | 102 ++++++++----
 src/Codec/CBOR/Cuddle/CDDL/CTree.hs   |  83 ----------
 src/Codec/CBOR/Cuddle/CDDL/Resolve.hs | 220 +++-----------------------
 4 files changed, 91 insertions(+), 315 deletions(-)
 delete mode 100644 src/Codec/CBOR/Cuddle/CDDL/CTree.hs

diff --git a/cuddle.cabal b/cuddle.cabal
index 63e7d0d..b813bc3 100644
--- a/cuddle.cabal
+++ b/cuddle.cabal
@@ -46,7 +46,6 @@ library
     Codec.CBOR.Cuddle.CBOR.Gen
     Codec.CBOR.Cuddle.CBOR.Validator
     Codec.CBOR.Cuddle.CDDL
-    Codec.CBOR.Cuddle.CDDL.CTree
     Codec.CBOR.Cuddle.CDDL.CtlOp
     Codec.CBOR.Cuddle.CDDL.Postlude
     Codec.CBOR.Cuddle.CDDL.Prelude
diff --git a/src/Codec/CBOR/Cuddle/CDDL.hs b/src/Codec/CBOR/Cuddle/CDDL.hs
index 173dc23..570493a 100644
--- a/src/Codec/CBOR/Cuddle/CDDL.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 -- | This module defined the data structure of CDDL as specified in
 --   https://datatracker.ietf.org/doc/rfc8610/
@@ -7,8 +9,6 @@ module Codec.CBOR.Cuddle.CDDL (
   CDDL (..),
   sortCDDL,
   cddlTopLevel,
-  cddlRules,
-  fromRules,
   fromRule,
   TopLevel (..),
   Name (..),
@@ -43,6 +43,7 @@ import Data.Function (on, (&))
 import Data.Hashable (Hashable)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.List.NonEmpty qualified as NE
+import Data.Maybe (mapMaybe)
 import Data.String (IsString (..))
 import Data.Text qualified as T
 import Data.TreeDiff (ToExpr)
@@ -52,47 +53,80 @@ import Optics.Core ((%), (.~))
 import Optics.Getter (view)
 import Optics.Lens (lens)
 
+type family TopLevelE i
+
+type family CDDLF i
+
 -- | The CDDL constructor takes three arguments:
 --     1. Top level comments that precede the first definition
 --     2. The root definition
 --     3. All the other top level comments and definitions
 --   This ensures that `CDDL` is correct by construction.
-data CDDL = CDDL [Comment] Rule [TopLevel]
-  deriving (Eq, Generic, Show, ToExpr)
+data CDDL i = CDDL
+  { rootDefinition :: Rule i
+  , topLevelDefinitions :: [TopLevel i]
+  , cddlExt :: CDDLF i
+  }
+  deriving (Generic)
+
+deriving instance
+  ( Eq (TopLevelE i)
+  , Eq (CDDLF i)
+  ) =>
+  Eq (CDDL i)
+
+deriving instance
+  ( Show (TopLevelE i)
+  , Show (CDDLF i)
+  ) =>
+  Show (CDDL i)
+
+deriving instance
+  ( ToExpr (TopLevelE i)
+  , ToExpr (CDDLF i)
+  ) =>
+  ToExpr (CDDL i)
+
+ruleTopLevel :: TopLevel i -> Maybe (Rule i)
+ruleTopLevel (TopLevelRule r) = Just r
+ruleTopLevel _ = Nothing
 
 -- | Sort the CDDL Rules on the basis of their names
--- Top level comments will be removed!
-sortCDDL :: CDDL -> CDDL
-sortCDDL = fromRules . NE.sortBy (compare `on` ruleName) . cddlRules
-
-cddlTopLevel :: CDDL -> NonEmpty TopLevel
-cddlTopLevel (CDDL cmts cHead cTail) =
-  prependList (TopLevelComment <$> cmts) $ TopLevelRule cHead :| cTail
-  where
-    prependList [] l = l
-    prependList (x : xs) (y :| ys) = prependList xs $ x :| (y : ys)
-
-cddlRules :: CDDL -> NonEmpty Rule
-cddlRules (CDDL _ x tls) = x :| concatMap getRule tls
+sortCDDL :: CDDL i -> NonEmpty (Rule i)
+sortCDDL (CDDL r rs _) = NE.sortBy (compare `on` ruleName) $ r :| mapMaybe ruleTopLevel rs
+
+cddlTopLevel ::
+  ( TopLevelE i ~ Comment
+  , CDDLF i ~ [Comment]
+  ) =>
+  CDDL i ->
+  NonEmpty (TopLevel i)
+cddlTopLevel (CDDL cHead cTail cmts) =
+  NE.prependList (TopLevelE <$> cmts) $ TopLevelRule cHead :| cTail
+
+fromRule :: Monoid (CDDLF i) => Rule i -> CDDL i
+fromRule x = CDDL x [] mempty
+
+instance
+  CDDLF i ~ [TopLevelE i] =>
+  Semigroup (CDDL i)
   where
-    getRule (TopLevelRule r) = [r]
-    getRule _ = mempty
+  CDDL aHead aTail aExt <> CDDL bHead bTail bExt =
+    CDDL
+      aHead
+      (aTail <> fmap TopLevelE bExt <> (TopLevelRule bHead : bTail))
+      aExt
 
-fromRules :: NonEmpty Rule -> CDDL
-fromRules (x :| xs) = CDDL [] x $ TopLevelRule <$> xs
+data TopLevel i
+  = TopLevelRule (Rule i)
+  | TopLevelE (TopLevelE i)
+  deriving (Generic)
 
-fromRule :: Rule -> CDDL
-fromRule x = CDDL [] x []
+deriving instance Eq (TopLevelE i) => Eq (TopLevel i)
 
-instance Semigroup CDDL where
-  CDDL aComments aHead aTail <> CDDL bComments bHead bTail =
-    CDDL aComments aHead $
-      aTail <> fmap TopLevelComment bComments <> (TopLevelRule bHead : bTail)
+deriving instance Show (TopLevelE i) => Show (TopLevel i)
 
-data TopLevel
-  = TopLevelRule Rule
-  | TopLevelComment Comment
-  deriving (Eq, Generic, Show, ToExpr)
+deriving instance ToExpr (TopLevelE i) => ToExpr (TopLevel i)
 
 -- |
 --  A name can consist of any of the characters from the set {"A" to
@@ -203,7 +237,7 @@ instance CollectComments GenericArg
 --   clear immediately either whether "b" stands for a group or a type --
 --   this semantic processing may need to span several levels of rule
 --   definitions before a determination can be made.)
-data Rule = Rule
+data Rule i = Rule
   { ruleName :: Name
   , ruleGenParam :: Maybe GenericParam
   , ruleAssign :: Assign
@@ -213,10 +247,10 @@ data Rule = Rule
   deriving (Eq, Generic, Show)
   deriving anyclass (ToExpr)
 
-instance HasComment Rule where
+instance HasComment (Rule i) where
   commentL = lens ruleComment (\x y -> x {ruleComment = y})
 
-compareRuleName :: Rule -> Rule -> Ordering
+compareRuleName :: Rule i -> Rule i -> Ordering
 compareRuleName = compare `on` ruleName
 
 -- |
diff --git a/src/Codec/CBOR/Cuddle/CDDL/CTree.hs b/src/Codec/CBOR/Cuddle/CDDL/CTree.hs
deleted file mode 100644
index 26963c6..0000000
--- a/src/Codec/CBOR/Cuddle/CDDL/CTree.hs
+++ /dev/null
@@ -1,83 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-
-module Codec.CBOR.Cuddle.CDDL.CTree where
-
-import Codec.CBOR.Cuddle.CDDL (
-  Name,
-  OccurrenceIndicator,
-  RangeBound,
-  Value,
- )
-import Codec.CBOR.Cuddle.CDDL.CtlOp
-import Codec.CBOR.Cuddle.CDDL.Postlude (PTerm)
-import Data.List.NonEmpty qualified as NE
-import Data.Map.Strict qualified as Map
-import Data.Word (Word64)
-import GHC.Generics (Generic)
-
---------------------------------------------------------------------------------
-
--- * Resolved CDDL Tree
-
---
--- This is a simplified representation of CDDL. It is technically more general -
--- that is, the structure can represent invalid CDDL - but is in that way easier
--- to manipulate.
---------------------------------------------------------------------------------
-
-type family CTreeExt i
-
-data CTree i
-  = Literal Value
-  | Postlude PTerm
-  | Map [CTree i]
-  | Array [CTree i]
-  | Choice (NE.NonEmpty (CTree i))
-  | Group [CTree i]
-  | KV {key :: CTree i, value :: CTree i, cut :: Bool}
-  | Occur {item :: CTree i, occurs :: OccurrenceIndicator}
-  | Range {from :: CTree i, to :: CTree i, inclusive :: RangeBound}
-  | Control {op :: CtlOp, target :: CTree i, controller :: CTree i}
-  | Enum (CTree i)
-  | Unwrap (CTree i)
-  | Tag Word64 (CTree i)
-  | CTreeE (CTreeExt i)
-  deriving (Generic)
-
-deriving instance Eq (Node f) => Eq (CTree f)
-
--- | Traverse the CTree, carrying out the given operation at each node
-traverseCTree ::
-  Monad m => (CTreeExt i -> m (CTree j)) -> (CTree i -> m (CTree j)) -> CTree i -> m (CTree j)
-traverseCTree _ _ (Literal a) = pure $ Literal a
-traverseCTree _ _ (Postlude a) = pure $ Postlude a
-traverseCTree _ atNode (Map xs) = Map <$> traverse atNode xs
-traverseCTree _ atNode (Array xs) = Array <$> traverse atNode xs
-traverseCTree _ atNode (Group xs) = Group <$> traverse atNode xs
-traverseCTree _ atNode (Choice xs) = Choice <$> traverse atNode xs
-traverseCTree _ atNode (KV k v c) = do
-  k' <- atNode k
-  v' <- atNode v
-  pure $ KV k' v' c
-traverseCTree _ atNode (Occur i occ) = flip Occur occ <$> atNode i
-traverseCTree _ atNode (Range f t inc) = do
-  f' <- atNode f
-  t' <- atNode t
-  pure $ Range f' t' inc
-traverseCTree _ atNode (Control o t c) = do
-  t' <- atNode t
-  c' <- atNode c
-  pure $ Control o t' c'
-traverseCTree _ atNode (Enum ref) = Enum <$> atNode ref
-traverseCTree _ atNode (Unwrap ref) = Unwrap <$> atNode ref
-traverseCTree _ atNode (Tag i ref) = Tag i <$> atNode ref
-traverseCTree atExt _ (CTreeE x) = atExt x
-
-type Node i = CTreeExt i
-
-newtype CTreeRoot i = CTreeRoot (Map.Map Name (CTree i))
-  deriving (Generic)
-
-deriving instance Show (CTree i) => Show (CTreeRoot i)
diff --git a/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs b/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
index bd3e29d..b8fab53 100644
--- a/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
@@ -27,7 +27,6 @@
 --    generic arguments bound.
 module Codec.CBOR.Cuddle.CDDL.Resolve (
   buildResolvedCTree,
-  buildRefCTree,
   asMap,
   buildMonoCTree,
   fullResolveCDDL,
@@ -45,12 +44,6 @@ import Capability.Sink (HasSink)
 import Capability.Source (HasSource)
 import Capability.State (HasState, MonadState (..), modify)
 import Codec.CBOR.Cuddle.CDDL as CDDL
-import Codec.CBOR.Cuddle.CDDL.CTree (
-  CTree (..),
-  CTreeExt,
-  CTreeRoot (..),
- )
-import Codec.CBOR.Cuddle.CDDL.CTree qualified as CTree
 import Codec.CBOR.Cuddle.CDDL.Postlude (PTerm (..))
 import Control.Monad.Except (ExceptT (..), runExceptT)
 import Control.Monad.Reader (Reader, ReaderT (..), runReader)
@@ -75,15 +68,11 @@ data ProvidedParameters a = ProvidedParameters
 
 instance Hashable a => Hashable (ProvidedParameters a)
 
-data Parametrised
-
-type instance CTreeExt Parametrised = ProvidedParameters (CTree Parametrised)
-
 --------------------------------------------------------------------------------
 -- 1. Rule extensions
 --------------------------------------------------------------------------------
 
-newtype PartialCTreeRoot i = PartialCTreeRoot (Map.Map Name (ProvidedParameters (CTree i)))
+newtype PartialCTreeRoot i = PartialCTreeRoot (Map.Map Name (ProvidedParameters TypeOrGroup))
   deriving (Generic)
 
 type CDDLMap = Map.Map Name (ProvidedParameters TypeOrGroup)
@@ -134,167 +123,14 @@ asMap cddl = foldl' go Map.empty rules
 
 data OrReferenced
 
-type instance CTreeExt OrReferenced = OrRef
-
 -- | Indicates that an item may be referenced rather than defined.
 data OrRef
   = -- | Reference to another node with possible generic arguments supplied
-    Ref Name [CTree OrReferenced]
-  deriving (Eq, Show)
-
-type RefCTree = PartialCTreeRoot OrReferenced
-
-deriving instance Show (CTree OrReferenced)
+    Ref Name [TypeOrGroup]
+  deriving (Eq, Show, Functor)
 
 deriving instance Show (PartialCTreeRoot OrReferenced)
 
--- | Build a CTree incorporating references.
---
--- This translation cannot fail.
-buildRefCTree :: CDDLMap -> RefCTree
-buildRefCTree rules = PartialCTreeRoot $ toCTreeRule <$> rules
-  where
-    toCTreeRule ::
-      ProvidedParameters TypeOrGroup ->
-      ProvidedParameters (CTree OrReferenced)
-    toCTreeRule = fmap toCTreeTOG
-
-    toCTreeTOG :: TypeOrGroup -> CTree OrReferenced
-    toCTreeTOG (TOGType t0) = toCTreeT0 t0
-    toCTreeTOG (TOGGroup ge) = toCTreeGroupEntry ge
-
-    toCTreeT0 :: Type0 -> CTree OrReferenced
-    toCTreeT0 (Type0 (t1 NE.:| [])) = toCTreeT1 t1
-    toCTreeT0 (Type0 xs) = CTree.Choice $ toCTreeT1 <$> xs
-
-    toCTreeT1 :: Type1 -> CTree OrReferenced
-    toCTreeT1 (Type1 t2 Nothing _) = toCTreeT2 t2
-    toCTreeT1 (Type1 t2 (Just (op, t2')) _) = case op of
-      RangeOp bound ->
-        CTree.Range
-          { CTree.from = toCTreeT2 t2
-          , CTree.to = toCTreeT2 t2'
-          , CTree.inclusive = bound
-          }
-      CtrlOp ctlop ->
-        CTree.Control
-          { CTree.op = ctlop
-          , CTree.target = toCTreeT2 t2
-          , CTree.controller = toCTreeT2 t2'
-          }
-
-    toCTreeT2 :: Type2 -> CTree OrReferenced
-    toCTreeT2 (T2Value v) = CTree.Literal v
-    toCTreeT2 (T2Name n garg) = CTreeE $ Ref n (fromGenArgs garg)
-    toCTreeT2 (T2Group t0) =
-      -- This behaviour seems questionable, but I don't really see how better to
-      -- interpret the spec here.
-      toCTreeT0 t0
-    toCTreeT2 (T2Map g) = toCTreeMap g
-    toCTreeT2 (T2Array g) = toCTreeArray g
-    toCTreeT2 (T2Unwrapped n margs) =
-      CTree.Unwrap . CTreeE $
-        Ref n (fromGenArgs margs)
-    toCTreeT2 (T2Enum g) = toCTreeEnum g
-    toCTreeT2 (T2EnumRef n margs) = CTreeE . Ref n $ fromGenArgs margs
-    toCTreeT2 (T2Tag Nothing t0) =
-      -- Currently not validating tags
-      toCTreeT0 t0
-    toCTreeT2 (T2Tag (Just tag) t0) =
-      CTree.Tag tag $ toCTreeT0 t0
-    toCTreeT2 (T2DataItem 7 (Just mmin)) =
-      toCTreeDataItem mmin
-    toCTreeT2 (T2DataItem _maj _mmin) =
-      -- We don't validate numerical items yet
-      CTree.Postlude PTAny
-    toCTreeT2 T2Any = CTree.Postlude PTAny
-
-    toCTreeDataItem 20 =
-      CTree.Literal $ Value (VBool False) mempty
-    toCTreeDataItem 21 =
-      CTree.Literal $ Value (VBool True) mempty
-    toCTreeDataItem 25 =
-      CTree.Postlude PTHalf
-    toCTreeDataItem 26 =
-      CTree.Postlude PTFloat
-    toCTreeDataItem 27 =
-      CTree.Postlude PTDouble
-    toCTreeDataItem 23 =
-      CTree.Postlude PTUndefined
-    toCTreeDataItem _ =
-      CTree.Postlude PTAny
-
-    toCTreeGroupEntry :: GroupEntry -> CTree OrReferenced
-    toCTreeGroupEntry (GroupEntry (Just occi) _ (GEType mmkey t0)) =
-      CTree.Occur
-        { CTree.item = toKVPair mmkey t0
-        , CTree.occurs = occi
-        }
-    toCTreeGroupEntry (GroupEntry Nothing _ (GEType mmkey t0)) = toKVPair mmkey t0
-    toCTreeGroupEntry (GroupEntry (Just occi) _ (GERef n margs)) =
-      CTree.Occur
-        { CTree.item = CTreeE $ Ref n (fromGenArgs margs)
-        , CTree.occurs = occi
-        }
-    toCTreeGroupEntry (GroupEntry Nothing _ (GERef n margs)) = CTreeE $ Ref n (fromGenArgs margs)
-    toCTreeGroupEntry (GroupEntry (Just occi) _ (GEGroup g)) =
-      CTree.Occur
-        { CTree.item = groupToGroup g
-        , CTree.occurs = occi
-        }
-    toCTreeGroupEntry (GroupEntry Nothing _ (GEGroup g)) = groupToGroup g
-
-    fromGenArgs :: Maybe GenericArg -> [CTree OrReferenced]
-    fromGenArgs = maybe [] (\(GenericArg xs) -> NE.toList $ fmap toCTreeT1 xs)
-
-    -- Interpret a group as an enumeration. Note that we float out the
-    -- choice options
-    toCTreeEnum :: Group -> CTree OrReferenced
-    toCTreeEnum (CDDL.Group (a NE.:| [])) =
-      CTree.Enum . CTree.Group $ toCTreeGroupEntry <$> gcGroupEntries a
-    toCTreeEnum (CDDL.Group xs) =
-      CTree.Choice $ CTree.Enum . CTree.Group . fmap toCTreeGroupEntry <$> groupEntries
-      where
-        groupEntries = fmap gcGroupEntries xs
-
-    -- Embed a group in another group, again floating out the choice options
-    groupToGroup :: Group -> CTree OrReferenced
-    groupToGroup (CDDL.Group (a NE.:| [])) =
-      CTree.Group $ fmap toCTreeGroupEntry (gcGroupEntries a)
-    groupToGroup (CDDL.Group xs) =
-      CTree.Choice $ fmap (CTree.Group . fmap toCTreeGroupEntry) (gcGroupEntries <$> xs)
-
-    toKVPair :: Maybe MemberKey -> Type0 -> CTree OrReferenced
-    toKVPair Nothing t0 = toCTreeT0 t0
-    toKVPair (Just mkey) t0 =
-      CTree.KV
-        { CTree.key = toCTreeMemberKey mkey
-        , CTree.value = toCTreeT0 t0
-        , -- TODO Handle cut semantics
-          CTree.cut = False
-        }
-
-    -- Interpret a group as a map. Note that we float out the choice options
-    toCTreeMap :: Group -> CTree OrReferenced
-    toCTreeMap (CDDL.Group (a NE.:| [])) = CTree.Map $ fmap toCTreeGroupEntry (gcGroupEntries a)
-    toCTreeMap (CDDL.Group xs) =
-      CTree.Choice $
-        fmap (CTree.Map . fmap toCTreeGroupEntry) (gcGroupEntries <$> xs)
-
-    -- Interpret a group as an array. Note that we float out the choice
-    -- options
-    toCTreeArray :: Group -> CTree OrReferenced
-    toCTreeArray (CDDL.Group (a NE.:| [])) =
-      CTree.Array $ fmap toCTreeGroupEntry (gcGroupEntries a)
-    toCTreeArray (CDDL.Group xs) =
-      CTree.Choice $
-        fmap (CTree.Array . fmap toCTreeGroupEntry) (gcGroupEntries <$> xs)
-
-    toCTreeMemberKey :: MemberKey -> CTree OrReferenced
-    toCTreeMemberKey (MKValue v) = CTree.Literal v
-    toCTreeMemberKey (MKBareword (Name n _)) = CTree.Literal (Value (VText n) mempty)
-    toCTreeMemberKey (MKType t1) = toCTreeT1 t1
-
 --------------------------------------------------------------------------------
 -- 3. Name resolution
 --------------------------------------------------------------------------------
@@ -302,7 +138,7 @@ buildRefCTree rules = PartialCTreeRoot $ toCTreeRule <$> rules
 data NameResolutionFailure
   = UnboundReference Name
   | MismatchingArgs Name [Name]
-  | ArgsToPostlude PTerm [CTree OrReferenced]
+  | ArgsToPostlude PTerm [TypeOrGroup]
   deriving (Show)
 
 deriving instance Eq NameResolutionFailure
@@ -327,30 +163,24 @@ postludeBinding =
     ]
 
 data BindingEnv i j = BindingEnv
-  { global :: Map.Map Name (ProvidedParameters (CTree i))
+  { global :: Map.Map Name (ProvidedParameters TypeOrGroup)
   -- ^ Global name bindings via 'RuleDef'
-  , local :: Map.Map Name (CTree j)
+  , local :: Map.Map Name TypeOrGroup
   -- ^ Local bindings for generic parameters
   }
   deriving (Generic)
 
 data DistReferenced
 
-type instance CTreeExt DistReferenced = DistRef
-
 data DistRef
   = -- | Reference to a generic parameter
     GenericRef Name
   | -- | Reference to a rule definition, possibly with generic arguments
-    RuleRef Name [CTree DistReferenced]
+    RuleRef Name [TypeOrGroup]
   deriving (Eq, Generic, Show)
 
 instance Hashable DistRef
 
-deriving instance Show (CTree DistReferenced)
-
-instance Hashable (CTree DistReferenced)
-
 deriving instance Show (PartialCTreeRoot DistReferenced)
 
 deriving instance Eq (PartialCTreeRoot DistReferenced)
@@ -359,8 +189,8 @@ instance Hashable (PartialCTreeRoot DistReferenced)
 
 resolveRef ::
   BindingEnv OrReferenced OrReferenced ->
-  CTree.Node OrReferenced ->
-  Either NameResolutionFailure (CTree DistReferenced)
+  OrRef TypeOrGroup ->
+  Either NameResolutionFailure TypeOrGroup
 resolveRef env (Ref n args) = case Map.lookup n postludeBinding of
   Just pterm -> case args of
     [] -> Right $ CTree.Postlude pterm
@@ -379,8 +209,8 @@ resolveRef env (Ref n args) = case Map.lookup n postludeBinding of
 
 resolveCTree ::
   BindingEnv OrReferenced OrReferenced ->
-  CTree OrReferenced ->
-  Either NameResolutionFailure (CTree DistReferenced)
+  TypeOrGroup ->
+  Either NameResolutionFailure TypeOrGroup
 resolveCTree e = CTree.traverseCTree (resolveRef e) (resolveCTree e)
 
 buildResolvedCTree ::
@@ -400,20 +230,16 @@ buildResolvedCTree (PartialCTreeRoot ct) = PartialCTreeRoot <$> traverse go ct
 
 data MonoReferenced
 
-type instance CTreeExt MonoReferenced = MonoRef (CTree MonoReferenced)
-
 newtype MonoRef a
   = MRuleRef Name
   deriving (Functor, Show)
 
-deriving instance Show (CTree MonoReferenced)
-
 deriving instance Show (PartialCTreeRoot MonoReferenced)
 
 type MonoEnv = BindingEnv DistReferenced MonoReferenced
 
 -- | We introduce additional bindings in the state
-type MonoState = Map.Map Name (CTree MonoReferenced)
+type MonoState = Map.Map Name TypeOrGroup
 
 -- | Monad to run the monomorphisation process. We need some additional
 -- capabilities for this, so 'Either' doesn't fully cut it anymore.
@@ -435,10 +261,10 @@ newtype MonoM a = MonoM
   deriving
     ( HasSource
         "local"
-        (Map.Map Name (CTree MonoReferenced))
+        (Map.Map Name TypeOrGroup)
     , HasReader
         "local"
-        (Map.Map Name (CTree MonoReferenced))
+        (Map.Map Name TypeOrGroup)
     )
     via Field
           "local"
@@ -452,10 +278,10 @@ newtype MonoM a = MonoM
   deriving
     ( HasSource
         "global"
-        (Map.Map Name (ProvidedParameters (CTree DistReferenced)))
+        (Map.Map Name (ProvidedParameters TypeOrGroup))
     , HasReader
         "global"
-        (Map.Map Name (ProvidedParameters (CTree DistReferenced)))
+        (Map.Map Name (ProvidedParameters TypeOrGroup))
     )
     via Field
           "global"
@@ -481,7 +307,7 @@ throwNR :: NameResolutionFailure -> MonoM a
 throwNR = throw @"nameResolution"
 
 -- | Synthesize a monomorphic rule definition, returning the name
-synthMono :: Name -> [CTree DistReferenced] -> MonoM Name
+synthMono :: Name -> [TypeOrGroup] -> MonoM Name
 synthMono n@(Name origName _) args =
   let fresh =
         -- % is not a valid CBOR name, so this should avoid conflict
@@ -504,8 +330,8 @@ synthMono n@(Name origName _) args =
         pure fresh
 
 resolveGenericRef ::
-  CTree.Node DistReferenced ->
-  MonoM (CTree MonoReferenced)
+  TypeOrGroup ->
+  MonoM TypeOrGroup
 resolveGenericRef (RuleRef n []) = pure . CTreeE $ MRuleRef n
 resolveGenericRef (RuleRef n args) = do
   fresh <- synthMono n args
@@ -517,8 +343,8 @@ resolveGenericRef (GenericRef n) = do
     Nothing -> throwNR $ UnboundReference n
 
 resolveGenericCTree ::
-  CTree DistReferenced ->
-  MonoM (CTree MonoReferenced)
+  TypeOrGroup ->
+  MonoM TypeOrGroup
 resolveGenericCTree = CTree.traverseCTree resolveGenericRef resolveGenericCTree
 
 -- | Monomorphise the CTree
@@ -528,7 +354,7 @@ resolveGenericCTree = CTree.traverseCTree resolveGenericRef resolveGenericCTree
 -- parameters applied.
 buildMonoCTree ::
   PartialCTreeRoot DistReferenced ->
-  Either NameResolutionFailure (CTreeRoot MonoReferenced)
+  Either NameResolutionFailure TypeOrGroup
 buildMonoCTree (PartialCTreeRoot ct) = do
   let a1 = runExceptT $ runMonoM (traverse resolveGenericCTree monoC)
       a2 = runStateT a1 mempty
@@ -548,7 +374,7 @@ buildMonoCTree (PartialCTreeRoot ct) = do
 -- Combined resolution
 --------------------------------------------------------------------------------
 
-fullResolveCDDL :: CDDL -> Either NameResolutionFailure (CTreeRoot MonoReferenced)
+fullResolveCDDL :: CDDL -> Either NameResolutionFailure TypeOrGroup
 fullResolveCDDL cddl = do
   let refCTree = buildRefCTree (asMap cddl)
   rCTree <- buildResolvedCTree refCTree

From 83945a6304e59eeebc1035fc56038583901e609a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Mon, 6 Oct 2025 18:30:11 +0300
Subject: [PATCH 02/15] Added extensions to CDDL AST

---
 src/Codec/CBOR/Cuddle/CDDL.hs | 307 ++++++++++++++++++++--------------
 1 file changed, 185 insertions(+), 122 deletions(-)

diff --git a/src/Codec/CBOR/Cuddle/CDDL.hs b/src/Codec/CBOR/Cuddle/CDDL.hs
index 570493a..e7d5ddf 100644
--- a/src/Codec/CBOR/Cuddle/CDDL.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -39,7 +40,7 @@ import Codec.CBOR.Cuddle.CDDL.CtlOp (CtlOp)
 import Codec.CBOR.Cuddle.Comments (CollectComments (..), Comment, HasComment (..))
 import Data.ByteString qualified as B
 import Data.Default.Class (Default (..))
-import Data.Function (on, (&))
+import Data.Function (on)
 import Data.Hashable (Hashable)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.List.NonEmpty qualified as NE
@@ -48,14 +49,22 @@ import Data.String (IsString (..))
 import Data.Text qualified as T
 import Data.TreeDiff (ToExpr)
 import Data.Word (Word64, Word8)
+import GHC.Base (Constraint, Type)
 import GHC.Generics (Generic)
-import Optics.Core ((%), (.~))
-import Optics.Getter (view)
+import Optics.Core ((%))
 import Optics.Lens (lens)
 
-type family TopLevelE i
+type family XXTopLevel i
 
-type family CDDLF i
+type family XCddl i
+
+type family XTerm i
+
+type ForAllExtensions i (c :: Type -> Constraint) =
+  ( c (XCddl i)
+  , c (XXTopLevel i)
+  , c (XTerm i)
+  )
 
 -- | The CDDL constructor takes three arguments:
 --     1. Top level comments that precede the first definition
@@ -65,27 +74,15 @@ type family CDDLF i
 data CDDL i = CDDL
   { rootDefinition :: Rule i
   , topLevelDefinitions :: [TopLevel i]
-  , cddlExt :: CDDLF i
+  , cddlExt :: XCddl i
   }
   deriving (Generic)
 
-deriving instance
-  ( Eq (TopLevelE i)
-  , Eq (CDDLF i)
-  ) =>
-  Eq (CDDL i)
+deriving instance ForAllExtensions i Eq => Eq (CDDL i)
 
-deriving instance
-  ( Show (TopLevelE i)
-  , Show (CDDLF i)
-  ) =>
-  Show (CDDL i)
+deriving instance ForAllExtensions i Show => Show (CDDL i)
 
-deriving instance
-  ( ToExpr (TopLevelE i)
-  , ToExpr (CDDLF i)
-  ) =>
-  ToExpr (CDDL i)
+deriving instance ForAllExtensions i ToExpr => ToExpr (CDDL i)
 
 ruleTopLevel :: TopLevel i -> Maybe (Rule i)
 ruleTopLevel (TopLevelRule r) = Just r
@@ -93,40 +90,40 @@ ruleTopLevel _ = Nothing
 
 -- | Sort the CDDL Rules on the basis of their names
 sortCDDL :: CDDL i -> NonEmpty (Rule i)
-sortCDDL (CDDL r rs _) = NE.sortBy (compare `on` ruleName) $ r :| mapMaybe ruleTopLevel rs
+sortCDDL (CDDL r rs _) = NE.sortBy (compare `on` name . ruleName) $ r :| mapMaybe ruleTopLevel rs
 
 cddlTopLevel ::
-  ( TopLevelE i ~ Comment
-  , CDDLF i ~ [Comment]
+  ( XXTopLevel i ~ Comment
+  , XCddl i ~ [Comment]
   ) =>
   CDDL i ->
   NonEmpty (TopLevel i)
 cddlTopLevel (CDDL cHead cTail cmts) =
-  NE.prependList (TopLevelE <$> cmts) $ TopLevelRule cHead :| cTail
+  NE.prependList (XXTopLevel <$> cmts) $ TopLevelRule cHead :| cTail
 
-fromRule :: Monoid (CDDLF i) => Rule i -> CDDL i
+fromRule :: Monoid (XCddl i) => Rule i -> CDDL i
 fromRule x = CDDL x [] mempty
 
 instance
-  CDDLF i ~ [TopLevelE i] =>
+  XCddl i ~ [XXTopLevel i] =>
   Semigroup (CDDL i)
   where
   CDDL aHead aTail aExt <> CDDL bHead bTail bExt =
     CDDL
       aHead
-      (aTail <> fmap TopLevelE bExt <> (TopLevelRule bHead : bTail))
+      (aTail <> fmap XXTopLevel bExt <> (TopLevelRule bHead : bTail))
       aExt
 
 data TopLevel i
   = TopLevelRule (Rule i)
-  | TopLevelE (TopLevelE i)
+  | XXTopLevel (XXTopLevel i)
   deriving (Generic)
 
-deriving instance Eq (TopLevelE i) => Eq (TopLevel i)
+deriving instance ForAllExtensions i Eq => Eq (TopLevel i)
 
-deriving instance Show (TopLevelE i) => Show (TopLevel i)
+deriving instance ForAllExtensions i Show => Show (TopLevel i)
 
-deriving instance ToExpr (TopLevelE i) => ToExpr (TopLevel i)
+deriving instance ForAllExtensions i ToExpr => ToExpr (TopLevel i)
 
 -- |
 --  A name can consist of any of the characters from the set {"A" to
@@ -151,23 +148,30 @@ deriving instance ToExpr (TopLevelE i) => ToExpr (TopLevel i)
 --
 --  *  Rule names (types or groups) do not appear in the actual CBOR
 --      encoding, but names used as "barewords" in member keys do.
-data Name = Name
+data Name i = Name
   { name :: T.Text
-  , nameComment :: Comment
+  , nameF :: XTerm i
   }
-  deriving (Eq, Generic, Ord, Show)
-  deriving anyclass (ToExpr)
+  deriving (Generic)
+
+deriving instance Eq (XTerm i) => Eq (Name i)
+
+deriving instance Ord (XTerm i) => Ord (Name i)
+
+deriving instance Show (XTerm i) => Show (Name i)
 
-instance IsString Name where
+deriving instance ToExpr (XTerm i) => ToExpr (Name i)
+
+instance Monoid (XTerm i) => IsString (Name i) where
   fromString x = Name (T.pack x) mempty
 
-instance HasComment Name where
-  commentL = lens nameComment (\x y -> x {nameComment = y})
+instance HasComment (XTerm i) => HasComment (Name i) where
+  commentL = #nameF % commentL
 
-instance CollectComments Name where
-  collectComments (Name _ c) = [c]
+instance CollectComments (XTerm i) => CollectComments (Name i) where
+  collectComments (Name _ c) = collectComments c
 
-instance Hashable Name
+instance XTerm i ~ () => Hashable (Name i)
 
 -- |
 --   assignt = "=" / "/="
@@ -202,17 +206,27 @@ data Assign = AssignEq | AssignExt
 --
 --   Generic rules can be used for establishing names for both types and
 --   groups.
-newtype GenericParam = GenericParam (NE.NonEmpty Name)
-  deriving (Eq, Generic, Show)
+newtype GenericParam i = GenericParam (NE.NonEmpty (Name i))
+  deriving (Generic)
   deriving newtype (Semigroup)
-  deriving anyclass (ToExpr)
 
-newtype GenericArg = GenericArg (NE.NonEmpty Type1)
-  deriving (Eq, Generic, Show)
+deriving instance Eq (XTerm i) => Eq (GenericParam i)
+
+deriving instance Show (XTerm i) => Show (GenericParam i)
+
+deriving anyclass instance ToExpr (XTerm i) => ToExpr (GenericParam i)
+
+newtype GenericArg i = GenericArg (NE.NonEmpty (Type1 i))
+  deriving (Generic)
   deriving newtype (Semigroup)
-  deriving anyclass (ToExpr)
 
-instance CollectComments GenericArg
+deriving instance ForAllExtensions i Eq => Eq (GenericArg i)
+
+deriving instance ForAllExtensions i Show => Show (GenericArg i)
+
+deriving anyclass instance ForAllExtensions i ToExpr => ToExpr (GenericArg i)
+
+instance CollectComments (XTerm i) => CollectComments (GenericArg i)
 
 -- |
 --  rule = typename [genericparm] S assignt S type
@@ -238,19 +252,24 @@ instance CollectComments GenericArg
 --   this semantic processing may need to span several levels of rule
 --   definitions before a determination can be made.)
 data Rule i = Rule
-  { ruleName :: Name
-  , ruleGenParam :: Maybe GenericParam
+  { ruleName :: Name i
+  , ruleGenParam :: Maybe (GenericParam i)
   , ruleAssign :: Assign
-  , ruleTerm :: TypeOrGroup
+  , ruleTerm :: TypeOrGroup i
   , ruleComment :: Comment
   }
-  deriving (Eq, Generic, Show)
-  deriving anyclass (ToExpr)
+  deriving (Generic)
+
+deriving instance ForAllExtensions i Eq => Eq (Rule i)
+
+deriving instance ForAllExtensions i Show => Show (Rule i)
+
+deriving instance ForAllExtensions i ToExpr => ToExpr (Rule i)
 
 instance HasComment (Rule i) where
   commentL = lens ruleComment (\x y -> x {ruleComment = y})
 
-compareRuleName :: Rule i -> Rule i -> Ordering
+compareRuleName :: Ord (XTerm i) => Rule i -> Rule i -> Ordering
 compareRuleName = compare `on` ruleName
 
 -- |
@@ -269,11 +288,16 @@ data TyOp = RangeOp RangeBound | CtrlOp CtlOp
   deriving (Eq, Generic, Show)
   deriving anyclass (ToExpr)
 
-data TypeOrGroup = TOGType Type0 | TOGGroup GroupEntry
-  deriving (Eq, Generic, Show)
-  deriving anyclass (ToExpr)
+data TypeOrGroup i = TOGType (Type0 i) | TOGGroup (GroupEntry i)
+  deriving (Generic)
+
+deriving instance ForAllExtensions i Eq => Eq (TypeOrGroup i)
+
+deriving instance ForAllExtensions i Show => Show (TypeOrGroup i)
+
+deriving instance ForAllExtensions i ToExpr => ToExpr (TypeOrGroup i)
 
-instance CollectComments TypeOrGroup
+instance CollectComments (XTerm i) => CollectComments (TypeOrGroup i)
 
 {-- |
    The group that is used to define a map or an array can often be reused in the
@@ -324,7 +348,7 @@ instance CollectComments TypeOrGroup
    described as "threading in" the group or type inside the referenced type,
    which suggested the thread-like "~" character.)
 -}
-unwrap :: TypeOrGroup -> Maybe Group
+unwrap :: TypeOrGroup i -> Maybe (Group i)
 unwrap (TOGType (Type0 (Type1 t2 Nothing _ NE.:| []))) = case t2 of
   T2Map g -> Just g
   T2Array g -> Just g
@@ -335,70 +359,82 @@ unwrap _ = Nothing
 -- A type can be given as a choice between one or more types.  The
 --   choice matches a data item if the data item matches any one of the
 --   types given in the choice.
-newtype Type0 = Type0 {t0Type1 :: NE.NonEmpty Type1}
-  deriving (Eq, Generic, Show)
+newtype Type0 i = Type0 {t0Type1 :: NE.NonEmpty (Type1 i)}
+  deriving (Generic)
   deriving newtype (Semigroup)
-  deriving anyclass (ToExpr)
 
-instance HasComment Type0 where
-  commentL = lens (view commentL . t0Type1) (\(Type0 x) y -> Type0 $ x & commentL .~ y)
+deriving instance ForAllExtensions i Eq => Eq (Type0 i)
+
+deriving instance ForAllExtensions i Show => Show (Type0 i)
 
-instance CollectComments Type0
+deriving anyclass instance ForAllExtensions i ToExpr => ToExpr (Type0 i)
+
+instance CollectComments (XTerm i) => CollectComments (Type0 i)
 
 -- |
 -- Two types can be combined with a range operator (see below)
-data Type1 = Type1
-  { t1Main :: Type2
-  , t1TyOp :: Maybe (TyOp, Type2)
-  , t1Comment :: Comment
+data Type1 i = Type1
+  { t1Main :: Type2 i
+  , t1TyOp :: Maybe (TyOp, Type2 i)
+  , t1Comment :: XTerm i
   }
-  deriving (Eq, Generic, Show)
-  deriving anyclass (ToExpr, Default)
+  deriving (Generic)
+
+deriving instance ForAllExtensions i Eq => Eq (Type1 i)
+
+deriving instance ForAllExtensions i Show => Show (Type1 i)
 
-instance HasComment Type1 where
-  commentL = lens t1Comment (\x y -> x {t1Comment = y})
+deriving instance ForAllExtensions i ToExpr => ToExpr (Type1 i)
 
-instance CollectComments Type1 where
-  collectComments (Type1 m tyOp c) = c : collectComments m <> collectComments (fmap snd tyOp)
+instance HasComment (XTerm i) => HasComment (Type1 i) where
+  commentL = #t1Comment % commentL
 
-data Type2
+instance CollectComments (XTerm i) => CollectComments (Type1 i) where
+  collectComments (Type1 m tyOp c) = collectComments c <> collectComments m <> collectComments (fmap snd tyOp)
+
+data Type2 i
   = -- | A type can be just a single value (such as 1 or "icecream" or
     --   h'0815'), which matches only a data item with that specific value
     --   (no conversions defined),
     T2Value Value
   | -- | or be defined by a rule giving a meaning to a name (possibly after
     --   supplying generic arguments as required by the generic parameters)
-    T2Name Name (Maybe GenericArg)
+    T2Name (Name i) (Maybe (GenericArg i))
   | -- | or be defined in a parenthesized type expression (parentheses may be
     --   necessary to override some operator precedence),
-    T2Group Type0
+    T2Group (Type0 i)
   | -- | a map expression, which matches a valid CBOR map the key/value pairs
     --  of which can be ordered in such a way that the resulting sequence
     --  matches the group expression, or
-    T2Map Group
+    T2Map (Group i)
   | -- | an array expression, which matches a CBOR array the elements of which
     -- when taken as values and complemented by a wildcard (matches
     -- anything) key each -- match the group, or
-    T2Array Group
+    T2Array (Group i)
   | -- | an "unwrapped" group (see Section 3.7), which matches the group
     --  inside a type defined as a map or an array by wrapping the group, or
-    T2Unwrapped Name (Maybe GenericArg)
+    T2Unwrapped (Name i) (Maybe (GenericArg i))
   | -- | an enumeration expression, which matches any value that is within the
     --  set of values that the values of the group given can take, or
-    T2Enum Group
-  | T2EnumRef Name (Maybe GenericArg)
+    T2Enum (Group i)
+  | T2EnumRef (Name i) (Maybe (GenericArg i))
   | -- | a tagged data item, tagged with the "uint" given and containing the
     --  type given as the tagged value, or
-    T2Tag (Maybe Word64) Type0
+    T2Tag (Maybe Word64) (Type0 i)
   | -- | a data item of a major type (given by the DIGIT), optionally
     --  constrained to the additional information given by the uint, or
     T2DataItem Word8 (Maybe Word64)
   | -- | Any data item
     T2Any
-  deriving (Eq, Generic, Show, Default)
-  deriving anyclass (ToExpr)
+  deriving (Generic)
+
+deriving instance ForAllExtensions i Eq => Eq (Type2 i)
 
-instance CollectComments Type2
+deriving instance ForAllExtensions i Show => Show (Type2 i)
+
+deriving instance ForAllExtensions i ToExpr => ToExpr (Type2 i)
+
+instance CollectComments (XTerm i) => CollectComments (Type2 i)
 
 -- |
 --  An optional _occurrence_ indicator can be given in front of a group
@@ -427,29 +463,39 @@ instance Hashable OccurrenceIndicator
 -- |
 --   A group matches any sequence of key/value pairs that matches any of
 --   the choices given (again using PEG semantics).
-newtype Group = Group {unGroup :: NE.NonEmpty GrpChoice}
-  deriving (Eq, Generic, Show)
+newtype Group i = Group {unGroup :: NE.NonEmpty (GrpChoice i)}
+  deriving (Generic)
   deriving newtype (Semigroup)
-  deriving anyclass (ToExpr)
 
-instance HasComment Group where
-  commentL = lens unGroup (\x y -> x {unGroup = y}) % commentL
+deriving instance ForAllExtensions i Eq => Eq (Group i)
 
-instance CollectComments Group where
+deriving instance ForAllExtensions i Show => Show (Group i)
+
+deriving anyclass instance ForAllExtensions i ToExpr => ToExpr (Group i)
+
+instance HasComment (XTerm i) => HasComment (Group i) where
+  commentL = #unGroup % commentL
+
+instance CollectComments (XTerm i) => CollectComments (Group i) where
   collectComments (Group xs) = concatMap collectComments xs
 
-data GrpChoice = GrpChoice
-  { gcGroupEntries :: [GroupEntry]
-  , gcComment :: Comment
+data GrpChoice i = GrpChoice
+  { gcGroupEntries :: [GroupEntry i]
+  , gcComment :: XTerm i
   }
-  deriving (Eq, Generic, Show)
-  deriving anyclass (ToExpr)
+  deriving (Generic)
+
+deriving instance ForAllExtensions i Eq => Eq (GrpChoice i)
+
+deriving instance ForAllExtensions i Show => Show (GrpChoice i)
+
+deriving instance ForAllExtensions i ToExpr => ToExpr (GrpChoice i)
 
-instance HasComment GrpChoice where
-  commentL = lens gcComment (\x y -> x {gcComment = y})
+instance HasComment (XTerm i) => HasComment (GrpChoice i) where
+  commentL = #gcComment % commentL
 
-instance CollectComments GrpChoice where
-  collectComments (GrpChoice ges c) = c : concatMap collectComments ges
+instance CollectComments (XTerm i) => CollectComments (GrpChoice i) where
+  collectComments (GrpChoice ges c) = collectComments c <> concatMap collectComments ges
 
 -- |
 --  A group entry can be given by a value type, which needs to be matched
@@ -458,26 +504,38 @@ instance CollectComments GrpChoice where
 --  the memberkey is given.  If the memberkey is not given, the entry can
 --  only be used for matching arrays, not for maps.  (See below for how
 --  that is modified by the occurrence indicator.)
-data GroupEntry = GroupEntry
+data GroupEntry i = GroupEntry
   { geOccurrenceIndicator :: Maybe OccurrenceIndicator
-  , geComment :: Comment
-  , geVariant :: GroupEntryVariant
+  , geComment :: XTerm i
+  , geVariant :: GroupEntryVariant i
   }
-  deriving (Eq, Show, Generic, ToExpr)
+  deriving (Generic)
+
+deriving instance ForAllExtensions i Eq => Eq (GroupEntry i)
+
+deriving instance ForAllExtensions i Show => Show (GroupEntry i)
 
-instance CollectComments GroupEntry where
-  collectComments (GroupEntry _ c x) = c : collectComments x
+deriving instance ForAllExtensions i ToExpr => ToExpr (GroupEntry i)
 
-data GroupEntryVariant
-  = GEType (Maybe MemberKey) Type0
-  | GERef Name (Maybe GenericArg)
-  | GEGroup Group
-  deriving (Eq, Show, Generic, ToExpr)
+instance CollectComments (XTerm i) => CollectComments (GroupEntry i) where
+  collectComments (GroupEntry _ c x) = collectComments c <> collectComments x
+
+data GroupEntryVariant i
+  = GEType (Maybe (MemberKey i)) (Type0 i)
+  | GERef (Name i) (Maybe (GenericArg i))
+  | GEGroup (Group i)
+  deriving (Generic)
 
-instance HasComment GroupEntry where
-  commentL = lens geComment (\x y -> x {geComment = y})
+deriving instance ForAllExtensions i Eq => Eq (GroupEntryVariant i)
 
-instance CollectComments GroupEntryVariant where
+deriving instance ForAllExtensions i Show => Show (GroupEntryVariant i)
+
+deriving instance ForAllExtensions i ToExpr => ToExpr (GroupEntryVariant i)
+
+instance HasComment (XTerm i) => HasComment (GroupEntry i) where
+  commentL = #geComment % commentL
+
+instance CollectComments (XTerm i) => CollectComments (GroupEntryVariant i) where
   collectComments (GEType _ t0) = collectComments t0
   collectComments (GERef n mga) = collectComments n <> collectComments mga
   collectComments (GEGroup g) = collectComments g
@@ -490,12 +548,17 @@ instance CollectComments GroupEntryVariant where
 --  member of the key type, unless a cut preceding it in the group
 --  applies (see Section 3.5.4 for how map matching is influenced by the
 --  presence of the cuts denoted by "^" or ":" in previous entries).
-data MemberKey
-  = MKType Type1
-  | MKBareword Name
+data MemberKey i
+  = MKType (Type1 i)
+  | MKBareword (Name i)
   | MKValue Value
-  deriving (Eq, Generic, Show)
-  deriving anyclass (ToExpr)
+  deriving (Generic)
+
+deriving instance ForAllExtensions i Eq => Eq (MemberKey i)
+
+deriving instance ForAllExtensions i Show => Show (MemberKey i)
+
+deriving instance ForAllExtensions i ToExpr => ToExpr (MemberKey i)
 
 data Value = Value ValueVariant Comment
   deriving (Eq, Generic, Show, Default)

From 5246ab027362edcf8bb29acd4b8e3d53e6d2e394 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Mon, 6 Oct 2025 18:35:09 +0300
Subject: [PATCH 03/15] Fixed Pretty

---
 src/Codec/CBOR/Cuddle/CDDL.hs   |  4 ++++
 src/Codec/CBOR/Cuddle/Pretty.hs | 41 ++++++++++++++++++++-------------
 2 files changed, 29 insertions(+), 16 deletions(-)

diff --git a/src/Codec/CBOR/Cuddle/CDDL.hs b/src/Codec/CBOR/Cuddle/CDDL.hs
index e7d5ddf..ad3501b 100644
--- a/src/Codec/CBOR/Cuddle/CDDL.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL.hs
@@ -34,6 +34,10 @@ module Codec.CBOR.Cuddle.CDDL (
   GrpChoice (..),
   unwrap,
   compareRuleName,
+  -- Extension
+  XXTopLevel,
+  XCddl,
+  XTerm,
 ) where
 
 import Codec.CBOR.Cuddle.CDDL.CtlOp (CtlOp)
diff --git a/src/Codec/CBOR/Cuddle/Pretty.hs b/src/Codec/CBOR/Cuddle/Pretty.hs
index 0e8b1ba..5b830c6 100644
--- a/src/Codec/CBOR/Cuddle/Pretty.hs
+++ b/src/Codec/CBOR/Cuddle/Pretty.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -28,14 +29,22 @@ import Data.String (fromString)
 import Data.Text qualified as T
 import Prettyprinter
 
-instance Pretty CDDL where
+data PrettyStage
+
+type instance XXTopLevel PrettyStage = Comment
+
+type instance XTerm PrettyStage = Comment
+
+type instance XCddl PrettyStage = [Comment]
+
+instance Pretty (CDDL PrettyStage) where
   pretty = vsep . fmap pretty . NE.toList . cddlTopLevel
 
-instance Pretty TopLevel where
-  pretty (TopLevelComment cmt) = pretty cmt
+instance Pretty (TopLevel PrettyStage) where
+  pretty (XXTopLevel cmt) = pretty cmt
   pretty (TopLevelRule x) = pretty x <> hardline
 
-instance Pretty Name where
+instance Pretty (Name PrettyStage) where
   pretty (Name name cmt) = pretty name <> prettyCommentNoBreakWS cmt
 
 data CommentRender
@@ -54,10 +63,10 @@ instance Pretty Comment where
   pretty (Comment "") = mempty
   pretty c = prettyCommentNoBreak c <> hardline
 
-type0Def :: Type0 -> Doc ann
+type0Def :: Type0 PrettyStage -> Doc ann
 type0Def t = nest 2 $ line' <> pretty t
 
-instance Pretty Rule where
+instance Pretty (Rule PrettyStage) where
   pretty (Rule n mgen assign tog cmt) =
     pretty cmt
       <> groupIfNoComments
@@ -74,17 +83,17 @@ instance Pretty Rule where
         AssignEq -> "="
         AssignExt -> "//="
 
-instance Pretty GenericArg where
+instance Pretty (GenericArg PrettyStage) where
   pretty (GenericArg (NE.toList -> l))
     | null (collectComments l) = group . cEncloseSep "<" ">" "," $ fmap pretty l
     | otherwise = columnarListing "<" ">" "," . Columnar $ singletonRow . pretty <$> l
 
-instance Pretty GenericParam where
+instance Pretty (GenericParam PrettyStage) where
   pretty (GenericParam (NE.toList -> l))
     | null (collectComments l) = group . cEncloseSep "<" ">" "," $ fmap pretty l
     | otherwise = columnarListing "<" ">" "," . Columnar $ singletonRow . pretty <$> l
 
-instance Pretty Type0 where
+instance Pretty (Type0 PrettyStage) where
   pretty t0@(Type0 (NE.toList -> l)) =
     groupIfNoComments t0 $ columnarSepBy "/" . Columnar $ type1ToRow <$> l
     where
@@ -104,7 +113,7 @@ instance Pretty TyOp where
   pretty (RangeOp Closed) = ".."
   pretty (CtrlOp n) = "." <> pretty n
 
-instance Pretty Type1 where
+instance Pretty (Type1 PrettyStage) where
   pretty (Type1 t2 Nothing cmt) = groupIfNoComments t2 (pretty t2) <> prettyCommentNoBreakWS cmt
   pretty (Type1 t2 (Just (tyop, t2')) cmt) =
     groupIfNoComments t2 (pretty t2)
@@ -112,7 +121,7 @@ instance Pretty Type1 where
       <+> groupIfNoComments t2' (pretty t2')
       <> prettyCommentNoBreakWS cmt
 
-instance Pretty Type2 where
+instance Pretty (Type2 PrettyStage) where
   pretty (T2Value v) = pretty v
   pretty (T2Name n mg) = pretty n <> pretty mg
   pretty (T2Group g) = cEncloseSep "(" ")" mempty [pretty g]
@@ -144,7 +153,7 @@ data GroupRender
   | AsArray
   | AsGroup
 
-memberKeySep :: MemberKey -> Doc ann
+memberKeySep :: MemberKey i -> Doc ann
 memberKeySep MKType {} = " => "
 memberKeySep _ = " : "
 
@@ -165,7 +174,7 @@ groupIfNoComments x
   | not (any (mempty /=) $ collectComments x) = group
   | otherwise = id
 
-columnarGroupChoice :: GrpChoice -> Columnar ann
+columnarGroupChoice :: GrpChoice PrettyStage -> Columnar ann
 columnarGroupChoice (GrpChoice ges _cmt) = Columnar grpEntryRows
   where
     groupEntryRow (GroupEntry oi cmt gev) =
@@ -179,7 +188,7 @@ columnarGroupChoice (GrpChoice ges _cmt) = Columnar grpEntryRows
     groupEntryVariantCells (GEGroup g) = [Cell (prettyGroup AsGroup g) LeftAlign, emptyCell]
     grpEntryRows = groupEntryRow <$> ges
 
-prettyGroup :: GroupRender -> Group -> Doc ann
+prettyGroup :: GroupRender -> Group PrettyStage -> Doc ann
 prettyGroup gr g@(Group (toList -> xs)) =
   groupIfNoComments g . columnarListing (lEnc <> softspace) rEnc "// " . Columnar $
     (\x -> singletonRow . groupIfNoComments x . columnarSepBy "," $ columnarGroupChoice x) <$> xs
@@ -189,10 +198,10 @@ prettyGroup gr g@(Group (toList -> xs)) =
       AsArray -> ("[", "]")
       AsGroup -> ("(", ")")
 
-instance Pretty GroupEntry where
+instance Pretty (GroupEntry PrettyStage) where
   pretty ge = prettyColumnar . columnarGroupChoice $ GrpChoice [ge] mempty
 
-instance Pretty MemberKey where
+instance Pretty (MemberKey PrettyStage) where
   pretty (MKType t1) = pretty t1
   pretty (MKBareword n) = pretty n
   pretty (MKValue v) = pretty v

From 653b618227b95095cabe9b30983da06b4506e727 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Mon, 6 Oct 2025 18:49:09 +0300
Subject: [PATCH 04/15] Fixed Parser

---
 src/Codec/CBOR/Cuddle/Parser.hs | 62 +++++++++++++++++++++++----------
 1 file changed, 43 insertions(+), 19 deletions(-)

diff --git a/src/Codec/CBOR/Cuddle/Parser.hs b/src/Codec/CBOR/Cuddle/Parser.hs
index f21f3f3..64a3ed2 100644
--- a/src/Codec/CBOR/Cuddle/Parser.hs
+++ b/src/Codec/CBOR/Cuddle/Parser.hs
@@ -1,12 +1,21 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module Codec.CBOR.Cuddle.Parser where
 
 import Codec.CBOR.Cuddle.CDDL
 import Codec.CBOR.Cuddle.CDDL.CtlOp (CtlOp)
 import Codec.CBOR.Cuddle.CDDL.CtlOp qualified as COp
-import Codec.CBOR.Cuddle.Comments (Comment, WithComment (..), withComment, (!*>), (//-), (<*!))
+import Codec.CBOR.Cuddle.Comments (
+  Comment,
+  HasComment (..),
+  WithComment (..),
+  withComment,
+  (!*>),
+  (//-),
+  (<*!),
+ )
 import Codec.CBOR.Cuddle.Parser.Lexer (
   Parser,
   charInRange,
@@ -16,36 +25,45 @@ import Codec.CBOR.Cuddle.Parser.Lexer (
 import Control.Applicative.Combinators.NonEmpty qualified as NE
 import Data.Foldable (Foldable (..))
 import Data.Functor (void, ($>))
-import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty (NonEmpty (..))
 import Data.List.NonEmpty qualified as NE
 import Data.Maybe (isJust)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.Encoding (encodeUtf8)
 import GHC.Word (Word64, Word8)
+import Optics.Core ((&), (.~))
 import Text.Megaparsec
 import Text.Megaparsec.Char hiding (space)
 import Text.Megaparsec.Char qualified as C
 import Text.Megaparsec.Char.Lexer qualified as L
 
-pCDDL :: Parser CDDL
+data ParserStage
+
+type instance XXTopLevel ParserStage = Comment
+
+type instance XTerm ParserStage = Comment
+
+type instance XCddl ParserStage = [Comment]
+
+pCDDL :: Parser (CDDL ParserStage)
 pCDDL = do
   initialComments <- many (try $ C.space *> pCommentBlock <* notFollowedBy pRule)
   initialRuleComment <- C.space *> optional pCommentBlock
   initialRule <- pRule
   cddlTail <- many $ pTopLevel <* C.space
-  eof $> CDDL initialComments (initialRule //- fold initialRuleComment) cddlTail
+  eof $> CDDL (initialRule //- fold initialRuleComment) cddlTail initialComments
 
-pTopLevel :: Parser TopLevel
+pTopLevel :: Parser (TopLevel ParserStage)
 pTopLevel = try tlRule <|> tlComment
   where
     tlRule = do
       mCmt <- optional pCommentBlock
       rule <- pRule
       pure . TopLevelRule $ rule //- fold mCmt
-    tlComment = TopLevelComment <$> pCommentBlock
+    tlComment = XXTopLevel <$> pCommentBlock
 
-pRule :: Parser Rule
+pRule :: Parser (Rule ParserStage)
 pRule = do
   name <- pName
   genericParam <- optcomp pGenericParam
@@ -61,7 +79,7 @@ pRule = do
       ]
   pure $ Rule name genericParam assign typeOrGrp cmt
 
-pName :: Parser Name
+pName :: Parser (Name ParserStage)
 pName = label "name" $ do
   fc <- firstChar
   rest <- many midChar
@@ -89,20 +107,20 @@ pAssignG =
     , AssignExt <$ "//="
     ]
 
-pGenericParam :: Parser GenericParam
+pGenericParam :: Parser (GenericParam ParserStage)
 pGenericParam =
   GenericParam
     <$> between "<" ">" (NE.sepBy1 (space !*> pName <*! space) ",")
 
-pGenericArg :: Parser GenericArg
+pGenericArg :: Parser (GenericArg ParserStage)
 pGenericArg =
   GenericArg
     <$> between "<" ">" (NE.sepBy1 (space !*> pType1 <*! space) ",")
 
-pType0 :: Parser Type0
+pType0 :: Parser (Type0 ParserStage)
 pType0 = Type0 <$> sepBy1' (space !*> pType1 <*! space) (try "/")
 
-pType1 :: Parser Type1
+pType1 :: Parser (Type1 ParserStage)
 pType1 = do
   v <- pType2
   rest <- optional $ do
@@ -118,12 +136,12 @@ pType1 = do
       pure $ Type1 v (Just (tyOp, w)) $ cmtFst <> cmtSnd
     Nothing -> pure $ Type1 v Nothing mempty
 
-pType2 :: Parser Type2
+pType2 :: Parser (Type2 ParserStage)
 pType2 =
   choice
     [ T2Value <$> pValue
     , T2Name <$> pName <*> optional pGenericArg
-    , T2Group <$> label "group" ("(" *> space !*> pType0 <*! space <* ")")
+    , T2Group <$> label "group" ("(" *> pType0Cmt <* ")")
     , T2Map <$> label "map" ("{" *> pGroup <* "}")
     , T2Array <$> label "array" ("[" *> space !*> pGroup <*! space <* "]")
     , T2Unwrapped <$> ("~" *> space !*> pName) <*> optional pGenericArg
@@ -141,11 +159,17 @@ pType2 =
             mminor <- optional ("." *> L.decimal)
             let
               pTag
-                | major == 6 = T2Tag mminor <$> ("(" *> space !*> pType0 <*! space <* ")")
+                | major == 6 = T2Tag mminor <$> ("(" *> pType0Cmt <* ")")
                 | otherwise = empty
             pTag <|> pure (T2DataItem major mminor)
           Nothing -> pure T2Any
     ]
+  where
+    pType0Cmt = do
+      pre <- space
+      Type0 (t :| ts) <- pType0
+      post <- space
+      pure . Type0 $ (t & commentL .~ (pre <> post)) :| ts
 
 pHeadNumber :: Parser Word64
 pHeadNumber = L.decimal
@@ -176,13 +200,13 @@ pCtlOp =
                 ]
         )
 
-pGroup :: Parser Group
+pGroup :: Parser (Group ParserStage)
 pGroup = Group <$> NE.sepBy1 (space !*> pGrpChoice) "//"
 
-pGrpChoice :: Parser GrpChoice
+pGrpChoice :: Parser (GrpChoice ParserStage)
 pGrpChoice = GrpChoice <$> many (space !*> pGrpEntry <*! pOptCom) <*> mempty
 
-pGrpEntry :: Parser GroupEntry
+pGrpEntry :: Parser (GroupEntry ParserStage)
 pGrpEntry = do
   occur <- optcomp pOccur
   cmt <- space
@@ -197,7 +221,7 @@ pGrpEntry = do
       ]
   pure $ GroupEntry occur (cmt <> cmt') variant
 
-pMemberKey :: Parser (WithComment MemberKey)
+pMemberKey :: Parser (WithComment (MemberKey ParserStage))
 pMemberKey =
   choice
     [ try $ do

From d62b0f61df9ef95785610ea62d29c0503212f1c4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Tue, 7 Oct 2025 12:36:07 +0300
Subject: [PATCH 05/15] Removed Prelude

---
 cuddle.cabal                          |  1 -
 src/Codec/CBOR/Cuddle/CDDL/Prelude.hs | 61 ---------------------------
 2 files changed, 62 deletions(-)
 delete mode 100644 src/Codec/CBOR/Cuddle/CDDL/Prelude.hs

diff --git a/cuddle.cabal b/cuddle.cabal
index b813bc3..6f44506 100644
--- a/cuddle.cabal
+++ b/cuddle.cabal
@@ -48,7 +48,6 @@ library
     Codec.CBOR.Cuddle.CDDL
     Codec.CBOR.Cuddle.CDDL.CtlOp
     Codec.CBOR.Cuddle.CDDL.Postlude
-    Codec.CBOR.Cuddle.CDDL.Prelude
     Codec.CBOR.Cuddle.CDDL.Resolve
     Codec.CBOR.Cuddle.Comments
     Codec.CBOR.Cuddle.Huddle
diff --git a/src/Codec/CBOR/Cuddle/CDDL/Prelude.hs b/src/Codec/CBOR/Cuddle/CDDL/Prelude.hs
deleted file mode 100644
index 3bcbe1a..0000000
--- a/src/Codec/CBOR/Cuddle/CDDL/Prelude.hs
+++ /dev/null
@@ -1,61 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Codec.CBOR.Cuddle.CDDL.Prelude (prependPrelude) where
-
-import Codec.CBOR.Cuddle.CDDL (CDDL (..))
-import Codec.CBOR.Cuddle.Parser (pCDDL)
-import Text.Megaparsec (errorBundlePretty, parse)
-
--- TODO switch to quasiquotes
-cddlPrelude :: CDDL
-cddlPrelude =
-  either (error . errorBundlePretty) id $
-    parse
-      pCDDL
-      "<HARDCODED>"
-      " any = # \
-      \ uint = #0 \
-      \ nint = #1 \
-      \ int = uint / nint \
-      \ \
-      \ bstr = #2 \
-      \ bytes = bstr \
-      \ tstr = #3 \
-      \ text = tstr \
-      \ \
-      \ tdate = #6.0(tstr) \
-      \ time = #6.1(number) \
-      \ number = int / float \
-      \ biguint = #6.2(bstr) \
-      \ bignint = #6.3(bstr) \
-      \ bigint = biguint / bignint \
-      \ integer = int / bigint \
-      \ unsigned = uint / biguint \
-      \ decfrac = #6.4([e10: int, m: integer]) \
-      \ bigfloat = #6.5([e2: int, m: integer]) \
-      \ eb64url = #6.21(any) \
-      \ eb64legacy = #6.22(any) \
-      \ eb16 = #6.23(any) \
-      \ encoded-cbor = #6.24(bstr) \
-      \ uri = #6.32(tstr) \
-      \ b64url = #6.33(tstr) \
-      \ b64legacy = #6.34(tstr) \
-      \ regexp = #6.35(tstr) \
-      \ mime-message = #6.36(tstr) \
-      \ cbor-any = #6.55799(any) \
-      \ float16 = #7.25 \
-      \ float32 = #7.26 \
-      \ float64 = #7.27 \
-      \ float16-32 = float16 / float32 \
-      \ float32-64 = float32 / float64 \
-      \ float = float16-32 / float64 \
-      \  \
-      \ false = #7.20 \
-      \ true = #7.21 \
-      \ bool = false / true \
-      \ nil = #7.22 \
-      \ null = nil \
-      \ undefined = #7.23"
-
-prependPrelude :: CDDL -> CDDL
-prependPrelude = (cddlPrelude <>)

From cd2103652d82069920fafe1f1787f26ee7c7be11 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Tue, 7 Oct 2025 13:24:58 +0300
Subject: [PATCH 06/15] Added XXType2

---
 src/Codec/CBOR/Cuddle/CDDL.hs         |  32 +++---
 src/Codec/CBOR/Cuddle/CDDL/Resolve.hs | 143 ++++++++++++++------------
 src/Codec/CBOR/Cuddle/Comments.hs     |   5 +
 src/Codec/CBOR/Cuddle/Huddle.hs       |  50 +++++----
 src/Codec/CBOR/Cuddle/Pretty.hs       |   4 +
 5 files changed, 132 insertions(+), 102 deletions(-)

diff --git a/src/Codec/CBOR/Cuddle/CDDL.hs b/src/Codec/CBOR/Cuddle/CDDL.hs
index ad3501b..300c9a0 100644
--- a/src/Codec/CBOR/Cuddle/CDDL.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL.hs
@@ -11,6 +11,7 @@ module Codec.CBOR.Cuddle.CDDL (
   sortCDDL,
   cddlTopLevel,
   fromRule,
+  fromRules,
   TopLevel (..),
   Name (..),
   Rule (..),
@@ -35,7 +36,9 @@ module Codec.CBOR.Cuddle.CDDL (
   unwrap,
   compareRuleName,
   -- Extension
+  ForAllExtensions,
   XXTopLevel,
+  XXType2,
   XCddl,
   XTerm,
 ) where
@@ -64,10 +67,13 @@ type family XCddl i
 
 type family XTerm i
 
+type family XXType2 i
+
 type ForAllExtensions i (c :: Type -> Constraint) =
   ( c (XCddl i)
   , c (XXTopLevel i)
   , c (XTerm i)
+  , c (XXType2 i)
   )
 
 -- | The CDDL constructor takes three arguments:
@@ -97,14 +103,15 @@ sortCDDL :: CDDL i -> NonEmpty (Rule i)
 sortCDDL (CDDL r rs _) = NE.sortBy (compare `on` name . ruleName) $ r :| mapMaybe ruleTopLevel rs
 
 cddlTopLevel ::
-  ( XXTopLevel i ~ Comment
-  , XCddl i ~ [Comment]
-  ) =>
+  [XXTopLevel i] ~ XCddl i =>
   CDDL i ->
   NonEmpty (TopLevel i)
 cddlTopLevel (CDDL cHead cTail cmts) =
   NE.prependList (XXTopLevel <$> cmts) $ TopLevelRule cHead :| cTail
 
+fromRules :: Monoid (XCddl i) => NonEmpty (Rule i) -> CDDL i
+fromRules (x :| xs) = CDDL x (TopLevelRule <$> xs) mempty
+
 fromRule :: Monoid (XCddl i) => Rule i -> CDDL i
 fromRule x = CDDL x [] mempty
 
@@ -230,7 +237,7 @@ deriving instance ForAllExtensions i Show => Show (GenericArg i)
 
 deriving anyclass instance ForAllExtensions i ToExpr => ToExpr (GenericArg i)
 
-instance CollectComments (XTerm i) => CollectComments (GenericArg i)
+instance ForAllExtensions i CollectComments => CollectComments (GenericArg i)
 
 -- |
 --  rule = typename [genericparm] S assignt S type
@@ -301,7 +308,7 @@ deriving instance ForAllExtensions i Show => Show (TypeOrGroup i)
 
 deriving instance ForAllExtensions i ToExpr => ToExpr (TypeOrGroup i)
 
-instance CollectComments (XTerm i) => CollectComments (TypeOrGroup i)
+instance ForAllExtensions i CollectComments => CollectComments (TypeOrGroup i)
 
 {-- |
    The group that is used to define a map or an array can often be reused in the
@@ -373,7 +380,7 @@ deriving instance ForAllExtensions i Show => Show (Type0 i)
 
 deriving anyclass instance ForAllExtensions i ToExpr => ToExpr (Type0 i)
 
-instance CollectComments (XTerm i) => CollectComments (Type0 i)
+instance ForAllExtensions i CollectComments => CollectComments (Type0 i)
 
 -- |
 -- Two types can be combined with a range operator (see below)
@@ -393,7 +400,7 @@ deriving instance ForAllExtensions i ToExpr => ToExpr (Type1 i)
 instance HasComment (XTerm i) => HasComment (Type1 i) where
   commentL = #t1Comment % commentL
 
-instance CollectComments (XTerm i) => CollectComments (Type1 i) where
+instance ForAllExtensions i CollectComments => CollectComments (Type1 i) where
   collectComments (Type1 m tyOp c) = collectComments c <> collectComments m <> collectComments (fmap snd tyOp)
 
 data Type2 i
@@ -430,6 +437,7 @@ data Type2 i
     T2DataItem Word8 (Maybe Word64)
   | -- | Any data item
     T2Any
+  | XXType2 (XXType2 i)
   deriving (Generic)
 
 deriving instance ForAllExtensions i Eq => Eq (Type2 i)
@@ -438,7 +446,7 @@ deriving instance ForAllExtensions i Show => Show (Type2 i)
 
 deriving instance ForAllExtensions i ToExpr => ToExpr (Type2 i)
 
-instance CollectComments (XTerm i) => CollectComments (Type2 i)
+instance ForAllExtensions i CollectComments => CollectComments (Type2 i)
 
 -- |
 --  An optional _occurrence_ indicator can be given in front of a group
@@ -480,7 +488,7 @@ deriving anyclass instance ForAllExtensions i ToExpr => ToExpr (Group i)
 instance HasComment (XTerm i) => HasComment (Group i) where
   commentL = #unGroup % commentL
 
-instance CollectComments (XTerm i) => CollectComments (Group i) where
+instance ForAllExtensions i CollectComments => CollectComments (Group i) where
   collectComments (Group xs) = concatMap collectComments xs
 
 data GrpChoice i = GrpChoice
@@ -498,7 +506,7 @@ deriving instance ForAllExtensions i ToExpr => ToExpr (GrpChoice i)
 instance HasComment (XTerm i) => HasComment (GrpChoice i) where
   commentL = #gcComment % commentL
 
-instance CollectComments (XTerm i) => CollectComments (GrpChoice i) where
+instance ForAllExtensions i CollectComments => CollectComments (GrpChoice i) where
   collectComments (GrpChoice ges c) = collectComments c <> concatMap collectComments ges
 
 -- |
@@ -521,7 +529,7 @@ deriving instance ForAllExtensions i Show => Show (GroupEntry i)
 
 deriving instance ForAllExtensions i ToExpr => ToExpr (GroupEntry i)
 
-instance CollectComments (XTerm i) => CollectComments (GroupEntry i) where
+instance ForAllExtensions i CollectComments => CollectComments (GroupEntry i) where
   collectComments (GroupEntry _ c x) = collectComments c <> collectComments x
 
 data GroupEntryVariant i
@@ -539,7 +547,7 @@ deriving instance ForAllExtensions i ToExpr => ToExpr (GroupEntryVariant i)
 instance HasComment (XTerm i) => HasComment (GroupEntry i) where
   commentL = #geComment % commentL
 
-instance CollectComments (XTerm i) => CollectComments (GroupEntryVariant i) where
+instance ForAllExtensions i CollectComments => CollectComments (GroupEntryVariant i) where
   collectComments (GEType _ t0) = collectComments t0
   collectComments (GERef n mga) = collectComments n <> collectComments mga
   collectComments (GEGroup g) = collectComments g
diff --git a/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs b/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
index b8fab53..535f6f6 100644
--- a/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
@@ -60,45 +60,48 @@ import Data.Text qualified as T
 import GHC.Generics (Generic)
 import Optics.Core
 
-data ProvidedParameters a = ProvidedParameters
-  { parameters :: [Name]
+data ProvidedParameters i a = ProvidedParameters
+  { parameters :: [Name i]
   , underlying :: a
   }
-  deriving (Generic, Functor, Show, Eq, Foldable, Traversable)
+  deriving (Generic, Functor, Foldable, Traversable)
 
-instance Hashable a => Hashable (ProvidedParameters a)
+deriving instance (ForAllExtensions i Eq, Eq a) => Eq (ProvidedParameters i a)
+
+deriving instance (ForAllExtensions i Show, Show a) => Show (ProvidedParameters i a)
 
 --------------------------------------------------------------------------------
 -- 1. Rule extensions
 --------------------------------------------------------------------------------
 
-newtype PartialCTreeRoot i = PartialCTreeRoot (Map.Map Name (ProvidedParameters TypeOrGroup))
+newtype PartialCTreeRoot i
+  = PartialCTreeRoot (Map.Map (Name i) (ProvidedParameters i (TypeOrGroup i)))
   deriving (Generic)
 
-type CDDLMap = Map.Map Name (ProvidedParameters TypeOrGroup)
+type CDDLMap i = Map.Map (Name i) (ProvidedParameters i (TypeOrGroup i))
 
-toParametrised :: a -> Maybe GenericParam -> ProvidedParameters a
+toParametrised :: a -> Maybe (GenericParam i) -> ProvidedParameters i a
 toParametrised a Nothing = ProvidedParameters [] a
 toParametrised a (Just (GenericParam gps)) = ProvidedParameters (NE.toList gps) a
 
-asMap :: CDDL -> CDDLMap
+asMap :: XCddl i ~ [XXTopLevel i] => CDDL i -> CDDLMap i
 asMap cddl = foldl' go Map.empty rules
   where
     rules = cddlTopLevel cddl
-    go x (TopLevelComment _) = x
+    go x (XXTopLevel _) = x
     go x (TopLevelRule r) = assignOrExtend x r
 
-    assignOrExtend :: CDDLMap -> Rule -> CDDLMap
+    assignOrExtend :: CDDLMap i -> Rule i -> CDDLMap i
     assignOrExtend m (Rule n gps assign tog _) = case assign of
       -- Equals assignment
       AssignEq -> Map.insert n (toParametrised tog gps) m
       AssignExt -> Map.alter (extend tog gps) n m
 
     extend ::
-      TypeOrGroup ->
-      Maybe GenericParam ->
-      Maybe (ProvidedParameters TypeOrGroup) ->
-      Maybe (ProvidedParameters TypeOrGroup)
+      TypeOrGroup i ->
+      Maybe (GenericParam i) ->
+      Maybe (ProvidedParameters i (TypeOrGroup i)) ->
+      Maybe (ProvidedParameters i (TypeOrGroup i))
     extend tog _gps (Just existing) = case (underlying existing, tog) of
       (TOGType _, TOGType (Type0 new)) ->
         Just $
@@ -124,10 +127,13 @@ asMap cddl = foldl' go Map.empty rules
 data OrReferenced
 
 -- | Indicates that an item may be referenced rather than defined.
-data OrRef
+data OrRef i
   = -- | Reference to another node with possible generic arguments supplied
-    Ref Name [TypeOrGroup]
-  deriving (Eq, Show, Functor)
+    Ref (Name i) [TypeOrGroup i]
+
+deriving instance ForAllExtensions i Eq => Eq (OrRef i)
+
+deriving instance ForAllExtensions i Show => Show (OrRef i)
 
 deriving instance Show (PartialCTreeRoot OrReferenced)
 
@@ -135,15 +141,16 @@ deriving instance Show (PartialCTreeRoot OrReferenced)
 -- 3. Name resolution
 --------------------------------------------------------------------------------
 
-data NameResolutionFailure
-  = UnboundReference Name
-  | MismatchingArgs Name [Name]
-  | ArgsToPostlude PTerm [TypeOrGroup]
-  deriving (Show)
+data NameResolutionFailure i
+  = UnboundReference (Name i)
+  | MismatchingArgs (Name i) [Name i]
+  | ArgsToPostlude PTerm [TypeOrGroup i]
+
+deriving instance ForAllExtensions i Eq => Eq (NameResolutionFailure i)
 
-deriving instance Eq NameResolutionFailure
+deriving instance ForAllExtensions i Show => Show (NameResolutionFailure i)
 
-postludeBinding :: Map.Map Name PTerm
+postludeBinding :: Map.Map (Name i) PTerm
 postludeBinding =
   Map.fromList
     [ (Name "bool" mempty, PTBool)
@@ -163,34 +170,34 @@ postludeBinding =
     ]
 
 data BindingEnv i j = BindingEnv
-  { global :: Map.Map Name (ProvidedParameters TypeOrGroup)
+  { global :: Map.Map (Name i) (ProvidedParameters i (TypeOrGroup i))
   -- ^ Global name bindings via 'RuleDef'
-  , local :: Map.Map Name TypeOrGroup
+  , local :: Map.Map (Name j) (TypeOrGroup j)
   -- ^ Local bindings for generic parameters
   }
   deriving (Generic)
 
 data DistReferenced
 
-data DistRef
+data DistRef i
   = -- | Reference to a generic parameter
-    GenericRef Name
+    GenericRef (Name i)
   | -- | Reference to a rule definition, possibly with generic arguments
-    RuleRef Name [TypeOrGroup]
-  deriving (Eq, Generic, Show)
+    RuleRef (Name i) [TypeOrGroup i]
+  deriving (Generic)
+
+deriving instance ForAllExtensions i Eq => Eq (DistRef i)
 
-instance Hashable DistRef
+deriving instance ForAllExtensions i Show => Show (DistRef i)
 
 deriving instance Show (PartialCTreeRoot DistReferenced)
 
 deriving instance Eq (PartialCTreeRoot DistReferenced)
 
-instance Hashable (PartialCTreeRoot DistReferenced)
-
 resolveRef ::
   BindingEnv OrReferenced OrReferenced ->
-  OrRef TypeOrGroup ->
-  Either NameResolutionFailure TypeOrGroup
+  OrRef (TypeOrGroup i) ->
+  Either (NameResolutionFailure i) (TypeOrGroup i)
 resolveRef env (Ref n args) = case Map.lookup n postludeBinding of
   Just pterm -> case args of
     [] -> Right $ CTree.Postlude pterm
@@ -209,13 +216,13 @@ resolveRef env (Ref n args) = case Map.lookup n postludeBinding of
 
 resolveCTree ::
   BindingEnv OrReferenced OrReferenced ->
-  TypeOrGroup ->
-  Either NameResolutionFailure TypeOrGroup
+  TypeOrGroup i ->
+  Either (NameResolutionFailure i) (TypeOrGroup i)
 resolveCTree e = CTree.traverseCTree (resolveRef e) (resolveCTree e)
 
 buildResolvedCTree ::
   PartialCTreeRoot OrReferenced ->
-  Either NameResolutionFailure (PartialCTreeRoot DistReferenced)
+  Either (NameResolutionFailure i) (PartialCTreeRoot DistReferenced)
 buildResolvedCTree (PartialCTreeRoot ct) = PartialCTreeRoot <$> traverse go ct
   where
     go pn =
@@ -230,8 +237,8 @@ buildResolvedCTree (PartialCTreeRoot ct) = PartialCTreeRoot <$> traverse go ct
 
 data MonoReferenced
 
-newtype MonoRef a
-  = MRuleRef Name
+newtype MonoRef i
+  = MRuleRef (Name i)
   deriving (Functor, Show)
 
 deriving instance Show (PartialCTreeRoot MonoReferenced)
@@ -239,75 +246,75 @@ deriving instance Show (PartialCTreeRoot MonoReferenced)
 type MonoEnv = BindingEnv DistReferenced MonoReferenced
 
 -- | We introduce additional bindings in the state
-type MonoState = Map.Map Name TypeOrGroup
+type MonoState i = Map.Map (Name i) (TypeOrGroup i)
 
 -- | Monad to run the monomorphisation process. We need some additional
 -- capabilities for this, so 'Either' doesn't fully cut it anymore.
-newtype MonoM a = MonoM
+newtype MonoM i a = MonoM
   { runMonoM ::
       ExceptT
-        NameResolutionFailure
-        (StateT MonoState (Reader MonoEnv))
+        (NameResolutionFailure i)
+        (StateT (MonoState i) (Reader MonoEnv))
         a
   }
   deriving (Functor, Applicative, Monad)
   deriving
-    (HasThrow "nameResolution" NameResolutionFailure)
+    (HasThrow "nameResolution" (NameResolutionFailure i))
     via MonadError
           ( ExceptT
-              NameResolutionFailure
-              (StateT MonoState (Reader MonoEnv))
+              (NameResolutionFailure i)
+              (StateT (MonoState i) (Reader MonoEnv))
           )
   deriving
     ( HasSource
         "local"
-        (Map.Map Name TypeOrGroup)
+        (Map.Map (Name i) (TypeOrGroup i))
     , HasReader
         "local"
-        (Map.Map Name TypeOrGroup)
+        (Map.Map (Name i) (TypeOrGroup i))
     )
     via Field
           "local"
           ()
           ( Lift
               ( ExceptT
-                  NameResolutionFailure
-                  (Lift (StateT MonoState (MonadReader (Reader MonoEnv))))
+                  (NameResolutionFailure i)
+                  (Lift (StateT (MonoState i) (MonadReader (Reader MonoEnv))))
               )
           )
   deriving
     ( HasSource
         "global"
-        (Map.Map Name (ProvidedParameters TypeOrGroup))
+        (Map.Map (Name i) (ProvidedParameters i (TypeOrGroup i)))
     , HasReader
         "global"
-        (Map.Map Name (ProvidedParameters TypeOrGroup))
+        (Map.Map (Name i) (ProvidedParameters i (TypeOrGroup i)))
     )
     via Field
           "global"
           ()
           ( Lift
               ( ExceptT
-                  NameResolutionFailure
-                  (Lift (StateT MonoState (MonadReader (Reader MonoEnv))))
+                  (NameResolutionFailure i)
+                  (Lift (StateT (MonoState i) (MonadReader (Reader MonoEnv))))
               )
           )
   deriving
-    ( HasSource "synth" MonoState
-    , HasSink "synth" MonoState
-    , HasState "synth" MonoState
+    ( HasSource "synth" (MonoState i)
+    , HasSink "synth" (MonoState i)
+    , HasState "synth" (MonoState i)
     )
     via Lift
           ( ExceptT
-              NameResolutionFailure
-              (MonadState (StateT MonoState (Reader MonoEnv)))
+              (NameResolutionFailure i)
+              (MonadState (StateT (MonoState i) (Reader MonoEnv)))
           )
 
-throwNR :: NameResolutionFailure -> MonoM a
+throwNR :: NameResolutionFailure i -> MonoM i a
 throwNR = throw @"nameResolution"
 
 -- | Synthesize a monomorphic rule definition, returning the name
-synthMono :: Name -> [TypeOrGroup] -> MonoM Name
+synthMono :: Name i -> [TypeOrGroup i] -> MonoM i (Name i)
 synthMono n@(Name origName _) args =
   let fresh =
         -- % is not a valid CBOR name, so this should avoid conflict
@@ -330,8 +337,8 @@ synthMono n@(Name origName _) args =
         pure fresh
 
 resolveGenericRef ::
-  TypeOrGroup ->
-  MonoM TypeOrGroup
+  TypeOrGroup i ->
+  MonoM i (TypeOrGroup i)
 resolveGenericRef (RuleRef n []) = pure . CTreeE $ MRuleRef n
 resolveGenericRef (RuleRef n args) = do
   fresh <- synthMono n args
@@ -343,8 +350,8 @@ resolveGenericRef (GenericRef n) = do
     Nothing -> throwNR $ UnboundReference n
 
 resolveGenericCTree ::
-  TypeOrGroup ->
-  MonoM TypeOrGroup
+  TypeOrGroup i ->
+  MonoM i (TypeOrGroup i)
 resolveGenericCTree = CTree.traverseCTree resolveGenericRef resolveGenericCTree
 
 -- | Monomorphise the CTree
@@ -354,7 +361,7 @@ resolveGenericCTree = CTree.traverseCTree resolveGenericRef resolveGenericCTree
 -- parameters applied.
 buildMonoCTree ::
   PartialCTreeRoot DistReferenced ->
-  Either NameResolutionFailure TypeOrGroup
+  Either (NameResolutionFailure i) (TypeOrGroup i)
 buildMonoCTree (PartialCTreeRoot ct) = do
   let a1 = runExceptT $ runMonoM (traverse resolveGenericCTree monoC)
       a2 = runStateT a1 mempty
@@ -374,7 +381,7 @@ buildMonoCTree (PartialCTreeRoot ct) = do
 -- Combined resolution
 --------------------------------------------------------------------------------
 
-fullResolveCDDL :: CDDL -> Either NameResolutionFailure TypeOrGroup
+fullResolveCDDL :: CDDL i -> Either (NameResolutionFailure i) (TypeOrGroup i)
 fullResolveCDDL cddl = do
   let refCTree = buildRefCTree (asMap cddl)
   rCTree <- buildResolvedCTree refCTree
diff --git a/src/Codec/CBOR/Cuddle/Comments.hs b/src/Codec/CBOR/Cuddle/Comments.hs
index 74c789f..e65135e 100644
--- a/src/Codec/CBOR/Cuddle/Comments.hs
+++ b/src/Codec/CBOR/Cuddle/Comments.hs
@@ -26,6 +26,7 @@ import Data.List.NonEmpty (NonEmpty (..))
 import Data.String (IsString (..))
 import Data.Text qualified as T
 import Data.TreeDiff (ToExpr)
+import Data.Void (Void, absurd)
 import Data.Word (Word16, Word32, Word64, Word8)
 import GHC.Generics (Generic (..), K1 (..), M1 (..), U1 (..), V1, (:*:) (..), (:+:) (..))
 import Optics.Core (Lens', lens, view, (%~), (&), (.~), (^.))
@@ -85,6 +86,10 @@ class CollectComments a where
   default collectComments :: (Generic a, GCollectComments (Rep a)) => a -> [Comment]
   collectComments = collectCommentsG . from
 
+instance CollectComments Void where collectComments = absurd
+
+instance CollectComments () where collectComments = mempty
+
 instance CollectComments a => CollectComments (Maybe a) where
   collectComments Nothing = []
   collectComments (Just x) = collectComments x
diff --git a/src/Codec/CBOR/Cuddle/Huddle.hs b/src/Codec/CBOR/Cuddle/Huddle.hs
index eb4669b..c54e526 100644
--- a/src/Codec/CBOR/Cuddle/Huddle.hs
+++ b/src/Codec/CBOR/Cuddle/Huddle.hs
@@ -109,6 +109,12 @@ import GHC.Generics (Generic)
 import Optics.Core (lens, view, (%~), (&), (.~), (^.))
 import Prelude hiding ((/))
 
+data HuddlePhase
+
+type instance C.XTerm HuddlePhase = C.Comment
+
+type instance C.XCddl HuddlePhase = C.Comment
+
 data Named a = Named
   { name :: T.Text
   , value :: a
@@ -432,7 +438,7 @@ unconstrained v = Constrained (CValue v) def []
 -- | A constraint on a 'Value' is something applied via CtlOp or RangeOp on a
 -- Type2, forming a Type1.
 data ValueConstraint a = ValueConstraint
-  { applyConstraint :: C.Type2 -> C.Type1
+  { applyConstraint :: C.Type2 HuddlePhase -> C.Type1 HuddlePhase
   , showConstraint :: String
   }
 
@@ -462,7 +468,7 @@ instance IsSizeable CGRefType
 
 -- | Things which can be used on the RHS of the '.size' operator.
 class IsSize a where
-  sizeAsCDDL :: a -> C.Type2
+  sizeAsCDDL :: a -> C.Type2 HuddlePhase
   sizeAsString :: a -> String
 
 instance IsSize Word where
@@ -1062,15 +1068,15 @@ collectFromInit rules =
 --------------------------------------------------------------------------------
 
 -- | Convert from Huddle to CDDL, generating a top level root element.
-toCDDL :: Huddle -> CDDL
+toCDDL :: Huddle -> CDDL HuddlePhase
 toCDDL = toCDDL' True
 
 -- | Convert from Huddle to CDDL, skipping a root element.
-toCDDLNoRoot :: Huddle -> CDDL
+toCDDLNoRoot :: Huddle -> CDDL HuddlePhase
 toCDDLNoRoot = toCDDL' False
 
 -- | Convert from Huddle to CDDL for the purpose of pretty-printing.
-toCDDL' :: Bool -> Huddle -> CDDL
+toCDDL' :: Bool -> Huddle -> CDDL HuddlePhase
 toCDDL' mkPseudoRoot hdl =
   C.fromRules
     $ ( if mkPseudoRoot
@@ -1082,12 +1088,12 @@ toCDDL' mkPseudoRoot hdl =
     toCDDLItem (HIRule r) = toCDDLRule r
     toCDDLItem (HIGroup g) = toCDDLGroup g
     toCDDLItem (HIGRule g) = toGenRuleDef g
-    toTopLevelPseudoRoot :: [Rule] -> C.Rule
+    toTopLevelPseudoRoot :: [Rule] -> C.Rule HuddlePhase
     toTopLevelPseudoRoot topRs =
       toCDDLRule $
         comment "Pseudo-rule introduced by Cuddle to collect root elements" $
           "huddle_root_defs" =:= arr (fromList (fmap a topRs))
-    toCDDLRule :: Rule -> C.Rule
+    toCDDLRule :: Rule -> C.Rule HuddlePhase
     toCDDLRule (Named n t0 c) =
       (\x -> C.Rule (C.Name n mempty) Nothing C.AssignEq x (foldMap C.Comment c))
         . C.TOGType
@@ -1103,13 +1109,13 @@ toCDDL' mkPseudoRoot hdl =
     toCDDLValue' (LText t) = C.VText t
     toCDDLValue' (LBytes b) = C.VBytes b
 
-    mapToCDDLGroup :: Map -> C.Group
+    mapToCDDLGroup :: Map -> C.Group HuddlePhase
     mapToCDDLGroup xs = C.Group $ mapChoiceToCDDL <$> choiceToNE xs
 
-    mapChoiceToCDDL :: MapChoice -> C.GrpChoice
+    mapChoiceToCDDL :: MapChoice -> C.GrpChoice HuddlePhase
     mapChoiceToCDDL (MapChoice entries) = C.GrpChoice (fmap mapEntryToCDDL entries) mempty
 
-    mapEntryToCDDL :: MapEntry -> C.GroupEntry
+    mapEntryToCDDL :: MapEntry -> C.GroupEntry HuddlePhase
     mapEntryToCDDL (MapEntry k v occ cmnt) =
       C.GroupEntry
         (toOccurrenceIndicator occ)
@@ -1123,7 +1129,7 @@ toCDDL' mkPseudoRoot hdl =
     toOccurrenceIndicator (Occurs (Just 1) Nothing) = Just C.OIOneOrMore
     toOccurrenceIndicator (Occurs lb ub) = Just $ C.OIBounded lb ub
 
-    toCDDLType1 :: Type2 -> C.Type1
+    toCDDLType1 :: Type2 -> C.Type1 HuddlePhase
     toCDDLType1 = \case
       T2Constrained (Constrained x constr _) ->
         -- TODO Need to handle choices at the top level
@@ -1142,28 +1148,28 @@ toCDDL' mkPseudoRoot hdl =
       T2Generic g -> C.Type1 (toGenericCall g) Nothing mempty
       T2GenericRef (GRef n) -> C.Type1 (C.T2Name (C.Name n mempty) Nothing) Nothing mempty
 
-    toMemberKey :: Key -> C.MemberKey
+    toMemberKey :: Key -> C.MemberKey HuddlePhase
     toMemberKey (LiteralKey (Literal (LText t) _)) = C.MKBareword (C.Name t mempty)
     toMemberKey (LiteralKey v) = C.MKValue $ toCDDLValue v
     toMemberKey (TypeKey t) = C.MKType (toCDDLType1 t)
 
-    toCDDLType0 :: Type0 -> C.Type0
+    toCDDLType0 :: Type0 -> C.Type0 HuddlePhase
     toCDDLType0 = C.Type0 . fmap toCDDLType1 . choiceToNE
 
-    arrayToCDDLGroup :: Array -> C.Group
+    arrayToCDDLGroup :: Array -> C.Group HuddlePhase
     arrayToCDDLGroup xs = C.Group $ arrayChoiceToCDDL <$> choiceToNE xs
 
-    arrayChoiceToCDDL :: ArrayChoice -> C.GrpChoice
+    arrayChoiceToCDDL :: ArrayChoice -> C.GrpChoice HuddlePhase
     arrayChoiceToCDDL (ArrayChoice entries cmt) = C.GrpChoice (fmap arrayEntryToCDDL entries) cmt
 
-    arrayEntryToCDDL :: ArrayEntry -> C.GroupEntry
+    arrayEntryToCDDL :: ArrayEntry -> C.GroupEntry HuddlePhase
     arrayEntryToCDDL (ArrayEntry k v occ cmnt) =
       C.GroupEntry
         (toOccurrenceIndicator occ)
         cmnt
         (C.GEType (fmap toMemberKey k) (toCDDLType0 v))
 
-    toCDDLPostlude :: Value a -> C.Name
+    toCDDLPostlude :: Value a -> C.Name HuddlePhase
     toCDDLPostlude VBool = C.Name "bool" mempty
     toCDDLPostlude VUInt = C.Name "uint" mempty
     toCDDLPostlude VNInt = C.Name "nint" mempty
@@ -1181,7 +1187,7 @@ toCDDL' mkPseudoRoot hdl =
       CRef r -> C.Name (name r) mempty
       CGRef (GRef n) -> C.Name n mempty
 
-    toCDDLRanged :: Ranged -> C.Type1
+    toCDDLRanged :: Ranged -> C.Type1 HuddlePhase
     toCDDLRanged (Unranged x) =
       C.Type1 (C.T2Value $ toCDDLValue x) Nothing mempty
     toCDDLRanged (Ranged lb ub rop) =
@@ -1190,11 +1196,11 @@ toCDDL' mkPseudoRoot hdl =
         (Just (C.RangeOp rop, toCDDLRangeBound ub))
         mempty
 
-    toCDDLRangeBound :: RangeBound -> C.Type2
+    toCDDLRangeBound :: RangeBound -> C.Type2 HuddlePhase
     toCDDLRangeBound (RangeBoundLiteral l) = C.T2Value $ toCDDLValue l
     toCDDLRangeBound (RangeBoundRef (Named n _ _)) = C.T2Name (C.Name n mempty) Nothing
 
-    toCDDLGroup :: Named Group -> C.Rule
+    toCDDLGroup :: Named Group -> C.Rule HuddlePhase
     toCDDLGroup (Named n (Group t0s) c) =
       C.Rule
         (C.Name n mempty)
@@ -1212,13 +1218,13 @@ toCDDL' mkPseudoRoot hdl =
         )
         (foldMap C.Comment c)
 
-    toGenericCall :: GRuleCall -> C.Type2
+    toGenericCall :: GRuleCall -> C.Type2 HuddlePhase
     toGenericCall (Named n gr _) =
       C.T2Name
         (C.Name n mempty)
         (Just . C.GenericArg $ fmap toCDDLType1 (args gr))
 
-    toGenRuleDef :: GRuleDef -> C.Rule
+    toGenRuleDef :: GRuleDef -> C.Rule HuddlePhase
     toGenRuleDef (Named n gr c) =
       C.Rule
         (C.Name n mempty)
diff --git a/src/Codec/CBOR/Cuddle/Pretty.hs b/src/Codec/CBOR/Cuddle/Pretty.hs
index 5b830c6..fe1b0f2 100644
--- a/src/Codec/CBOR/Cuddle/Pretty.hs
+++ b/src/Codec/CBOR/Cuddle/Pretty.hs
@@ -27,12 +27,15 @@ import Data.Foldable (Foldable (..))
 import Data.List.NonEmpty qualified as NE
 import Data.String (fromString)
 import Data.Text qualified as T
+import Data.Void (Void, absurd)
 import Prettyprinter
 
 data PrettyStage
 
 type instance XXTopLevel PrettyStage = Comment
 
+type instance XXType2 PrettyStage = Void
+
 type instance XTerm PrettyStage = Comment
 
 type instance XCddl PrettyStage = [Comment]
@@ -140,6 +143,7 @@ instance Pretty (Type2 PrettyStage) where
       Nothing -> mempty
       Just minor -> "." <> pretty minor
   pretty T2Any = "#"
+  pretty (XXType2 v) = absurd v
 
 instance Pretty OccurrenceIndicator where
   pretty OIOptional = "?"

From 3076a451f6bd879de8fedc54aaa46576c9456c1e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Tue, 7 Oct 2025 15:29:54 +0300
Subject: [PATCH 07/15] WIP

---
 cuddle.cabal                          |   1 +
 src/Codec/CBOR/Cuddle/CDDL/CTree.hs   | 107 +++++++
 src/Codec/CBOR/Cuddle/CDDL/Resolve.hs | 435 ++++++++++++++++++--------
 3 files changed, 414 insertions(+), 129 deletions(-)
 create mode 100644 src/Codec/CBOR/Cuddle/CDDL/CTree.hs

diff --git a/cuddle.cabal b/cuddle.cabal
index 6f44506..4d300f4 100644
--- a/cuddle.cabal
+++ b/cuddle.cabal
@@ -46,6 +46,7 @@ library
     Codec.CBOR.Cuddle.CBOR.Gen
     Codec.CBOR.Cuddle.CBOR.Validator
     Codec.CBOR.Cuddle.CDDL
+    Codec.CBOR.Cuddle.CDDL.CTree
     Codec.CBOR.Cuddle.CDDL.CtlOp
     Codec.CBOR.Cuddle.CDDL.Postlude
     Codec.CBOR.Cuddle.CDDL.Resolve
diff --git a/src/Codec/CBOR/Cuddle/CDDL/CTree.hs b/src/Codec/CBOR/Cuddle/CDDL/CTree.hs
new file mode 100644
index 0000000..a50a31d
--- /dev/null
+++ b/src/Codec/CBOR/Cuddle/CDDL/CTree.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Codec.CBOR.Cuddle.CDDL.CTree where
+
+import Codec.CBOR.Cuddle.CDDL (
+  Name,
+  OccurrenceIndicator,
+  RangeBound,
+  Value,
+  XCddl,
+  XTerm,
+  XXTopLevel,
+ )
+import Codec.CBOR.Cuddle.CDDL.CtlOp
+import Codec.CBOR.Cuddle.CDDL.Postlude (PTerm)
+import Codec.CBOR.Cuddle.Comments (Comment)
+import Data.Hashable (Hashable)
+import Data.List.NonEmpty qualified as NE
+import Data.Map.Strict qualified as Map
+import Data.Word (Word64)
+import GHC.Generics (Generic)
+
+data CTreePhase
+
+type instance XTerm CTreePhase = Comment
+
+type instance XCddl CTreePhase = [Comment]
+
+type instance XXTopLevel CTreePhase = Comment
+
+--------------------------------------------------------------------------------
+
+-- * Resolved CDDL Tree
+
+--
+-- This is a simplified representation of CDDL. It is technically more general -
+-- that is, the structure can represent invalid CDDL - but is in that way easier
+-- to manipulate.
+--------------------------------------------------------------------------------
+
+-- | CDDL Tree, parametrised over a functor
+--
+--   We principally use this functor to represent references - thus, every 'f a'
+--   may be either an a or a reference to another CTree.
+data CTree f
+  = Literal Value
+  | Postlude PTerm
+  | Map [Node f]
+  | Array [Node f]
+  | Choice (NE.NonEmpty (Node f))
+  | Group [Node f]
+  | KV {key :: Node f, value :: Node f, cut :: Bool}
+  | Occur {item :: Node f, occurs :: OccurrenceIndicator}
+  | Range {from :: Node f, to :: Node f, inclusive :: RangeBound}
+  | Control {op :: CtlOp, target :: Node f, controller :: Node f}
+  | Enum (Node f)
+  | Unwrap (Node 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
+traverseCTree _ (Postlude a) = pure $ Postlude a
+traverseCTree atNode (Map xs) = Map <$> traverse atNode xs
+traverseCTree atNode (Array xs) = Array <$> traverse atNode xs
+traverseCTree atNode (Group xs) = Group <$> traverse atNode xs
+traverseCTree atNode (Choice xs) = Choice <$> traverse atNode xs
+traverseCTree atNode (KV k v c) = do
+  k' <- atNode k
+  v' <- atNode v
+  pure $ KV k' v' c
+traverseCTree atNode (Occur i occ) = flip Occur occ <$> atNode i
+traverseCTree atNode (Range f t inc) = do
+  f' <- atNode f
+  t' <- atNode t
+  pure $ Range f' t' inc
+traverseCTree atNode (Control o t c) = do
+  t' <- atNode t
+  c' <- atNode c
+  pure $ Control o t' c'
+traverseCTree atNode (Enum ref) = Enum <$> atNode ref
+traverseCTree atNode (Unwrap ref) = Unwrap <$> atNode ref
+traverseCTree atNode (Tag i ref) = Tag i <$> atNode ref
+
+type Node f = f (CTree f)
+
+newtype CTreeRoot' poly f
+  = CTreeRoot
+      (Map.Map (Name CTreePhase) (poly (Node f)))
+  deriving (Generic)
+
+type CTreeRoot f = CTreeRoot' (ParametrisedWith [Name CTreePhase]) f
+
+data ParametrisedWith w a
+  = Unparametrised {underlying :: a}
+  | Parametrised
+      { underlying :: a
+      , params :: w
+      }
+  deriving (Eq, Functor, Generic, Foldable, Traversable, Show)
+
+instance (Hashable w, Hashable a) => Hashable (ParametrisedWith w a)
diff --git a/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs b/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
index 535f6f6..e8fe62e 100644
--- a/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
@@ -2,9 +2,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -27,12 +25,13 @@
 --    generic arguments bound.
 module Codec.CBOR.Cuddle.CDDL.Resolve (
   buildResolvedCTree,
+  buildRefCTree,
   asMap,
   buildMonoCTree,
   fullResolveCDDL,
-  NameResolutionFailure (..),
-  MonoReferenced,
   MonoRef (..),
+  OrRef (..),
+  NameResolutionFailure (..),
 )
 where
 
@@ -43,11 +42,20 @@ import Capability.Reader qualified as Reader (local)
 import Capability.Sink (HasSink)
 import Capability.Source (HasSource)
 import Capability.State (HasState, MonadState (..), modify)
-import Codec.CBOR.Cuddle.CDDL as CDDL
+import Codec.CBOR.Cuddle.CDDL
+import Codec.CBOR.Cuddle.CDDL.CTree (
+  CTree,
+  CTreePhase,
+  CTreeRoot,
+  CTreeRoot' (CTreeRoot),
+  ParametrisedWith (..),
+ )
+import Codec.CBOR.Cuddle.CDDL.CTree qualified as CTree
 import Codec.CBOR.Cuddle.CDDL.Postlude (PTerm (..))
 import Control.Monad.Except (ExceptT (..), runExceptT)
 import Control.Monad.Reader (Reader, ReaderT (..), runReader)
 import Control.Monad.State.Strict (StateT (..))
+import Data.Functor.Identity (Identity (..))
 import Data.Generics.Product
 import Data.Generics.Sum
 import Data.Hashable
@@ -60,48 +68,40 @@ import Data.Text qualified as T
 import GHC.Generics (Generic)
 import Optics.Core
 
-data ProvidedParameters i a = ProvidedParameters
-  { parameters :: [Name i]
-  , underlying :: a
-  }
-  deriving (Generic, Functor, Foldable, Traversable)
-
-deriving instance (ForAllExtensions i Eq, Eq a) => Eq (ProvidedParameters i a)
-
-deriving instance (ForAllExtensions i Show, Show a) => Show (ProvidedParameters i a)
-
 --------------------------------------------------------------------------------
 -- 1. Rule extensions
 --------------------------------------------------------------------------------
 
-newtype PartialCTreeRoot i
-  = PartialCTreeRoot (Map.Map (Name i) (ProvidedParameters i (TypeOrGroup i)))
-  deriving (Generic)
+type CDDLMap = Map.Map (Name CTreePhase) (Parametrised (TypeOrGroup CTreePhase))
+
+type Parametrised a = ParametrisedWith [Name CTreePhase] a
 
-type CDDLMap i = Map.Map (Name i) (ProvidedParameters i (TypeOrGroup i))
+toParametrised :: a -> Maybe (GenericParam CTreePhase) -> Parametrised a
+toParametrised a Nothing = Unparametrised a
+toParametrised a (Just (GenericParam gps)) = Parametrised a (NE.toList gps)
 
-toParametrised :: a -> Maybe (GenericParam i) -> ProvidedParameters i a
-toParametrised a Nothing = ProvidedParameters [] a
-toParametrised a (Just (GenericParam gps)) = ProvidedParameters (NE.toList gps) a
+parameters :: Parametrised a -> [Name CTreePhase]
+parameters (Unparametrised _) = mempty
+parameters (Parametrised _ ps) = ps
 
-asMap :: XCddl i ~ [XXTopLevel i] => CDDL i -> CDDLMap i
+asMap :: CDDL CTreePhase -> CDDLMap
 asMap cddl = foldl' go Map.empty rules
   where
     rules = cddlTopLevel cddl
     go x (XXTopLevel _) = x
     go x (TopLevelRule r) = assignOrExtend x r
 
-    assignOrExtend :: CDDLMap i -> Rule i -> CDDLMap i
+    assignOrExtend :: CDDLMap -> Rule CTreePhase -> CDDLMap
     assignOrExtend m (Rule n gps assign tog _) = case assign of
       -- Equals assignment
       AssignEq -> Map.insert n (toParametrised tog gps) m
       AssignExt -> Map.alter (extend tog gps) n m
 
     extend ::
-      TypeOrGroup i ->
-      Maybe (GenericParam i) ->
-      Maybe (ProvidedParameters i (TypeOrGroup i)) ->
-      Maybe (ProvidedParameters i (TypeOrGroup i))
+      TypeOrGroup CTreePhase ->
+      Maybe (GenericParam CTreePhase) ->
+      Maybe (Parametrised (TypeOrGroup CTreePhase)) ->
+      Maybe (Parametrised (TypeOrGroup CTreePhase))
     extend tog _gps (Just existing) = case (underlying existing, tog) of
       (TOGType _, TOGType (Type0 new)) ->
         Just $
@@ -124,33 +124,190 @@ asMap cddl = foldl' go Map.empty rules
 -- 2. Conversion to CTree
 --------------------------------------------------------------------------------
 
-data OrReferenced
-
 -- | Indicates that an item may be referenced rather than defined.
-data OrRef i
-  = -- | Reference to another node with possible generic arguments supplied
-    Ref (Name i) [TypeOrGroup i]
+data OrRef a
+  = -- | The item is inlined directly
+    It a
+  | -- | Reference to another node with possible generic arguments supplied
+    Ref (Name CTreePhase) [CTree.Node OrRef]
+  deriving (Eq, Show, Functor)
 
-deriving instance ForAllExtensions i Eq => Eq (OrRef i)
+type RefCTree = CTreeRoot OrRef
 
-deriving instance ForAllExtensions i Show => Show (OrRef i)
+deriving instance Show (CTree OrRef)
 
-deriving instance Show (PartialCTreeRoot OrReferenced)
+deriving instance Show (CTreeRoot OrRef)
+
+-- | Build a CTree incorporating references.
+--
+-- This translation cannot fail.
+buildRefCTree :: CDDLMap -> RefCTree
+buildRefCTree rules = CTreeRoot $ fmap toCTreeRule rules
+  where
+    toCTreeRule ::
+      Parametrised (TypeOrGroup CTreePhase) ->
+      ParametrisedWith [Name CTreePhase] (CTree.Node OrRef)
+    toCTreeRule = fmap toCTreeTOG
+
+    toCTreeTOG :: TypeOrGroup CTreePhase -> CTree.Node OrRef
+    toCTreeTOG (TOGType t0) = toCTreeT0 t0
+    toCTreeTOG (TOGGroup ge) = toCTreeGroupEntry ge
+
+    toCTreeT0 :: Type0 CTreePhase -> CTree.Node OrRef
+    toCTreeT0 (Type0 (t1 NE.:| [])) = toCTreeT1 t1
+    toCTreeT0 (Type0 xs) = It . CTree.Choice $ toCTreeT1 <$> xs
+
+    toCTreeT1 :: Type1 CTreePhase -> CTree.Node OrRef
+    toCTreeT1 (Type1 t2 Nothing _) = toCTreeT2 t2
+    toCTreeT1 (Type1 t2 (Just (op, t2')) _) = case op of
+      RangeOp bound ->
+        It $
+          CTree.Range
+            { CTree.from = toCTreeT2 t2
+            , CTree.to = toCTreeT2 t2'
+            , CTree.inclusive = bound
+            }
+      CtrlOp ctlop ->
+        It $
+          CTree.Control
+            { CTree.op = ctlop
+            , CTree.target = toCTreeT2 t2
+            , CTree.controller = toCTreeT2 t2'
+            }
+
+    toCTreeT2 :: Type2 CTreePhase -> CTree.Node OrRef
+    toCTreeT2 (T2Value v) = It $ CTree.Literal v
+    toCTreeT2 (T2Name n garg) =
+      Ref n (fromGenArgs garg)
+    toCTreeT2 (T2Group t0) =
+      -- This behaviour seems questionable, but I don't really see how better to
+      -- interpret the spec here.
+      toCTreeT0 t0
+    toCTreeT2 (T2Map g) = toCTreeMap g
+    toCTreeT2 (T2Array g) = toCTreeArray g
+    toCTreeT2 (T2Unwrapped n margs) =
+      It . CTree.Unwrap $
+        Ref n (fromGenArgs margs)
+    toCTreeT2 (T2Enum g) = toCTreeEnum g
+    toCTreeT2 (T2EnumRef n margs) = Ref n $ fromGenArgs margs
+    toCTreeT2 (T2Tag Nothing t0) =
+      -- Currently not validating tags
+      toCTreeT0 t0
+    toCTreeT2 (T2Tag (Just tag) t0) =
+      It . CTree.Tag tag $ toCTreeT0 t0
+    toCTreeT2 (T2DataItem 7 (Just mmin)) =
+      toCTreeDataItem mmin
+    toCTreeT2 (T2DataItem _maj _mmin) =
+      -- We don't validate numerical items yet
+      It $ CTree.Postlude PTAny
+    toCTreeT2 T2Any = It $ CTree.Postlude PTAny
+
+    toCTreeDataItem 20 =
+      It . CTree.Literal $ Value (VBool False) mempty
+    toCTreeDataItem 21 =
+      It . CTree.Literal $ Value (VBool True) mempty
+    toCTreeDataItem 25 =
+      It $ CTree.Postlude PTHalf
+    toCTreeDataItem 26 =
+      It $ CTree.Postlude PTFloat
+    toCTreeDataItem 27 =
+      It $ CTree.Postlude PTDouble
+    toCTreeDataItem 23 =
+      It $ CTree.Postlude PTUndefined
+    toCTreeDataItem _ =
+      It $ CTree.Postlude PTAny
+
+    toCTreeGroupEntry :: GroupEntry CTreePhase -> CTree.Node OrRef
+    toCTreeGroupEntry (GroupEntry (Just occi) _ (GEType mmkey t0)) =
+      It $
+        CTree.Occur
+          { CTree.item = toKVPair mmkey t0
+          , CTree.occurs = occi
+          }
+    toCTreeGroupEntry (GroupEntry Nothing _ (GEType mmkey t0)) = toKVPair mmkey t0
+    toCTreeGroupEntry (GroupEntry (Just occi) _ (GERef n margs)) =
+      It $
+        CTree.Occur
+          { CTree.item = Ref n (fromGenArgs margs)
+          , CTree.occurs = occi
+          }
+    toCTreeGroupEntry (GroupEntry Nothing _ (GERef n margs)) = Ref n (fromGenArgs margs)
+    toCTreeGroupEntry (GroupEntry (Just occi) _ (GEGroup g)) =
+      It $
+        CTree.Occur
+          { CTree.item = groupToGroup g
+          , CTree.occurs = occi
+          }
+    toCTreeGroupEntry (GroupEntry Nothing _ (GEGroup g)) = groupToGroup g
+
+    fromGenArgs :: Maybe (GenericArg CTreePhase) -> [CTree.Node OrRef]
+    fromGenArgs = maybe [] (\(GenericArg xs) -> NE.toList $ fmap toCTreeT1 xs)
+
+    -- Interpret a group as an enumeration. Note that we float out the
+    -- choice options
+    toCTreeEnum :: Group CTreePhase -> CTree.Node OrRef
+    toCTreeEnum (Group (a NE.:| [])) =
+      It . CTree.Enum . It . CTree.Group $ toCTreeGroupEntry <$> gcGroupEntries a
+    toCTreeEnum (Group xs) =
+      It . CTree.Choice $
+        It . CTree.Enum . It . CTree.Group . fmap toCTreeGroupEntry <$> groupEntries
+      where
+        groupEntries = fmap gcGroupEntries xs
+
+    -- Embed a group in another group, again floating out the choice options
+    groupToGroup :: Group CTreePhase -> CTree.Node OrRef
+    groupToGroup (Group (a NE.:| [])) =
+      It . CTree.Group $ fmap toCTreeGroupEntry (gcGroupEntries a)
+    groupToGroup (Group xs) =
+      It . CTree.Choice $
+        fmap (It . CTree.Group . fmap toCTreeGroupEntry) (gcGroupEntries <$> xs)
+
+    toKVPair :: Maybe (MemberKey CTreePhase) -> Type0 CTreePhase -> CTree.Node OrRef
+    toKVPair Nothing t0 = toCTreeT0 t0
+    toKVPair (Just mkey) t0 =
+      It $
+        CTree.KV
+          { CTree.key = toCTreeMemberKey mkey
+          , CTree.value = toCTreeT0 t0
+          , -- TODO Handle cut semantics
+            CTree.cut = False
+          }
+
+    -- Interpret a group as a map. Note that we float out the choice options
+    toCTreeMap :: Group CTreePhase -> CTree.Node OrRef
+    toCTreeMap (Group (a NE.:| [])) = It . CTree.Map $ fmap toCTreeGroupEntry (gcGroupEntries a)
+    toCTreeMap (Group xs) =
+      It
+        . CTree.Choice
+        $ fmap (It . CTree.Map . fmap toCTreeGroupEntry) (gcGroupEntries <$> xs)
+
+    -- Interpret a group as an array. Note that we float out the choice
+    -- options
+    toCTreeArray :: Group CTreePhase -> CTree.Node OrRef
+    toCTreeArray (Group (a NE.:| [])) =
+      It . CTree.Array $ fmap toCTreeGroupEntry (gcGroupEntries a)
+    toCTreeArray (Group xs) =
+      It . CTree.Choice $
+        fmap (It . CTree.Array . fmap toCTreeGroupEntry) (gcGroupEntries <$> xs)
+
+    toCTreeMemberKey :: MemberKey CTreePhase -> CTree.Node OrRef
+    toCTreeMemberKey (MKValue v) = It $ CTree.Literal v
+    toCTreeMemberKey (MKBareword (Name n _)) = It $ CTree.Literal (Value (VText n) mempty)
+    toCTreeMemberKey (MKType t1) = toCTreeT1 t1
 
 --------------------------------------------------------------------------------
 -- 3. Name resolution
 --------------------------------------------------------------------------------
 
-data NameResolutionFailure i
-  = UnboundReference (Name i)
-  | MismatchingArgs (Name i) [Name i]
-  | ArgsToPostlude PTerm [TypeOrGroup i]
+data NameResolutionFailure
+  = UnboundReference (Name CTreePhase)
+  | MismatchingArgs (Name CTreePhase) [Name CTreePhase]
+  | ArgsToPostlude PTerm [CTree.Node OrRef]
+  deriving (Show)
 
-deriving instance ForAllExtensions i Eq => Eq (NameResolutionFailure i)
+deriving instance Eq (OrRef (CTree OrRef)) => Eq NameResolutionFailure
 
-deriving instance ForAllExtensions i Show => Show (NameResolutionFailure i)
-
-postludeBinding :: Map.Map (Name i) PTerm
+postludeBinding :: Map.Map (Name CTreePhase) PTerm
 postludeBinding =
   Map.fromList
     [ (Name "bool" mempty, PTBool)
@@ -169,152 +326,160 @@ postludeBinding =
     , (Name "null" mempty, PTNil)
     ]
 
-data BindingEnv i j = BindingEnv
-  { global :: Map.Map (Name i) (ProvidedParameters i (TypeOrGroup i))
+data BindingEnv poly f g = BindingEnv
+  { global :: Map.Map (Name CTreePhase) (poly (CTree.Node f))
   -- ^ Global name bindings via 'RuleDef'
-  , local :: Map.Map (Name j) (TypeOrGroup j)
+  , local :: Map.Map (Name CTreePhase) (CTree.Node g)
   -- ^ Local bindings for generic parameters
   }
   deriving (Generic)
 
-data DistReferenced
-
-data DistRef i
-  = -- | Reference to a generic parameter
-    GenericRef (Name i)
+data DistRef a
+  = DIt a
+  | -- | Reference to a generic parameter
+    GenericRef (Name CTreePhase)
   | -- | Reference to a rule definition, possibly with generic arguments
-    RuleRef (Name i) [TypeOrGroup i]
-  deriving (Generic)
+    RuleRef (Name CTreePhase) [CTree.Node DistRef]
+  deriving (Eq, Generic, Functor, Show)
 
-deriving instance ForAllExtensions i Eq => Eq (DistRef i)
+instance Hashable (DistRef a)
 
-deriving instance ForAllExtensions i Show => Show (DistRef i)
+deriving instance Show (CTree DistRef)
 
-deriving instance Show (PartialCTreeRoot DistReferenced)
+instance Hashable (CTree DistRef)
 
-deriving instance Eq (PartialCTreeRoot DistReferenced)
+deriving instance Show (CTreeRoot DistRef)
+
+deriving instance Eq (CTreeRoot DistRef)
+
+instance Hashable (CTreeRoot DistRef)
 
 resolveRef ::
-  BindingEnv OrReferenced OrReferenced ->
-  OrRef (TypeOrGroup i) ->
-  Either (NameResolutionFailure i) (TypeOrGroup i)
+  BindingEnv (ParametrisedWith [Name CTreePhase]) OrRef OrRef ->
+  CTree.Node OrRef ->
+  Either NameResolutionFailure (DistRef (CTree DistRef))
+resolveRef env (It a) = DIt <$> resolveCTree env a
 resolveRef env (Ref n args) = case Map.lookup n postludeBinding of
   Just pterm -> case args of
-    [] -> Right $ CTree.Postlude pterm
+    [] -> Right . DIt $ CTree.Postlude pterm
     xs -> Left $ ArgsToPostlude pterm xs
   Nothing -> case Map.lookup n (global env) of
     Just (parameters -> params') ->
       if length params' == length args
         then
           let localBinds = Map.fromList $ zip params' args
-              newEnv = env & #local %~ Map.union localBinds
-           in CTreeE . RuleRef n <$> traverse (resolveCTree newEnv) args
+              newEnv = env & field @"local" %~ Map.union localBinds
+           in RuleRef n <$> traverse (resolveRef newEnv) args
         else Left $ MismatchingArgs n params'
     Nothing -> case Map.lookup n (local env) of
-      Just _ -> Right . CTreeE $ GenericRef n
+      Just _ -> Right $ GenericRef n
       Nothing -> Left $ UnboundReference n
 
 resolveCTree ::
-  BindingEnv OrReferenced OrReferenced ->
-  TypeOrGroup i ->
-  Either (NameResolutionFailure i) (TypeOrGroup i)
-resolveCTree e = CTree.traverseCTree (resolveRef e) (resolveCTree e)
+  BindingEnv (ParametrisedWith [Name CTreePhase]) OrRef OrRef ->
+  CTree OrRef ->
+  Either NameResolutionFailure (CTree DistRef)
+resolveCTree e = CTree.traverseCTree (resolveRef e)
 
 buildResolvedCTree ::
-  PartialCTreeRoot OrReferenced ->
-  Either (NameResolutionFailure i) (PartialCTreeRoot DistReferenced)
-buildResolvedCTree (PartialCTreeRoot ct) = PartialCTreeRoot <$> traverse go ct
+  CTreeRoot OrRef ->
+  Either NameResolutionFailure (CTreeRoot DistRef)
+buildResolvedCTree (CTreeRoot ct) = CTreeRoot <$> traverse go ct
   where
+    initBindingEnv = BindingEnv ct mempty
     go pn =
       let args = parameters pn
-          localBinds = Map.fromList $ zip args (CTreeE . flip Ref [] <$> args)
-          env = BindingEnv @OrReferenced @OrReferenced ct localBinds
-       in traverse (resolveCTree env) pn
+          localBinds = Map.fromList $ zip args (flip Ref [] <$> args)
+          env = initBindingEnv & field @"local" %~ Map.union localBinds
+       in traverse (resolveRef env) pn
 
 --------------------------------------------------------------------------------
 -- 4. Monomorphisation
 --------------------------------------------------------------------------------
 
-data MonoReferenced
-
-newtype MonoRef i
-  = MRuleRef (Name i)
+data MonoRef a
+  = MIt a
+  | MRuleRef (Name CTreePhase)
   deriving (Functor, Show)
 
-deriving instance Show (PartialCTreeRoot MonoReferenced)
+deriving instance Show (CTree MonoRef)
+
+deriving instance
+  Show (poly (CTree.Node MonoRef)) =>
+  Show (CTreeRoot' poly MonoRef)
 
-type MonoEnv = BindingEnv DistReferenced MonoReferenced
+type MonoEnv = BindingEnv (ParametrisedWith [Name CTreePhase]) DistRef MonoRef
 
 -- | We introduce additional bindings in the state
-type MonoState i = Map.Map (Name i) (TypeOrGroup i)
+type MonoState = Map.Map (Name CTreePhase) (CTree.Node MonoRef)
 
 -- | Monad to run the monomorphisation process. We need some additional
 -- capabilities for this, so 'Either' doesn't fully cut it anymore.
-newtype MonoM i a = MonoM
+newtype MonoM a = MonoM
   { runMonoM ::
       ExceptT
-        (NameResolutionFailure i)
-        (StateT (MonoState i) (Reader MonoEnv))
+        NameResolutionFailure
+        (StateT MonoState (Reader MonoEnv))
         a
   }
   deriving (Functor, Applicative, Monad)
   deriving
-    (HasThrow "nameResolution" (NameResolutionFailure i))
+    (HasThrow "nameResolution" NameResolutionFailure)
     via MonadError
           ( ExceptT
-              (NameResolutionFailure i)
-              (StateT (MonoState i) (Reader MonoEnv))
+              NameResolutionFailure
+              (StateT MonoState (Reader MonoEnv))
           )
   deriving
     ( HasSource
         "local"
-        (Map.Map (Name i) (TypeOrGroup i))
+        (Map.Map (Name CTreePhase) (CTree.Node MonoRef))
     , HasReader
         "local"
-        (Map.Map (Name i) (TypeOrGroup i))
+        (Map.Map (Name CTreePhase) (CTree.Node MonoRef))
     )
     via Field
           "local"
           ()
           ( Lift
               ( ExceptT
-                  (NameResolutionFailure i)
-                  (Lift (StateT (MonoState i) (MonadReader (Reader MonoEnv))))
+                  NameResolutionFailure
+                  (Lift (StateT MonoState (MonadReader (Reader MonoEnv))))
               )
           )
   deriving
     ( HasSource
         "global"
-        (Map.Map (Name i) (ProvidedParameters i (TypeOrGroup i)))
+        (Map.Map (Name CTreePhase) (ParametrisedWith [Name CTreePhase] (CTree.Node DistRef)))
     , HasReader
         "global"
-        (Map.Map (Name i) (ProvidedParameters i (TypeOrGroup i)))
+        (Map.Map (Name CTreePhase) (ParametrisedWith [Name CTreePhase] (CTree.Node DistRef)))
     )
     via Field
           "global"
           ()
           ( Lift
               ( ExceptT
-                  (NameResolutionFailure i)
-                  (Lift (StateT (MonoState i) (MonadReader (Reader MonoEnv))))
+                  NameResolutionFailure
+                  (Lift (StateT MonoState (MonadReader (Reader MonoEnv))))
               )
           )
   deriving
-    ( HasSource "synth" (MonoState i)
-    , HasSink "synth" (MonoState i)
-    , HasState "synth" (MonoState i)
+    ( HasSource "synth" MonoState
+    , HasSink "synth" MonoState
+    , HasState "synth" MonoState
     )
     via Lift
           ( ExceptT
-              (NameResolutionFailure i)
-              (MonadState (StateT (MonoState i) (Reader MonoEnv)))
+              NameResolutionFailure
+              (MonadState (StateT MonoState (Reader MonoEnv)))
           )
 
-throwNR :: NameResolutionFailure i -> MonoM i a
+throwNR :: NameResolutionFailure -> MonoM a
 throwNR = throw @"nameResolution"
 
 -- | Synthesize a monomorphic rule definition, returning the name
-synthMono :: Name i -> [TypeOrGroup i] -> MonoM i (Name i)
+synthMono :: Name CTreePhase -> [CTree.Node DistRef] -> MonoM (Name CTreePhase)
 synthMono n@(Name origName _) args =
   let fresh =
         -- % is not a valid CBOR name, so this should avoid conflict
@@ -323,26 +488,29 @@ synthMono n@(Name origName _) args =
         -- Lookup the original name in the global bindings
         globalBinds <- ask @"global"
         case Map.lookup n globalBinds of
-          Just (ProvidedParameters [] _) -> throwNR $ MismatchingArgs n []
-          Just (ProvidedParameters params' r) ->
+          Just (Unparametrised _) -> throwNR $ MismatchingArgs n []
+          Just (Parametrised r params') ->
             if length params' == length args
               then do
-                rargs <- traverse resolveGenericCTree args
+                rargs <- traverse resolveGenericRef args
                 let localBinds = Map.fromList $ zip params' rargs
                 Reader.local @"local" (Map.union localBinds) $ do
-                  foo <- resolveGenericCTree r
+                  foo <- resolveGenericRef r
                   modify @"synth" $ Map.insert fresh foo
               else throwNR $ MismatchingArgs n params'
           Nothing -> throwNR $ UnboundReference n
         pure fresh
 
 resolveGenericRef ::
-  TypeOrGroup i ->
-  MonoM i (TypeOrGroup i)
-resolveGenericRef (RuleRef n []) = pure . CTreeE $ MRuleRef n
-resolveGenericRef (RuleRef n args) = do
-  fresh <- synthMono n args
-  pure . CTreeE $ MRuleRef fresh
+  CTree.Node DistRef ->
+  MonoM (MonoRef (CTree MonoRef))
+resolveGenericRef (DIt a) = MIt <$> resolveGenericCTree a
+resolveGenericRef (RuleRef n margs) =
+  case margs of
+    [] -> pure $ MRuleRef n
+    args -> do
+      fresh <- synthMono n args
+      pure $ MRuleRef fresh
 resolveGenericRef (GenericRef n) = do
   localBinds <- ask @"local"
   case Map.lookup n localBinds of
@@ -350,38 +518,47 @@ resolveGenericRef (GenericRef n) = do
     Nothing -> throwNR $ UnboundReference n
 
 resolveGenericCTree ::
-  TypeOrGroup i ->
-  MonoM i (TypeOrGroup i)
-resolveGenericCTree = CTree.traverseCTree resolveGenericRef resolveGenericCTree
+  CTree DistRef ->
+  MonoM (CTree MonoRef)
+resolveGenericCTree = CTree.traverseCTree resolveGenericRef
 
 -- | Monomorphise the CTree
 --
 -- Concretely, for each reference in the tree to a generic rule, we synthesize a
 -- new monomorphic instance of that rule at top-level with the correct
 -- parameters applied.
+monoCTree ::
+  CTreeRoot' Identity DistRef ->
+  MonoM (CTreeRoot' Identity MonoRef)
+monoCTree (CTreeRoot ct) = CTreeRoot <$> traverse go ct
+  where
+    go = traverse resolveGenericRef
+
 buildMonoCTree ::
-  PartialCTreeRoot DistReferenced ->
-  Either (NameResolutionFailure i) (TypeOrGroup i)
-buildMonoCTree (PartialCTreeRoot ct) = do
-  let a1 = runExceptT $ runMonoM (traverse resolveGenericCTree monoC)
+  CTreeRoot DistRef ->
+  Either NameResolutionFailure (CTreeRoot' Identity MonoRef)
+buildMonoCTree (CTreeRoot ct) = do
+  let a1 = runExceptT $ runMonoM (monoCTree monoC)
       a2 = runStateT a1 mempty
-      (r, newBindings) = runReader a2 initBindingEnv
-  CTreeRoot . (`Map.union` newBindings) <$> r
+      (er, newBindings) = runReader a2 initBindingEnv
+  CTreeRoot r <- er
+  pure . CTreeRoot $ Map.union r $ fmap Identity newBindings
   where
     initBindingEnv = BindingEnv ct mempty
     monoC =
-      Map.mapMaybe
-        ( \case
-            ProvidedParameters [] f -> Just f
-            _ -> Nothing
-        )
-        ct
+      CTreeRoot $
+        Map.mapMaybe
+          ( \case
+              Unparametrised f -> Just $ Identity f
+              Parametrised _ _ -> Nothing
+          )
+          ct
 
 --------------------------------------------------------------------------------
 -- Combined resolution
 --------------------------------------------------------------------------------
 
-fullResolveCDDL :: CDDL i -> Either (NameResolutionFailure i) (TypeOrGroup i)
+fullResolveCDDL :: CDDL CTreePhase -> Either NameResolutionFailure (CTreeRoot' Identity MonoRef)
 fullResolveCDDL cddl = do
   let refCTree = buildRefCTree (asMap cddl)
   rCTree <- buildResolvedCTree refCTree

From b280cd45ceec0b30390a4cebc767fcbfec2efce5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Tue, 7 Oct 2025 19:07:51 +0300
Subject: [PATCH 08/15] added IndexMappable instances

---
 bin/Main.hs                             |  46 +--
 cuddle.cabal                            |   1 +
 src/Codec/CBOR/Cuddle/CBOR/Gen.hs       |   8 +-
 src/Codec/CBOR/Cuddle/CBOR/Validator.hs |   4 +-
 src/Codec/CBOR/Cuddle/CDDL.hs           |  50 ++-
 src/Codec/CBOR/Cuddle/CDDL/CTree.hs     | 103 +++---
 src/Codec/CBOR/Cuddle/CDDL/Postlude.hs  |  65 ++++
 src/Codec/CBOR/Cuddle/CDDL/Resolve.hs   | 416 ++++++++++++------------
 src/Codec/CBOR/Cuddle/Huddle.hs         |  20 +-
 src/Codec/CBOR/Cuddle/IndexMappable.hs  | 129 ++++++++
 src/Codec/CBOR/Cuddle/Parser.hs         |  25 +-
 src/Codec/CBOR/Cuddle/Pretty.hs         |  36 +-
 12 files changed, 543 insertions(+), 360 deletions(-)
 create mode 100644 src/Codec/CBOR/Cuddle/IndexMappable.hs

diff --git a/bin/Main.hs b/bin/Main.hs
index 4564d36..f2ee5b7 100644
--- a/bin/Main.hs
+++ b/bin/Main.hs
@@ -4,13 +4,14 @@ module Main (main) where
 
 import Codec.CBOR.Cuddle.CBOR.Gen (generateCBORTerm)
 import Codec.CBOR.Cuddle.CBOR.Validator
-import Codec.CBOR.Cuddle.CDDL (Name (..), sortCDDL)
-import Codec.CBOR.Cuddle.CDDL.Prelude (prependPrelude)
+import Codec.CBOR.Cuddle.CDDL (Name (..), fromRules, sortCDDL)
+import Codec.CBOR.Cuddle.CDDL.Postlude (appendPostlude)
 import Codec.CBOR.Cuddle.CDDL.Resolve (
   fullResolveCDDL,
  )
+import Codec.CBOR.Cuddle.IndexMappable (IndexMappable (..))
 import Codec.CBOR.Cuddle.Parser (pCDDL)
-import Codec.CBOR.Cuddle.Pretty ()
+import Codec.CBOR.Cuddle.Pretty (PrettyStage)
 import Codec.CBOR.FlatTerm (toFlatTerm)
 import Codec.CBOR.Pretty (prettyHexEnc)
 import Codec.CBOR.Term (encodeTerm)
@@ -31,20 +32,10 @@ data Opts = Opts Command String
 
 data Command
   = Format FormatOpts
-  | Validate ValidateOpts
+  | Validate
   | GenerateCBOR GenOpts
   | ValidateCBOR ValidateCBOROpts
 
-newtype ValidateOpts = ValidateOpts {vNoPrelude :: Bool}
-
-pValidateOpts :: Parser ValidateOpts
-pValidateOpts =
-  ValidateOpts
-    <$> switch
-      ( long "no-prelude"
-          <> help "Do not include the CDDL prelude."
-      )
-
 -- | Various formats for outputtting CBOR
 data CBOROutputFormat
   = AsCBOR
@@ -144,7 +135,7 @@ opts =
           <> command
             "validate"
             ( info
-                (Validate <$> pValidateOpts <**> helper)
+                (pure Validate <**> helper)
                 (progDesc "Validate the provided CDDL file")
             )
           <> command
@@ -185,26 +176,21 @@ run (Opts cmd cddlFile) = do
         Format fOpts ->
           let
             defs
-              | sort fOpts = sortCDDL res
+              | sort fOpts = fromRules $ sortCDDL res
               | otherwise = res
            in
-            putDocW 80 $ pretty defs
-        Validate vOpts ->
-          let
-            res'
-              | vNoPrelude vOpts = res
-              | otherwise = prependPrelude res
-           in
-            case fullResolveCDDL res' of
-              Left err -> putStrLnErr (show err) >> exitFailure
-              Right _ -> exitSuccess
+            putDocW 80 . pretty $ mapIndex @_ @_ @PrettyStage defs
+        Validate ->
+          case fullResolveCDDL $ mapIndex res of
+            Left err -> putStrLnErr (show err) >> exitFailure
+            Right _ -> exitSuccess
         (GenerateCBOR gOpts) ->
           let
             res'
               | gNoPrelude gOpts = res
-              | otherwise = prependPrelude res
+              | otherwise = appendPostlude res
            in
-            case fullResolveCDDL res' of
+            case fullResolveCDDL $ mapIndex res' of
               Left err -> putStrLnErr (show err) >> exitFailure
               Right mt -> do
                 stdGen <- getStdGen
@@ -220,9 +206,9 @@ run (Opts cmd cddlFile) = do
           let
             res'
               | vcNoPrelude vcOpts = res
-              | otherwise = prependPrelude res
+              | otherwise = res
            in
-            case fullResolveCDDL res' of
+            case fullResolveCDDL $ mapIndex res' of
               Left err -> putStrLnErr (show err) >> exitFailure
               Right mt -> do
                 cbor <- BSC.readFile (vcInput vcOpts)
diff --git a/cuddle.cabal b/cuddle.cabal
index 4d300f4..ca6aee1 100644
--- a/cuddle.cabal
+++ b/cuddle.cabal
@@ -54,6 +54,7 @@ library
     Codec.CBOR.Cuddle.Huddle
     Codec.CBOR.Cuddle.Huddle.HuddleM
     Codec.CBOR.Cuddle.Huddle.Optics
+    Codec.CBOR.Cuddle.IndexMappable
     Codec.CBOR.Cuddle.Parser
     Codec.CBOR.Cuddle.Parser.Lexer
     Codec.CBOR.Cuddle.Pretty
diff --git a/src/Codec/CBOR/Cuddle/CBOR/Gen.hs b/src/Codec/CBOR/Cuddle/CBOR/Gen.hs
index 69a5154..ad3d474 100644
--- a/src/Codec/CBOR/Cuddle/CBOR/Gen.hs
+++ b/src/Codec/CBOR/Cuddle/CBOR/Gen.hs
@@ -25,7 +25,7 @@ import Codec.CBOR.Cuddle.CDDL (
   Value (..),
   ValueVariant (..),
  )
-import Codec.CBOR.Cuddle.CDDL.CTree (CTree, CTreeRoot (..))
+import Codec.CBOR.Cuddle.CDDL.CTree (CTree, CTreePhase, CTreeRoot (..))
 import Codec.CBOR.Cuddle.CDDL.CTree qualified as CTree
 import Codec.CBOR.Cuddle.CDDL.CtlOp qualified as CtlOp
 import Codec.CBOR.Cuddle.CDDL.Postlude (PTerm (..))
@@ -380,7 +380,7 @@ resolveRef (MRuleRef n) = do
 -- This will throw an error if the generated item does not correspond to a
 -- single CBOR term (e.g. if the name resolves to a group, which cannot be
 -- generated outside a context).
-genForName :: RandomGen g => Name -> M g Term
+genForName :: RandomGen g => Name CTreePhase -> M g Term
 genForName n = do
   (CTreeRoot cddl) <- ask @"cddl"
   case Map.lookup n cddl of
@@ -434,13 +434,13 @@ genValueVariant (VBool b) = pure $ TBool b
 -- Generator functions
 --------------------------------------------------------------------------------
 
-generateCBORTerm :: RandomGen g => CTreeRoot MonoReferenced -> Name -> g -> Term
+generateCBORTerm :: RandomGen g => CTreeRoot MonoReferenced -> Name CTreePhase -> g -> Term
 generateCBORTerm cddl n stdGen =
   let genEnv = GenEnv {cddl}
       genState = GenState {randomSeed = stdGen, depth = 1}
    in evalGen (genForName n) genEnv genState
 
-generateCBORTerm' :: RandomGen g => CTreeRoot MonoReferenced -> Name -> g -> (Term, g)
+generateCBORTerm' :: RandomGen g => CTreeRoot MonoReferenced -> Name CTreePhase -> g -> (Term, g)
 generateCBORTerm' cddl n stdGen =
   let genEnv = GenEnv {cddl}
       genState = GenState {randomSeed = stdGen, depth = 1}
diff --git a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
index d3894fb..15029e5 100644
--- a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
+++ b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
@@ -113,7 +113,7 @@ data AMatchedItem = AMatchedItem
 --------------------------------------------------------------------------------
 -- Main entry point
 
-validateCBOR :: BS.ByteString -> Name -> CDDL -> IO ()
+validateCBOR :: BS.ByteString -> Name CTreePhase -> CDDL -> IO ()
 validateCBOR bs rule cddl =
   ( case validateCBOR' bs rule cddl of
       ok@(CBORTermResult _ (Valid _)) -> do
@@ -130,7 +130,7 @@ validateCBOR bs rule cddl =
             )
 
 validateCBOR' ::
-  BS.ByteString -> Name -> CDDL -> CBORTermResult
+  BS.ByteString -> Name CTreePhase -> CDDL -> CBORTermResult
 validateCBOR' bs rule cddl@(CTreeRoot tree) =
   case deserialiseFromBytes decodeTerm (BSL.fromStrict bs) of
     Left e -> error $ show e
diff --git a/src/Codec/CBOR/Cuddle/CDDL.hs b/src/Codec/CBOR/Cuddle/CDDL.hs
index 300c9a0..6127ba7 100644
--- a/src/Codec/CBOR/Cuddle/CDDL.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE OverloadedLabels #-}
@@ -12,6 +13,7 @@ module Codec.CBOR.Cuddle.CDDL (
   cddlTopLevel,
   fromRule,
   fromRules,
+  appendRules,
   TopLevel (..),
   Name (..),
   Rule (..),
@@ -49,7 +51,7 @@ import Data.ByteString qualified as B
 import Data.Default.Class (Default (..))
 import Data.Function (on)
 import Data.Hashable (Hashable)
-import Data.List.NonEmpty (NonEmpty (..))
+import Data.List.NonEmpty (NonEmpty (..), prependList)
 import Data.List.NonEmpty qualified as NE
 import Data.Maybe (mapMaybe)
 import Data.String (IsString (..))
@@ -58,16 +60,15 @@ import Data.TreeDiff (ToExpr)
 import Data.Word (Word64, Word8)
 import GHC.Base (Constraint, Type)
 import GHC.Generics (Generic)
-import Optics.Core ((%))
-import Optics.Lens (lens)
+import Optics.Core ((%), (%~), (&))
 
-type family XXTopLevel i
+data family XXTopLevel i
 
-type family XCddl i
+data family XCddl i
 
-type family XTerm i
+data family XTerm i
 
-type family XXType2 i
+data family XXType2 i
 
 type ForAllExtensions i (c :: Type -> Constraint) =
   ( c (XCddl i)
@@ -84,7 +85,7 @@ type ForAllExtensions i (c :: Type -> Constraint) =
 data CDDL i = CDDL
   { rootDefinition :: Rule i
   , topLevelDefinitions :: [TopLevel i]
-  , cddlExt :: XCddl i
+  , cddlExt :: [XXTopLevel i]
   }
   deriving (Generic)
 
@@ -102,28 +103,17 @@ ruleTopLevel _ = Nothing
 sortCDDL :: CDDL i -> NonEmpty (Rule i)
 sortCDDL (CDDL r rs _) = NE.sortBy (compare `on` name . ruleName) $ r :| mapMaybe ruleTopLevel rs
 
-cddlTopLevel ::
-  [XXTopLevel i] ~ XCddl i =>
-  CDDL i ->
-  NonEmpty (TopLevel i)
-cddlTopLevel (CDDL cHead cTail cmts) =
-  NE.prependList (XXTopLevel <$> cmts) $ TopLevelRule cHead :| cTail
-
 fromRules :: Monoid (XCddl i) => NonEmpty (Rule i) -> CDDL i
 fromRules (x :| xs) = CDDL x (TopLevelRule <$> xs) mempty
 
 fromRule :: Monoid (XCddl i) => Rule i -> CDDL i
 fromRule x = CDDL x [] mempty
 
-instance
-  XCddl i ~ [XXTopLevel i] =>
-  Semigroup (CDDL i)
-  where
-  CDDL aHead aTail aExt <> CDDL bHead bTail bExt =
-    CDDL
-      aHead
-      (aTail <> fmap XXTopLevel bExt <> (TopLevelRule bHead : bTail))
-      aExt
+appendRules :: CDDL i -> [Rule i] -> CDDL i
+appendRules cddl rs = cddl & #topLevelDefinitions %~ (<> fmap TopLevelRule rs)
+
+cddlTopLevel :: CDDL i -> NonEmpty (TopLevel i)
+cddlTopLevel (CDDL r tls e) = prependList (XXTopLevel <$> e) $ TopLevelRule r :| tls
 
 data TopLevel i
   = TopLevelRule (Rule i)
@@ -182,7 +172,7 @@ instance HasComment (XTerm i) => HasComment (Name i) where
 instance CollectComments (XTerm i) => CollectComments (Name i) where
   collectComments (Name _ c) = collectComments c
 
-instance XTerm i ~ () => Hashable (Name i)
+instance Hashable (XTerm i) => Hashable (Name i)
 
 -- |
 --   assignt = "=" / "/="
@@ -267,7 +257,7 @@ data Rule i = Rule
   , ruleGenParam :: Maybe (GenericParam i)
   , ruleAssign :: Assign
   , ruleTerm :: TypeOrGroup i
-  , ruleComment :: Comment
+  , ruleComment :: XTerm i
   }
   deriving (Generic)
 
@@ -277,8 +267,8 @@ deriving instance ForAllExtensions i Show => Show (Rule i)
 
 deriving instance ForAllExtensions i ToExpr => ToExpr (Rule i)
 
-instance HasComment (Rule i) where
-  commentL = lens ruleComment (\x y -> x {ruleComment = y})
+instance HasComment (XTerm i) => HasComment (Rule i) where
+  commentL = #ruleComment % commentL
 
 compareRuleName :: Ord (XTerm i) => Rule i -> Rule i -> Ordering
 compareRuleName = compare `on` ruleName
@@ -518,8 +508,8 @@ instance ForAllExtensions i CollectComments => CollectComments (GrpChoice i) whe
 --  that is modified by the occurrence indicator.)
 data GroupEntry i = GroupEntry
   { geOccurrenceIndicator :: Maybe OccurrenceIndicator
-  , geComment :: XTerm i
   , geVariant :: GroupEntryVariant i
+  , geExt :: XTerm i
   }
   deriving (Generic)
 
@@ -545,7 +535,7 @@ deriving instance ForAllExtensions i Show => Show (GroupEntryVariant i)
 deriving instance ForAllExtensions i ToExpr => ToExpr (GroupEntryVariant i)
 
 instance HasComment (XTerm i) => HasComment (GroupEntry i) where
-  commentL = #geComment % commentL
+  commentL = #geExt % commentL
 
 instance ForAllExtensions i CollectComments => CollectComments (GroupEntryVariant i) where
   collectComments (GEType _ t0) = collectComments t0
diff --git a/src/Codec/CBOR/Cuddle/CDDL/CTree.hs b/src/Codec/CBOR/Cuddle/CDDL/CTree.hs
index a50a31d..d4882b7 100644
--- a/src/Codec/CBOR/Cuddle/CDDL/CTree.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL/CTree.hs
@@ -12,6 +12,7 @@ import Codec.CBOR.Cuddle.CDDL (
   XCddl,
   XTerm,
   XXTopLevel,
+  XXType2,
  )
 import Codec.CBOR.Cuddle.CDDL.CtlOp
 import Codec.CBOR.Cuddle.CDDL.Postlude (PTerm)
@@ -19,17 +20,10 @@ import Codec.CBOR.Cuddle.Comments (Comment)
 import Data.Hashable (Hashable)
 import Data.List.NonEmpty qualified as NE
 import Data.Map.Strict qualified as Map
+import Data.Void (Void)
 import Data.Word (Word64)
 import GHC.Generics (Generic)
 
-data CTreePhase
-
-type instance XTerm CTreePhase = Comment
-
-type instance XCddl CTreePhase = [Comment]
-
-type instance XXTopLevel CTreePhase = Comment
-
 --------------------------------------------------------------------------------
 
 -- * Resolved CDDL Tree
@@ -40,68 +34,71 @@ type instance XXTopLevel CTreePhase = Comment
 -- to manipulate.
 --------------------------------------------------------------------------------
 
--- | CDDL Tree, parametrised over a functor
---
---   We principally use this functor to represent references - thus, every 'f a'
---   may be either an a or a reference to another CTree.
-data CTree f
+type family CTreeExt i
+
+data CTreePhase
+
+newtype instance XTerm CTreePhase = CTreeXTerm Comment
+  deriving (Generic, Show, Eq, Ord, Hashable, Semigroup, Monoid)
+
+newtype instance XXTopLevel CTreePhase = CTreeXXTopLevel Comment
+  deriving (Generic, Show, Eq, Ord, Hashable)
+
+newtype instance XCddl CTreePhase = CTreeXCddl [Comment]
+  deriving (Generic, Show, Eq, Ord, Hashable)
+
+newtype instance XXType2 CTreePhase = CTreeXXType2 Void
+  deriving (Generic, Show, Eq, Ord, Hashable)
+
+data CTree i
   = Literal Value
   | Postlude PTerm
-  | Map [Node f]
-  | Array [Node f]
-  | Choice (NE.NonEmpty (Node f))
-  | Group [Node f]
-  | KV {key :: Node f, value :: Node f, cut :: Bool}
-  | Occur {item :: Node f, occurs :: OccurrenceIndicator}
-  | Range {from :: Node f, to :: Node f, inclusive :: RangeBound}
-  | Control {op :: CtlOp, target :: Node f, controller :: Node f}
-  | Enum (Node f)
-  | Unwrap (Node f)
-  | Tag Word64 (Node f)
+  | Map [CTree i]
+  | Array [CTree i]
+  | Choice (NE.NonEmpty (CTree i))
+  | Group [CTree i]
+  | KV {key :: CTree i, value :: CTree i, cut :: Bool}
+  | Occur {item :: CTree i, occurs :: OccurrenceIndicator}
+  | Range {from :: CTree i, to :: CTree i, inclusive :: RangeBound}
+  | Control {op :: CtlOp, target :: CTree i, controller :: CTree i}
+  | Enum (CTree i)
+  | Unwrap (CTree i)
+  | Tag Word64 (CTree i)
+  | CTreeE (CTreeExt i)
   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
-traverseCTree _ (Postlude a) = pure $ Postlude a
-traverseCTree atNode (Map xs) = Map <$> traverse atNode xs
-traverseCTree atNode (Array xs) = Array <$> traverse atNode xs
-traverseCTree atNode (Group xs) = Group <$> traverse atNode xs
-traverseCTree atNode (Choice xs) = Choice <$> traverse atNode xs
-traverseCTree atNode (KV k v c) = do
+traverseCTree ::
+  Monad m => (CTreeExt i -> m (CTree j)) -> (CTree i -> m (CTree j)) -> CTree i -> m (CTree j)
+traverseCTree _ _ (Literal a) = pure $ Literal a
+traverseCTree _ _ (Postlude a) = pure $ Postlude a
+traverseCTree _ atNode (Map xs) = Map <$> traverse atNode xs
+traverseCTree _ atNode (Array xs) = Array <$> traverse atNode xs
+traverseCTree _ atNode (Group xs) = Group <$> traverse atNode xs
+traverseCTree _ atNode (Choice xs) = Choice <$> traverse atNode xs
+traverseCTree _ atNode (KV k v c) = do
   k' <- atNode k
   v' <- atNode v
   pure $ KV k' v' c
-traverseCTree atNode (Occur i occ) = flip Occur occ <$> atNode i
-traverseCTree atNode (Range f t inc) = do
+traverseCTree _ atNode (Occur i occ) = flip Occur occ <$> atNode i
+traverseCTree _ atNode (Range f t inc) = do
   f' <- atNode f
   t' <- atNode t
   pure $ Range f' t' inc
-traverseCTree atNode (Control o t c) = do
+traverseCTree _ atNode (Control o t c) = do
   t' <- atNode t
   c' <- atNode c
   pure $ Control o t' c'
-traverseCTree atNode (Enum ref) = Enum <$> atNode ref
-traverseCTree atNode (Unwrap ref) = Unwrap <$> atNode ref
-traverseCTree atNode (Tag i ref) = Tag i <$> atNode ref
+traverseCTree _ atNode (Enum ref) = Enum <$> atNode ref
+traverseCTree _ atNode (Unwrap ref) = Unwrap <$> atNode ref
+traverseCTree _ atNode (Tag i ref) = Tag i <$> atNode ref
+traverseCTree atExt _ (CTreeE x) = atExt x
 
-type Node f = f (CTree f)
+type Node i = CTreeExt i
 
-newtype CTreeRoot' poly f
-  = CTreeRoot
-      (Map.Map (Name CTreePhase) (poly (Node f)))
+newtype CTreeRoot i = CTreeRoot (Map.Map (Name CTreePhase) (CTree i))
   deriving (Generic)
 
-type CTreeRoot f = CTreeRoot' (ParametrisedWith [Name CTreePhase]) f
-
-data ParametrisedWith w a
-  = Unparametrised {underlying :: a}
-  | Parametrised
-      { underlying :: a
-      , params :: w
-      }
-  deriving (Eq, Functor, Generic, Foldable, Traversable, Show)
-
-instance (Hashable w, Hashable a) => Hashable (ParametrisedWith w a)
+deriving instance Show (CTree i) => Show (CTreeRoot i)
diff --git a/src/Codec/CBOR/Cuddle/CDDL/Postlude.hs b/src/Codec/CBOR/Cuddle/CDDL/Postlude.hs
index 0f5c0a4..6ce4e3e 100644
--- a/src/Codec/CBOR/Cuddle/CDDL/Postlude.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL/Postlude.hs
@@ -1,7 +1,13 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Codec.CBOR.Cuddle.CDDL.Postlude where
 
+import Codec.CBOR.Cuddle.CDDL (CDDL (..), TopLevel (..), appendRules)
+import Codec.CBOR.Cuddle.Parser (ParserStage, pCDDL)
 import Data.Hashable (Hashable)
+import Data.Maybe (mapMaybe)
 import GHC.Generics (Generic)
+import Text.Megaparsec (errorBundlePretty, parse)
 
 -- |
 --
@@ -53,3 +59,62 @@ data PTerm
   deriving (Eq, Generic, Ord, Show)
 
 instance Hashable PTerm
+
+-- TODO switch to quasiquotes
+cddlPostlude :: CDDL ParserStage
+cddlPostlude =
+  either (error . errorBundlePretty) id $
+    parse
+      pCDDL
+      "<HARDCODED>"
+      " any = # \
+      \ uint = #0 \
+      \ nint = #1 \
+      \ int = uint / nint \
+      \ \
+      \ bstr = #2 \
+      \ bytes = bstr \
+      \ tstr = #3 \
+      \ text = tstr \
+      \ \
+      \ tdate = #6.0(tstr) \
+      \ time = #6.1(number) \
+      \ number = int / float \
+      \ biguint = #6.2(bstr) \
+      \ bignint = #6.3(bstr) \
+      \ bigint = biguint / bignint \
+      \ integer = int / bigint \
+      \ unsigned = uint / biguint \
+      \ decfrac = #6.4([e10: int, m: integer]) \
+      \ bigfloat = #6.5([e2: int, m: integer]) \
+      \ eb64url = #6.21(any) \
+      \ eb64legacy = #6.22(any) \
+      \ eb16 = #6.23(any) \
+      \ encoded-cbor = #6.24(bstr) \
+      \ uri = #6.32(tstr) \
+      \ b64url = #6.33(tstr) \
+      \ b64legacy = #6.34(tstr) \
+      \ regexp = #6.35(tstr) \
+      \ mime-message = #6.36(tstr) \
+      \ cbor-any = #6.55799(any) \
+      \ float16 = #7.25 \
+      \ float32 = #7.26 \
+      \ float64 = #7.27 \
+      \ float16-32 = float16 / float32 \
+      \ float32-64 = float32 / float64 \
+      \ float = float16-32 / float64 \
+      \  \
+      \ false = #7.20 \
+      \ true = #7.21 \
+      \ bool = false / true \
+      \ nil = #7.22 \
+      \ null = nil \
+      \ undefined = #7.23"
+
+appendPostlude :: CDDL ParserStage -> CDDL ParserStage
+appendPostlude cddl = appendRules cddl (r : rs)
+  where
+    CDDL r tls _ = cddlPostlude
+    f (TopLevelRule x) = Just x
+    f _ = Nothing
+    rs = mapMaybe f tls
diff --git a/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs b/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
index e8fe62e..ab777aa 100644
--- a/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
@@ -2,7 +2,9 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -29,9 +31,9 @@ module Codec.CBOR.Cuddle.CDDL.Resolve (
   asMap,
   buildMonoCTree,
   fullResolveCDDL,
-  MonoRef (..),
-  OrRef (..),
   NameResolutionFailure (..),
+  MonoReferenced,
+  MonoRef (..),
 )
 where
 
@@ -42,20 +44,19 @@ import Capability.Reader qualified as Reader (local)
 import Capability.Sink (HasSink)
 import Capability.Source (HasSource)
 import Capability.State (HasState, MonadState (..), modify)
-import Codec.CBOR.Cuddle.CDDL
+import Codec.CBOR.Cuddle.CDDL as CDDL
 import Codec.CBOR.Cuddle.CDDL.CTree (
-  CTree,
+  CTree (..),
+  CTreeExt,
   CTreePhase,
-  CTreeRoot,
-  CTreeRoot' (CTreeRoot),
-  ParametrisedWith (..),
+  CTreeRoot (..),
+  XXType2 (..),
  )
 import Codec.CBOR.Cuddle.CDDL.CTree qualified as CTree
 import Codec.CBOR.Cuddle.CDDL.Postlude (PTerm (..))
 import Control.Monad.Except (ExceptT (..), runExceptT)
 import Control.Monad.Reader (Reader, ReaderT (..), runReader)
 import Control.Monad.State.Strict (StateT (..))
-import Data.Functor.Identity (Identity (..))
 import Data.Generics.Product
 import Data.Generics.Sum
 import Data.Hashable
@@ -65,24 +66,34 @@ import Data.List (foldl')
 import Data.List.NonEmpty qualified as NE
 import Data.Map.Strict qualified as Map
 import Data.Text qualified as T
+import Data.Void (absurd)
 import GHC.Generics (Generic)
 import Optics.Core
 
+data ProvidedParameters a = ProvidedParameters
+  { parameters :: [Name CTreePhase]
+  , underlying :: a
+  }
+  deriving (Generic, Functor, Show, Eq, Foldable, Traversable)
+
+instance Hashable a => Hashable (ProvidedParameters a)
+
+data Parametrised
+
+type instance CTreeExt Parametrised = ProvidedParameters (CTree Parametrised)
+
 --------------------------------------------------------------------------------
 -- 1. Rule extensions
 --------------------------------------------------------------------------------
 
-type CDDLMap = Map.Map (Name CTreePhase) (Parametrised (TypeOrGroup CTreePhase))
-
-type Parametrised a = ParametrisedWith [Name CTreePhase] a
+newtype PartialCTreeRoot i = PartialCTreeRoot (Map.Map (Name CTreePhase) (ProvidedParameters (CTree i)))
+  deriving (Generic)
 
-toParametrised :: a -> Maybe (GenericParam CTreePhase) -> Parametrised a
-toParametrised a Nothing = Unparametrised a
-toParametrised a (Just (GenericParam gps)) = Parametrised a (NE.toList gps)
+type CDDLMap = Map.Map (Name CTreePhase) (ProvidedParameters (TypeOrGroup CTreePhase))
 
-parameters :: Parametrised a -> [Name CTreePhase]
-parameters (Unparametrised _) = mempty
-parameters (Parametrised _ ps) = ps
+toParametrised :: a -> Maybe (GenericParam CTreePhase) -> ProvidedParameters a
+toParametrised a Nothing = ProvidedParameters [] a
+toParametrised a (Just (GenericParam gps)) = ProvidedParameters (NE.toList gps) a
 
 asMap :: CDDL CTreePhase -> CDDLMap
 asMap cddl = foldl' go Map.empty rules
@@ -100,8 +111,8 @@ asMap cddl = foldl' go Map.empty rules
     extend ::
       TypeOrGroup CTreePhase ->
       Maybe (GenericParam CTreePhase) ->
-      Maybe (Parametrised (TypeOrGroup CTreePhase)) ->
-      Maybe (Parametrised (TypeOrGroup CTreePhase))
+      Maybe (ProvidedParameters (TypeOrGroup CTreePhase)) ->
+      Maybe (ProvidedParameters (TypeOrGroup CTreePhase))
     extend tog _gps (Just existing) = case (underlying existing, tog) of
       (TOGType _, TOGType (Type0 new)) ->
         Just $
@@ -124,61 +135,60 @@ asMap cddl = foldl' go Map.empty rules
 -- 2. Conversion to CTree
 --------------------------------------------------------------------------------
 
+data OrReferenced
+
+type instance CTreeExt OrReferenced = OrRef (CTree OrReferenced)
+
 -- | Indicates that an item may be referenced rather than defined.
 data OrRef a
-  = -- | The item is inlined directly
-    It a
-  | -- | Reference to another node with possible generic arguments supplied
-    Ref (Name CTreePhase) [CTree.Node OrRef]
+  = -- | Reference to another node with possible generic arguments supplied
+    Ref (Name CTreePhase) [CTree OrReferenced]
   deriving (Eq, Show, Functor)
 
-type RefCTree = CTreeRoot OrRef
+type RefCTree = PartialCTreeRoot OrReferenced
 
-deriving instance Show (CTree OrRef)
+deriving instance Show (CTree OrReferenced)
 
-deriving instance Show (CTreeRoot OrRef)
+deriving instance Show (PartialCTreeRoot OrReferenced)
 
 -- | Build a CTree incorporating references.
 --
 -- This translation cannot fail.
 buildRefCTree :: CDDLMap -> RefCTree
-buildRefCTree rules = CTreeRoot $ fmap toCTreeRule rules
+buildRefCTree rules = PartialCTreeRoot $ toCTreeRule <$> rules
   where
     toCTreeRule ::
-      Parametrised (TypeOrGroup CTreePhase) ->
-      ParametrisedWith [Name CTreePhase] (CTree.Node OrRef)
+      ProvidedParameters (TypeOrGroup CTreePhase) ->
+      ProvidedParameters (CTree OrReferenced)
     toCTreeRule = fmap toCTreeTOG
 
-    toCTreeTOG :: TypeOrGroup CTreePhase -> CTree.Node OrRef
+    toCTreeTOG :: TypeOrGroup CTreePhase -> CTree OrReferenced
     toCTreeTOG (TOGType t0) = toCTreeT0 t0
     toCTreeTOG (TOGGroup ge) = toCTreeGroupEntry ge
 
-    toCTreeT0 :: Type0 CTreePhase -> CTree.Node OrRef
+    toCTreeT0 :: Type0 CTreePhase -> CTree OrReferenced
     toCTreeT0 (Type0 (t1 NE.:| [])) = toCTreeT1 t1
-    toCTreeT0 (Type0 xs) = It . CTree.Choice $ toCTreeT1 <$> xs
+    toCTreeT0 (Type0 xs) = CTree.Choice $ toCTreeT1 <$> xs
 
-    toCTreeT1 :: Type1 CTreePhase -> CTree.Node OrRef
+    toCTreeT1 :: Type1 CTreePhase -> CTree OrReferenced
     toCTreeT1 (Type1 t2 Nothing _) = toCTreeT2 t2
     toCTreeT1 (Type1 t2 (Just (op, t2')) _) = case op of
       RangeOp bound ->
-        It $
-          CTree.Range
-            { CTree.from = toCTreeT2 t2
-            , CTree.to = toCTreeT2 t2'
-            , CTree.inclusive = bound
-            }
+        CTree.Range
+          { CTree.from = toCTreeT2 t2
+          , CTree.to = toCTreeT2 t2'
+          , CTree.inclusive = bound
+          }
       CtrlOp ctlop ->
-        It $
-          CTree.Control
-            { CTree.op = ctlop
-            , CTree.target = toCTreeT2 t2
-            , CTree.controller = toCTreeT2 t2'
-            }
-
-    toCTreeT2 :: Type2 CTreePhase -> CTree.Node OrRef
-    toCTreeT2 (T2Value v) = It $ CTree.Literal v
-    toCTreeT2 (T2Name n garg) =
-      Ref n (fromGenArgs garg)
+        CTree.Control
+          { CTree.op = ctlop
+          , CTree.target = toCTreeT2 t2
+          , CTree.controller = toCTreeT2 t2'
+          }
+
+    toCTreeT2 :: Type2 CTreePhase -> CTree OrReferenced
+    toCTreeT2 (T2Value v) = CTree.Literal v
+    toCTreeT2 (T2Name n garg) = CTreeE $ Ref n (fromGenArgs garg)
     toCTreeT2 (T2Group t0) =
       -- This behaviour seems questionable, but I don't really see how better to
       -- interpret the spec here.
@@ -186,113 +196,107 @@ buildRefCTree rules = CTreeRoot $ fmap toCTreeRule rules
     toCTreeT2 (T2Map g) = toCTreeMap g
     toCTreeT2 (T2Array g) = toCTreeArray g
     toCTreeT2 (T2Unwrapped n margs) =
-      It . CTree.Unwrap $
+      CTree.Unwrap . CTreeE $
         Ref n (fromGenArgs margs)
     toCTreeT2 (T2Enum g) = toCTreeEnum g
-    toCTreeT2 (T2EnumRef n margs) = Ref n $ fromGenArgs margs
+    toCTreeT2 (T2EnumRef n margs) = CTreeE . Ref n $ fromGenArgs margs
     toCTreeT2 (T2Tag Nothing t0) =
       -- Currently not validating tags
       toCTreeT0 t0
     toCTreeT2 (T2Tag (Just tag) t0) =
-      It . CTree.Tag tag $ toCTreeT0 t0
+      CTree.Tag tag $ toCTreeT0 t0
     toCTreeT2 (T2DataItem 7 (Just mmin)) =
       toCTreeDataItem mmin
     toCTreeT2 (T2DataItem _maj _mmin) =
       -- We don't validate numerical items yet
-      It $ CTree.Postlude PTAny
-    toCTreeT2 T2Any = It $ CTree.Postlude PTAny
+      CTree.Postlude PTAny
+    toCTreeT2 T2Any = CTree.Postlude PTAny
+    toCTreeT2 (XXType2 (CTreeXXType2 v)) = absurd v
 
     toCTreeDataItem 20 =
-      It . CTree.Literal $ Value (VBool False) mempty
+      CTree.Literal $ Value (VBool False) mempty
     toCTreeDataItem 21 =
-      It . CTree.Literal $ Value (VBool True) mempty
+      CTree.Literal $ Value (VBool True) mempty
     toCTreeDataItem 25 =
-      It $ CTree.Postlude PTHalf
+      CTree.Postlude PTHalf
     toCTreeDataItem 26 =
-      It $ CTree.Postlude PTFloat
+      CTree.Postlude PTFloat
     toCTreeDataItem 27 =
-      It $ CTree.Postlude PTDouble
+      CTree.Postlude PTDouble
     toCTreeDataItem 23 =
-      It $ CTree.Postlude PTUndefined
+      CTree.Postlude PTUndefined
     toCTreeDataItem _ =
-      It $ CTree.Postlude PTAny
-
-    toCTreeGroupEntry :: GroupEntry CTreePhase -> CTree.Node OrRef
-    toCTreeGroupEntry (GroupEntry (Just occi) _ (GEType mmkey t0)) =
-      It $
-        CTree.Occur
-          { CTree.item = toKVPair mmkey t0
-          , CTree.occurs = occi
-          }
-    toCTreeGroupEntry (GroupEntry Nothing _ (GEType mmkey t0)) = toKVPair mmkey t0
-    toCTreeGroupEntry (GroupEntry (Just occi) _ (GERef n margs)) =
-      It $
-        CTree.Occur
-          { CTree.item = Ref n (fromGenArgs margs)
-          , CTree.occurs = occi
-          }
-    toCTreeGroupEntry (GroupEntry Nothing _ (GERef n margs)) = Ref n (fromGenArgs margs)
-    toCTreeGroupEntry (GroupEntry (Just occi) _ (GEGroup g)) =
-      It $
-        CTree.Occur
-          { CTree.item = groupToGroup g
-          , CTree.occurs = occi
-          }
-    toCTreeGroupEntry (GroupEntry Nothing _ (GEGroup g)) = groupToGroup g
-
-    fromGenArgs :: Maybe (GenericArg CTreePhase) -> [CTree.Node OrRef]
+      CTree.Postlude PTAny
+
+    toCTreeGroupEntry :: GroupEntry CTreePhase -> CTree OrReferenced
+    toCTreeGroupEntry (GroupEntry (Just occi) (GEType mmkey t0) _) =
+      CTree.Occur
+        { CTree.item = toKVPair mmkey t0
+        , CTree.occurs = occi
+        }
+    toCTreeGroupEntry (GroupEntry Nothing (GEType mmkey t0) _) = toKVPair mmkey t0
+    toCTreeGroupEntry (GroupEntry (Just occi) (GERef n margs) _) =
+      CTree.Occur
+        { CTree.item = CTreeE $ Ref n (fromGenArgs margs)
+        , CTree.occurs = occi
+        }
+    toCTreeGroupEntry (GroupEntry Nothing (GERef n margs) _) = CTreeE $ Ref n (fromGenArgs margs)
+    toCTreeGroupEntry (GroupEntry (Just occi) (GEGroup g) _) =
+      CTree.Occur
+        { CTree.item = groupToGroup g
+        , CTree.occurs = occi
+        }
+    toCTreeGroupEntry (GroupEntry Nothing (GEGroup g) _) = groupToGroup g
+
+    fromGenArgs :: Maybe (GenericArg CTreePhase) -> [CTree OrReferenced]
     fromGenArgs = maybe [] (\(GenericArg xs) -> NE.toList $ fmap toCTreeT1 xs)
 
     -- Interpret a group as an enumeration. Note that we float out the
     -- choice options
-    toCTreeEnum :: Group CTreePhase -> CTree.Node OrRef
-    toCTreeEnum (Group (a NE.:| [])) =
-      It . CTree.Enum . It . CTree.Group $ toCTreeGroupEntry <$> gcGroupEntries a
-    toCTreeEnum (Group xs) =
-      It . CTree.Choice $
-        It . CTree.Enum . It . CTree.Group . fmap toCTreeGroupEntry <$> groupEntries
+    toCTreeEnum :: Group CTreePhase -> CTree OrReferenced
+    toCTreeEnum (CDDL.Group (a NE.:| [])) =
+      CTree.Enum . CTree.Group $ toCTreeGroupEntry <$> gcGroupEntries a
+    toCTreeEnum (CDDL.Group xs) =
+      CTree.Choice $ CTree.Enum . CTree.Group . fmap toCTreeGroupEntry <$> groupEntries
       where
         groupEntries = fmap gcGroupEntries xs
 
     -- Embed a group in another group, again floating out the choice options
-    groupToGroup :: Group CTreePhase -> CTree.Node OrRef
-    groupToGroup (Group (a NE.:| [])) =
-      It . CTree.Group $ fmap toCTreeGroupEntry (gcGroupEntries a)
-    groupToGroup (Group xs) =
-      It . CTree.Choice $
-        fmap (It . CTree.Group . fmap toCTreeGroupEntry) (gcGroupEntries <$> xs)
-
-    toKVPair :: Maybe (MemberKey CTreePhase) -> Type0 CTreePhase -> CTree.Node OrRef
+    groupToGroup :: Group CTreePhase -> CTree OrReferenced
+    groupToGroup (CDDL.Group (a NE.:| [])) =
+      CTree.Group $ fmap toCTreeGroupEntry (gcGroupEntries a)
+    groupToGroup (CDDL.Group xs) =
+      CTree.Choice $ fmap (CTree.Group . fmap toCTreeGroupEntry) (gcGroupEntries <$> xs)
+
+    toKVPair :: Maybe (MemberKey CTreePhase) -> Type0 CTreePhase -> CTree OrReferenced
     toKVPair Nothing t0 = toCTreeT0 t0
     toKVPair (Just mkey) t0 =
-      It $
-        CTree.KV
-          { CTree.key = toCTreeMemberKey mkey
-          , CTree.value = toCTreeT0 t0
-          , -- TODO Handle cut semantics
-            CTree.cut = False
-          }
+      CTree.KV
+        { CTree.key = toCTreeMemberKey mkey
+        , CTree.value = toCTreeT0 t0
+        , -- TODO Handle cut semantics
+          CTree.cut = False
+        }
 
     -- Interpret a group as a map. Note that we float out the choice options
-    toCTreeMap :: Group CTreePhase -> CTree.Node OrRef
-    toCTreeMap (Group (a NE.:| [])) = It . CTree.Map $ fmap toCTreeGroupEntry (gcGroupEntries a)
-    toCTreeMap (Group xs) =
-      It
-        . CTree.Choice
-        $ fmap (It . CTree.Map . fmap toCTreeGroupEntry) (gcGroupEntries <$> xs)
+    toCTreeMap :: Group CTreePhase -> CTree OrReferenced
+    toCTreeMap (CDDL.Group (a NE.:| [])) = CTree.Map $ fmap toCTreeGroupEntry (gcGroupEntries a)
+    toCTreeMap (CDDL.Group xs) =
+      CTree.Choice $
+        fmap (CTree.Map . fmap toCTreeGroupEntry) (gcGroupEntries <$> xs)
 
     -- Interpret a group as an array. Note that we float out the choice
     -- options
-    toCTreeArray :: Group CTreePhase -> CTree.Node OrRef
-    toCTreeArray (Group (a NE.:| [])) =
-      It . CTree.Array $ fmap toCTreeGroupEntry (gcGroupEntries a)
-    toCTreeArray (Group xs) =
-      It . CTree.Choice $
-        fmap (It . CTree.Array . fmap toCTreeGroupEntry) (gcGroupEntries <$> xs)
-
-    toCTreeMemberKey :: MemberKey CTreePhase -> CTree.Node OrRef
-    toCTreeMemberKey (MKValue v) = It $ CTree.Literal v
-    toCTreeMemberKey (MKBareword (Name n _)) = It $ CTree.Literal (Value (VText n) mempty)
+    toCTreeArray :: Group CTreePhase -> CTree OrReferenced
+    toCTreeArray (CDDL.Group (a NE.:| [])) =
+      CTree.Array $ fmap toCTreeGroupEntry (gcGroupEntries a)
+    toCTreeArray (CDDL.Group xs) =
+      CTree.Choice $
+        fmap (CTree.Array . fmap toCTreeGroupEntry) (gcGroupEntries <$> xs)
+
+    toCTreeMemberKey :: MemberKey CTreePhase -> CTree OrReferenced
+    toCTreeMemberKey (MKValue v) = CTree.Literal v
+    toCTreeMemberKey (MKBareword (Name n _)) = CTree.Literal (Value (VText n) mempty)
     toCTreeMemberKey (MKType t1) = toCTreeT1 t1
 
 --------------------------------------------------------------------------------
@@ -302,10 +306,10 @@ buildRefCTree rules = CTreeRoot $ fmap toCTreeRule rules
 data NameResolutionFailure
   = UnboundReference (Name CTreePhase)
   | MismatchingArgs (Name CTreePhase) [Name CTreePhase]
-  | ArgsToPostlude PTerm [CTree.Node OrRef]
+  | ArgsToPostlude PTerm [CTree OrReferenced]
   deriving (Show)
 
-deriving instance Eq (OrRef (CTree OrRef)) => Eq NameResolutionFailure
+deriving instance Eq (CTree.Node OrReferenced) => Eq NameResolutionFailure
 
 postludeBinding :: Map.Map (Name CTreePhase) PTerm
 postludeBinding =
@@ -326,92 +330,94 @@ postludeBinding =
     , (Name "null" mempty, PTNil)
     ]
 
-data BindingEnv poly f g = BindingEnv
-  { global :: Map.Map (Name CTreePhase) (poly (CTree.Node f))
+data BindingEnv i j = BindingEnv
+  { global :: Map.Map (Name CTreePhase) (ProvidedParameters (CTree i))
   -- ^ Global name bindings via 'RuleDef'
-  , local :: Map.Map (Name CTreePhase) (CTree.Node g)
+  , local :: Map.Map (Name CTreePhase) (CTree j)
   -- ^ Local bindings for generic parameters
   }
   deriving (Generic)
 
-data DistRef a
-  = DIt a
-  | -- | Reference to a generic parameter
+data DistReferenced
+
+type instance CTreeExt DistReferenced = DistRef
+
+data DistRef
+  = -- | Reference to a generic parameter
     GenericRef (Name CTreePhase)
   | -- | Reference to a rule definition, possibly with generic arguments
-    RuleRef (Name CTreePhase) [CTree.Node DistRef]
-  deriving (Eq, Generic, Functor, Show)
+    RuleRef (Name CTreePhase) [CTree DistReferenced]
+  deriving (Eq, Generic, Show)
 
-instance Hashable (DistRef a)
+instance Hashable DistRef
 
-deriving instance Show (CTree DistRef)
+deriving instance Show (CTree DistReferenced)
 
-instance Hashable (CTree DistRef)
+instance Hashable (CTree DistReferenced)
 
-deriving instance Show (CTreeRoot DistRef)
+deriving instance Show (PartialCTreeRoot DistReferenced)
 
-deriving instance Eq (CTreeRoot DistRef)
+deriving instance Eq (PartialCTreeRoot DistReferenced)
 
-instance Hashable (CTreeRoot DistRef)
+instance Hashable (PartialCTreeRoot DistReferenced)
 
 resolveRef ::
-  BindingEnv (ParametrisedWith [Name CTreePhase]) OrRef OrRef ->
-  CTree.Node OrRef ->
-  Either NameResolutionFailure (DistRef (CTree DistRef))
-resolveRef env (It a) = DIt <$> resolveCTree env a
+  BindingEnv OrReferenced OrReferenced ->
+  CTree.Node OrReferenced ->
+  Either NameResolutionFailure (CTree DistReferenced)
 resolveRef env (Ref n args) = case Map.lookup n postludeBinding of
   Just pterm -> case args of
-    [] -> Right . DIt $ CTree.Postlude pterm
+    [] -> Right $ CTree.Postlude pterm
     xs -> Left $ ArgsToPostlude pterm xs
   Nothing -> case Map.lookup n (global env) of
     Just (parameters -> params') ->
       if length params' == length args
         then
           let localBinds = Map.fromList $ zip params' args
-              newEnv = env & field @"local" %~ Map.union localBinds
-           in RuleRef n <$> traverse (resolveRef newEnv) args
+              newEnv = env & #local %~ Map.union localBinds
+           in CTreeE . RuleRef n <$> traverse (resolveCTree newEnv) args
         else Left $ MismatchingArgs n params'
     Nothing -> case Map.lookup n (local env) of
-      Just _ -> Right $ GenericRef n
+      Just _ -> Right . CTreeE $ GenericRef n
       Nothing -> Left $ UnboundReference n
 
 resolveCTree ::
-  BindingEnv (ParametrisedWith [Name CTreePhase]) OrRef OrRef ->
-  CTree OrRef ->
-  Either NameResolutionFailure (CTree DistRef)
-resolveCTree e = CTree.traverseCTree (resolveRef e)
+  BindingEnv OrReferenced OrReferenced ->
+  CTree OrReferenced ->
+  Either NameResolutionFailure (CTree DistReferenced)
+resolveCTree e = CTree.traverseCTree (resolveRef e) (resolveCTree e)
 
 buildResolvedCTree ::
-  CTreeRoot OrRef ->
-  Either NameResolutionFailure (CTreeRoot DistRef)
-buildResolvedCTree (CTreeRoot ct) = CTreeRoot <$> traverse go ct
+  PartialCTreeRoot OrReferenced ->
+  Either NameResolutionFailure (PartialCTreeRoot DistReferenced)
+buildResolvedCTree (PartialCTreeRoot ct) = PartialCTreeRoot <$> traverse go ct
   where
-    initBindingEnv = BindingEnv ct mempty
     go pn =
       let args = parameters pn
-          localBinds = Map.fromList $ zip args (flip Ref [] <$> args)
-          env = initBindingEnv & field @"local" %~ Map.union localBinds
-       in traverse (resolveRef env) pn
+          localBinds = Map.fromList $ zip args (CTreeE . flip Ref [] <$> args)
+          env = BindingEnv @OrReferenced @OrReferenced ct localBinds
+       in traverse (resolveCTree env) pn
 
 --------------------------------------------------------------------------------
 -- 4. Monomorphisation
 --------------------------------------------------------------------------------
 
-data MonoRef a
-  = MIt a
-  | MRuleRef (Name CTreePhase)
+data MonoReferenced
+
+type instance CTreeExt MonoReferenced = MonoRef (CTree MonoReferenced)
+
+newtype MonoRef a
+  = MRuleRef (Name CTreePhase)
   deriving (Functor, Show)
 
-deriving instance Show (CTree MonoRef)
+deriving instance Show (CTree MonoReferenced)
 
-deriving instance
-  Show (poly (CTree.Node MonoRef)) =>
-  Show (CTreeRoot' poly MonoRef)
+deriving instance Show (PartialCTreeRoot MonoReferenced)
 
-type MonoEnv = BindingEnv (ParametrisedWith [Name CTreePhase]) DistRef MonoRef
+type MonoEnv = BindingEnv DistReferenced MonoReferenced
 
 -- | We introduce additional bindings in the state
-type MonoState = Map.Map (Name CTreePhase) (CTree.Node MonoRef)
+type MonoState = Map.Map (Name CTreePhase) (CTree MonoReferenced)
 
 -- | Monad to run the monomorphisation process. We need some additional
 -- capabilities for this, so 'Either' doesn't fully cut it anymore.
@@ -433,10 +439,10 @@ newtype MonoM a = MonoM
   deriving
     ( HasSource
         "local"
-        (Map.Map (Name CTreePhase) (CTree.Node MonoRef))
+        (Map.Map (Name CTreePhase) (CTree MonoReferenced))
     , HasReader
         "local"
-        (Map.Map (Name CTreePhase) (CTree.Node MonoRef))
+        (Map.Map (Name CTreePhase) (CTree MonoReferenced))
     )
     via Field
           "local"
@@ -450,10 +456,10 @@ newtype MonoM a = MonoM
   deriving
     ( HasSource
         "global"
-        (Map.Map (Name CTreePhase) (ParametrisedWith [Name CTreePhase] (CTree.Node DistRef)))
+        (Map.Map (Name CTreePhase) (ProvidedParameters (CTree DistReferenced)))
     , HasReader
         "global"
-        (Map.Map (Name CTreePhase) (ParametrisedWith [Name CTreePhase] (CTree.Node DistRef)))
+        (Map.Map (Name CTreePhase) (ProvidedParameters (CTree DistReferenced)))
     )
     via Field
           "global"
@@ -479,7 +485,7 @@ throwNR :: NameResolutionFailure -> MonoM a
 throwNR = throw @"nameResolution"
 
 -- | Synthesize a monomorphic rule definition, returning the name
-synthMono :: Name CTreePhase -> [CTree.Node DistRef] -> MonoM (Name CTreePhase)
+synthMono :: Name CTreePhase -> [CTree DistReferenced] -> MonoM (Name CTreePhase)
 synthMono n@(Name origName _) args =
   let fresh =
         -- % is not a valid CBOR name, so this should avoid conflict
@@ -488,29 +494,26 @@ synthMono n@(Name origName _) args =
         -- Lookup the original name in the global bindings
         globalBinds <- ask @"global"
         case Map.lookup n globalBinds of
-          Just (Unparametrised _) -> throwNR $ MismatchingArgs n []
-          Just (Parametrised r params') ->
+          Just (ProvidedParameters [] _) -> throwNR $ MismatchingArgs n []
+          Just (ProvidedParameters params' r) ->
             if length params' == length args
               then do
-                rargs <- traverse resolveGenericRef args
+                rargs <- traverse resolveGenericCTree args
                 let localBinds = Map.fromList $ zip params' rargs
                 Reader.local @"local" (Map.union localBinds) $ do
-                  foo <- resolveGenericRef r
+                  foo <- resolveGenericCTree r
                   modify @"synth" $ Map.insert fresh foo
               else throwNR $ MismatchingArgs n params'
           Nothing -> throwNR $ UnboundReference n
         pure fresh
 
 resolveGenericRef ::
-  CTree.Node DistRef ->
-  MonoM (MonoRef (CTree MonoRef))
-resolveGenericRef (DIt a) = MIt <$> resolveGenericCTree a
-resolveGenericRef (RuleRef n margs) =
-  case margs of
-    [] -> pure $ MRuleRef n
-    args -> do
-      fresh <- synthMono n args
-      pure $ MRuleRef fresh
+  CTree.Node DistReferenced ->
+  MonoM (CTree MonoReferenced)
+resolveGenericRef (RuleRef n []) = pure . CTreeE $ MRuleRef n
+resolveGenericRef (RuleRef n args) = do
+  fresh <- synthMono n args
+  pure . CTreeE $ MRuleRef fresh
 resolveGenericRef (GenericRef n) = do
   localBinds <- ask @"local"
   case Map.lookup n localBinds of
@@ -518,47 +521,38 @@ resolveGenericRef (GenericRef n) = do
     Nothing -> throwNR $ UnboundReference n
 
 resolveGenericCTree ::
-  CTree DistRef ->
-  MonoM (CTree MonoRef)
-resolveGenericCTree = CTree.traverseCTree resolveGenericRef
+  CTree DistReferenced ->
+  MonoM (CTree MonoReferenced)
+resolveGenericCTree = CTree.traverseCTree resolveGenericRef resolveGenericCTree
 
 -- | Monomorphise the CTree
 --
 -- Concretely, for each reference in the tree to a generic rule, we synthesize a
 -- new monomorphic instance of that rule at top-level with the correct
 -- parameters applied.
-monoCTree ::
-  CTreeRoot' Identity DistRef ->
-  MonoM (CTreeRoot' Identity MonoRef)
-monoCTree (CTreeRoot ct) = CTreeRoot <$> traverse go ct
-  where
-    go = traverse resolveGenericRef
-
 buildMonoCTree ::
-  CTreeRoot DistRef ->
-  Either NameResolutionFailure (CTreeRoot' Identity MonoRef)
-buildMonoCTree (CTreeRoot ct) = do
-  let a1 = runExceptT $ runMonoM (monoCTree monoC)
+  PartialCTreeRoot DistReferenced ->
+  Either NameResolutionFailure (CTreeRoot MonoReferenced)
+buildMonoCTree (PartialCTreeRoot ct) = do
+  let a1 = runExceptT $ runMonoM (traverse resolveGenericCTree monoC)
       a2 = runStateT a1 mempty
-      (er, newBindings) = runReader a2 initBindingEnv
-  CTreeRoot r <- er
-  pure . CTreeRoot $ Map.union r $ fmap Identity newBindings
+      (r, newBindings) = runReader a2 initBindingEnv
+  CTreeRoot . (`Map.union` newBindings) <$> r
   where
     initBindingEnv = BindingEnv ct mempty
     monoC =
-      CTreeRoot $
-        Map.mapMaybe
-          ( \case
-              Unparametrised f -> Just $ Identity f
-              Parametrised _ _ -> Nothing
-          )
-          ct
+      Map.mapMaybe
+        ( \case
+            ProvidedParameters [] f -> Just f
+            _ -> Nothing
+        )
+        ct
 
 --------------------------------------------------------------------------------
 -- Combined resolution
 --------------------------------------------------------------------------------
 
-fullResolveCDDL :: CDDL CTreePhase -> Either NameResolutionFailure (CTreeRoot' Identity MonoRef)
+fullResolveCDDL :: CDDL CTreePhase -> Either NameResolutionFailure (CTreeRoot MonoReferenced)
 fullResolveCDDL cddl = do
   let refCTree = buildRefCTree (asMap cddl)
   rCTree <- buildResolvedCTree refCTree
diff --git a/src/Codec/CBOR/Cuddle/Huddle.hs b/src/Codec/CBOR/Cuddle/Huddle.hs
index c54e526..7768e14 100644
--- a/src/Codec/CBOR/Cuddle/Huddle.hs
+++ b/src/Codec/CBOR/Cuddle/Huddle.hs
@@ -111,9 +111,11 @@ import Prelude hiding ((/))
 
 data HuddlePhase
 
-type instance C.XTerm HuddlePhase = C.Comment
+newtype instance C.XTerm HuddlePhase = HuddleXTerm C.Comment
+  deriving (Generic, Semigroup, Monoid)
 
-type instance C.XCddl HuddlePhase = C.Comment
+newtype instance C.XCddl HuddlePhase = HuddleXCddl C.Comment
+  deriving (Generic, Semigroup, Monoid)
 
 data Named a = Named
   { name :: T.Text
@@ -1095,7 +1097,7 @@ toCDDL' mkPseudoRoot hdl =
           "huddle_root_defs" =:= arr (fromList (fmap a topRs))
     toCDDLRule :: Rule -> C.Rule HuddlePhase
     toCDDLRule (Named n t0 c) =
-      (\x -> C.Rule (C.Name n mempty) Nothing C.AssignEq x (foldMap C.Comment c))
+      (\x -> C.Rule (C.Name n mempty) Nothing C.AssignEq x (foldMap (HuddleXTerm . C.Comment) c))
         . C.TOGType
         . C.Type0
         $ toCDDLType1 <$> choiceToNE t0
@@ -1119,8 +1121,8 @@ toCDDL' mkPseudoRoot hdl =
     mapEntryToCDDL (MapEntry k v occ cmnt) =
       C.GroupEntry
         (toOccurrenceIndicator occ)
-        cmnt
         (C.GEType (Just $ toMemberKey k) (toCDDLType0 v))
+        (HuddleXTerm cmnt)
 
     toOccurrenceIndicator :: Occurs -> Maybe C.OccurrenceIndicator
     toOccurrenceIndicator (Occurs Nothing Nothing) = Nothing
@@ -1160,14 +1162,14 @@ toCDDL' mkPseudoRoot hdl =
     arrayToCDDLGroup xs = C.Group $ arrayChoiceToCDDL <$> choiceToNE xs
 
     arrayChoiceToCDDL :: ArrayChoice -> C.GrpChoice HuddlePhase
-    arrayChoiceToCDDL (ArrayChoice entries cmt) = C.GrpChoice (fmap arrayEntryToCDDL entries) cmt
+    arrayChoiceToCDDL (ArrayChoice entries cmt) = C.GrpChoice (fmap arrayEntryToCDDL entries) (HuddleXTerm cmt)
 
     arrayEntryToCDDL :: ArrayEntry -> C.GroupEntry HuddlePhase
     arrayEntryToCDDL (ArrayEntry k v occ cmnt) =
       C.GroupEntry
         (toOccurrenceIndicator occ)
-        cmnt
         (C.GEType (fmap toMemberKey k) (toCDDLType0 v))
+        (HuddleXTerm cmnt)
 
     toCDDLPostlude :: Value a -> C.Name HuddlePhase
     toCDDLPostlude VBool = C.Name "bool" mempty
@@ -1207,7 +1209,7 @@ toCDDL' mkPseudoRoot hdl =
         Nothing
         C.AssignEq
         ( C.TOGGroup
-            . C.GroupEntry Nothing mempty
+            . (\x -> C.GroupEntry Nothing x mempty)
             . C.GEGroup
             . C.Group
             . (NE.:| [])
@@ -1216,7 +1218,7 @@ toCDDL' mkPseudoRoot hdl =
               arrayEntryToCDDL
               t0s
         )
-        (foldMap C.Comment c)
+        (foldMap (HuddleXTerm . C.Comment) c)
 
     toGenericCall :: GRuleCall -> C.Type2 HuddlePhase
     toGenericCall (Named n gr _) =
@@ -1234,7 +1236,7 @@ toCDDL' mkPseudoRoot hdl =
             . C.Type0
             $ toCDDLType1 <$> choiceToNE (body gr)
         )
-        (foldMap C.Comment c)
+        (foldMap (HuddleXTerm . C.Comment) c)
       where
         gps =
           C.GenericParam $ fmap (\(GRef t) -> C.Name t mempty) (args gr)
diff --git a/src/Codec/CBOR/Cuddle/IndexMappable.hs b/src/Codec/CBOR/Cuddle/IndexMappable.hs
new file mode 100644
index 0000000..a77a27c
--- /dev/null
+++ b/src/Codec/CBOR/Cuddle/IndexMappable.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE DefaultSignatures #-}
+
+module Codec.CBOR.Cuddle.IndexMappable (IndexMappable (..)) where
+
+import Codec.CBOR.Cuddle.CDDL (
+  CDDL (..),
+  GenericArg (..),
+  GenericParam (..),
+  Group (..),
+  GroupEntry (..),
+  GroupEntryVariant,
+  GrpChoice (..),
+  Name (..),
+  Rule (..),
+  TopLevel (..),
+  Type0 (..),
+  Type1 (..),
+  Type2 (..),
+  TypeOrGroup (..),
+  XCddl,
+  XTerm,
+  XXTopLevel,
+  XXType2,
+ )
+import Data.Bifunctor (Bifunctor (..))
+import Data.Coerce (Coercible, coerce)
+
+class IndexMappable f i j where
+  mapIndex :: f i -> f j
+  default mapIndex :: Coercible (f i) (f j) => f i -> f j
+  mapIndex = coerce
+
+instance
+  ( IndexMappable XCddl i j
+  , IndexMappable XXTopLevel i j
+  , IndexMappable XXType2 i j
+  , IndexMappable XTerm i j
+  ) =>
+  IndexMappable CDDL i j
+  where
+  mapIndex (CDDL r tls e) = CDDL (mapIndex r) (mapIndex <$> tls) (mapIndex <$> e)
+
+instance
+  ( IndexMappable XXType2 i j
+  , IndexMappable XTerm i j
+  ) =>
+  IndexMappable Rule i j
+  where
+  mapIndex (Rule n mg a t c) = Rule (mapIndex n) (mapIndex <$> mg) a (mapIndex t) (mapIndex c)
+
+instance
+  ( IndexMappable XXTopLevel i j
+  , IndexMappable XXType2 i j
+  , IndexMappable XTerm i j
+  ) =>
+  IndexMappable TopLevel i j
+  where
+  mapIndex (TopLevelRule r) = TopLevelRule $ mapIndex r
+  mapIndex (XXTopLevel e) = XXTopLevel $ mapIndex e
+
+instance IndexMappable XTerm i j => IndexMappable Name i j where
+  mapIndex (Name n e) = Name n $ mapIndex e
+
+instance IndexMappable XTerm i j => IndexMappable GenericParam i j where
+  mapIndex (GenericParam ns) = GenericParam $ mapIndex <$> ns
+
+instance
+  ( IndexMappable XXType2 i j
+  , IndexMappable XTerm i j
+  ) =>
+  IndexMappable TypeOrGroup i j
+  where
+  mapIndex (TOGType t) = TOGType $ mapIndex t
+  mapIndex (TOGGroup g) = TOGGroup $ mapIndex g
+
+instance IndexMappable XTerm i j => IndexMappable GroupEntry i j where
+  mapIndex (GroupEntry mo gev e) = GroupEntry mo (mapIndex gev) (mapIndex e)
+
+instance IndexMappable GroupEntryVariant i j where
+  mapIndex = undefined
+
+instance
+  ( IndexMappable XXType2 i j
+  , IndexMappable XTerm i j
+  ) =>
+  IndexMappable Type0 i j
+  where
+  mapIndex (Type0 ts) = Type0 $ mapIndex <$> ts
+
+instance
+  ( IndexMappable XXType2 i j
+  , IndexMappable XTerm i j
+  ) =>
+  IndexMappable Type1 i j
+  where
+  mapIndex (Type1 t mo e) = Type1 (mapIndex t) (second mapIndex <$> mo) (mapIndex e)
+
+instance
+  ( IndexMappable XXType2 i j
+  , IndexMappable XTerm i j
+  ) =>
+  IndexMappable Type2 i j
+  where
+  mapIndex (T2Value v) = T2Value v
+  mapIndex (T2Name n mg) = T2Name (mapIndex n) (mapIndex <$> mg)
+  mapIndex (T2Group t) = T2Group $ mapIndex t
+  mapIndex (T2Map g) = T2Map $ mapIndex g
+  mapIndex (T2Array a) = T2Array $ mapIndex a
+  mapIndex (T2Unwrapped n mg) = T2Unwrapped (mapIndex n) (mapIndex <$> mg)
+  mapIndex (T2Enum g) = T2Enum $ mapIndex g
+  mapIndex (T2EnumRef n mg) = T2EnumRef (mapIndex n) (mapIndex <$> mg)
+  mapIndex (T2Tag mt t) = T2Tag mt $ mapIndex t
+  mapIndex (T2DataItem t mt) = T2DataItem t mt
+  mapIndex T2Any = T2Any
+  mapIndex (XXType2 e) = XXType2 $ mapIndex e
+
+instance
+  ( IndexMappable XXType2 i j
+  , IndexMappable XTerm i j
+  ) =>
+  IndexMappable GenericArg i j
+  where
+  mapIndex (GenericArg g) = GenericArg $ mapIndex <$> g
+
+instance IndexMappable XTerm i j => IndexMappable Group i j where
+  mapIndex (Group g) = Group $ mapIndex <$> g
+
+instance IndexMappable XTerm i j => IndexMappable GrpChoice i j where
+  mapIndex (GrpChoice gs e) = GrpChoice (mapIndex <$> gs) $ mapIndex e
diff --git a/src/Codec/CBOR/Cuddle/Parser.hs b/src/Codec/CBOR/Cuddle/Parser.hs
index 64a3ed2..6152325 100644
--- a/src/Codec/CBOR/Cuddle/Parser.hs
+++ b/src/Codec/CBOR/Cuddle/Parser.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -31,6 +32,7 @@ import Data.Maybe (isJust)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.Encoding (encodeUtf8)
+import GHC.Generics (Generic)
 import GHC.Word (Word64, Word8)
 import Optics.Core ((&), (.~))
 import Text.Megaparsec
@@ -40,11 +42,17 @@ import Text.Megaparsec.Char.Lexer qualified as L
 
 data ParserStage
 
-type instance XXTopLevel ParserStage = Comment
+newtype instance XXTopLevel ParserStage = ParserXXTopLevel Comment
+  deriving (Generic)
 
-type instance XTerm ParserStage = Comment
+newtype instance XTerm ParserStage = ParserXTerm {unParserXTerm :: Comment}
+  deriving (Generic, Semigroup, Monoid)
 
-type instance XCddl ParserStage = [Comment]
+newtype instance XCddl ParserStage = ParserXCddl [Comment]
+  deriving (Generic, Semigroup, Monoid)
+
+instance HasComment (XTerm ParserStage) where
+  commentL = #unParserXTerm
 
 pCDDL :: Parser (CDDL ParserStage)
 pCDDL = do
@@ -52,7 +60,8 @@ pCDDL = do
   initialRuleComment <- C.space *> optional pCommentBlock
   initialRule <- pRule
   cddlTail <- many $ pTopLevel <* C.space
-  eof $> CDDL (initialRule //- fold initialRuleComment) cddlTail initialComments
+  eof
+    $> CDDL (initialRule //- fold initialRuleComment) cddlTail (ParserXXTopLevel <$> initialComments)
 
 pTopLevel :: Parser (TopLevel ParserStage)
 pTopLevel = try tlRule <|> tlComment
@@ -61,7 +70,7 @@ pTopLevel = try tlRule <|> tlComment
       mCmt <- optional pCommentBlock
       rule <- pRule
       pure . TopLevelRule $ rule //- fold mCmt
-    tlComment = XXTopLevel <$> pCommentBlock
+    tlComment = XXTopLevel . ParserXXTopLevel <$> pCommentBlock
 
 pRule :: Parser (Rule ParserStage)
 pRule = do
@@ -77,7 +86,7 @@ pRule = do
             <*> (TOGType <$> pType0 <* notFollowedBy (space >> (":" <|> "=>")))
       , (,) <$> pAssignG <* space <*> (TOGGroup <$> pGrpEntry)
       ]
-  pure $ Rule name genericParam assign typeOrGrp cmt
+  pure $ Rule name genericParam assign typeOrGrp (ParserXTerm cmt)
 
 pName :: Parser (Name ParserStage)
 pName = label "name" $ do
@@ -133,7 +142,7 @@ pType1 = do
     pure (cmtFst, tyOp, cmtSnd, w)
   case rest of
     Just (cmtFst, tyOp, cmtSnd, w) ->
-      pure $ Type1 v (Just (tyOp, w)) $ cmtFst <> cmtSnd
+      pure $ Type1 v (Just (tyOp, w)) . ParserXTerm $ cmtFst <> cmtSnd
     Nothing -> pure $ Type1 v Nothing mempty
 
 pType2 :: Parser (Type2 ParserStage)
@@ -219,7 +228,7 @@ pGrpEntry = do
       , try $ withComment <$> (GERef <$> pName <*> optional pGenericArg)
       , withComment . GEGroup <$> ("(" *> space !*> pGroup <*! space <* ")")
       ]
-  pure $ GroupEntry occur (cmt <> cmt') variant
+  pure $ GroupEntry occur variant (ParserXTerm $ cmt <> cmt')
 
 pMemberKey :: Parser (WithComment (MemberKey ParserStage))
 pMemberKey =
diff --git a/src/Codec/CBOR/Cuddle/Pretty.hs b/src/Codec/CBOR/Cuddle/Pretty.hs
index fe1b0f2..2033f93 100644
--- a/src/Codec/CBOR/Cuddle/Pretty.hs
+++ b/src/Codec/CBOR/Cuddle/Pretty.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
@@ -8,7 +9,7 @@ module Codec.CBOR.Cuddle.Pretty where
 
 import Codec.CBOR.Cuddle.CDDL
 import Codec.CBOR.Cuddle.CDDL.CtlOp (CtlOp)
-import Codec.CBOR.Cuddle.Comments (CollectComments (..), Comment (..), unComment)
+import Codec.CBOR.Cuddle.Comments (CollectComments (..), Comment (..), HasComment (..), unComment)
 import Codec.CBOR.Cuddle.Pretty.Columnar (
   Cell (..),
   CellAlign (..),
@@ -28,27 +29,36 @@ import Data.List.NonEmpty qualified as NE
 import Data.String (fromString)
 import Data.Text qualified as T
 import Data.Void (Void, absurd)
+import GHC.Generics (Generic)
+import Optics.Core ((^.))
 import Prettyprinter
 
 data PrettyStage
 
-type instance XXTopLevel PrettyStage = Comment
+newtype instance XXTopLevel PrettyStage = PrettyXXTopLevel Comment
+  deriving (Generic, CollectComments)
 
-type instance XXType2 PrettyStage = Void
+newtype instance XXType2 PrettyStage = PrettyXXType2 Void
+  deriving (Generic, CollectComments)
 
-type instance XTerm PrettyStage = Comment
+newtype instance XTerm PrettyStage = PrettyXTerm {unPrettyXTerm :: Comment}
+  deriving (Generic, CollectComments, Semigroup, Monoid)
 
-type instance XCddl PrettyStage = [Comment]
+newtype instance XCddl PrettyStage = PrettyXCddl [Comment]
+  deriving (Generic, CollectComments)
+
+instance HasComment (XTerm PrettyStage) where
+  commentL = #unPrettyXTerm
 
 instance Pretty (CDDL PrettyStage) where
   pretty = vsep . fmap pretty . NE.toList . cddlTopLevel
 
 instance Pretty (TopLevel PrettyStage) where
-  pretty (XXTopLevel cmt) = pretty cmt
+  pretty (XXTopLevel (PrettyXXTopLevel cmt)) = pretty cmt
   pretty (TopLevelRule x) = pretty x <> hardline
 
 instance Pretty (Name PrettyStage) where
-  pretty (Name name cmt) = pretty name <> prettyCommentNoBreakWS cmt
+  pretty (Name name (PrettyXTerm cmt)) = pretty name <> prettyCommentNoBreakWS cmt
 
 data CommentRender
   = PreComment
@@ -71,7 +81,7 @@ type0Def t = nest 2 $ line' <> pretty t
 
 instance Pretty (Rule PrettyStage) where
   pretty (Rule n mgen assign tog cmt) =
-    pretty cmt
+    pretty (cmt ^. commentL)
       <> groupIfNoComments
         tog
         ( pretty n <> pretty mgen <+> case tog of
@@ -100,7 +110,7 @@ instance Pretty (Type0 PrettyStage) where
   pretty t0@(Type0 (NE.toList -> l)) =
     groupIfNoComments t0 $ columnarSepBy "/" . Columnar $ type1ToRow <$> l
     where
-      type1ToRow (Type1 t2 tyOp cmt) =
+      type1ToRow (Type1 t2 tyOp (PrettyXTerm cmt)) =
         let
           valCell = case tyOp of
             Nothing -> cellL t2
@@ -117,8 +127,8 @@ instance Pretty TyOp where
   pretty (CtrlOp n) = "." <> pretty n
 
 instance Pretty (Type1 PrettyStage) where
-  pretty (Type1 t2 Nothing cmt) = groupIfNoComments t2 (pretty t2) <> prettyCommentNoBreakWS cmt
-  pretty (Type1 t2 (Just (tyop, t2')) cmt) =
+  pretty (Type1 t2 Nothing (PrettyXTerm cmt)) = groupIfNoComments t2 (pretty t2) <> prettyCommentNoBreakWS cmt
+  pretty (Type1 t2 (Just (tyop, t2')) (PrettyXTerm cmt)) =
     groupIfNoComments t2 (pretty t2)
       <+> pretty tyop
       <+> groupIfNoComments t2' (pretty t2')
@@ -143,7 +153,7 @@ instance Pretty (Type2 PrettyStage) where
       Nothing -> mempty
       Just minor -> "." <> pretty minor
   pretty T2Any = "#"
-  pretty (XXType2 v) = absurd v
+  pretty (XXType2 (PrettyXXType2 v)) = absurd v
 
 instance Pretty OccurrenceIndicator where
   pretty OIOptional = "?"
@@ -181,7 +191,7 @@ groupIfNoComments x
 columnarGroupChoice :: GrpChoice PrettyStage -> Columnar ann
 columnarGroupChoice (GrpChoice ges _cmt) = Columnar grpEntryRows
   where
-    groupEntryRow (GroupEntry oi cmt gev) =
+    groupEntryRow (GroupEntry oi gev (PrettyXTerm cmt)) =
       Row $
         [maybe emptyCell (\x -> Cell (pretty x <> space) LeftAlign) oi]
           <> groupEntryVariantCells gev

From a4dd2109012fb40fe0a3ac60602b9f1837dea146 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Wed, 8 Oct 2025 12:36:09 +0300
Subject: [PATCH 09/15] Done

---
 src/Codec/CBOR/Cuddle/IndexMappable.hs | 38 ++++++++++++++++++++++++++
 src/Codec/CBOR/Cuddle/Parser.hs        |  3 ++
 2 files changed, 41 insertions(+)

diff --git a/src/Codec/CBOR/Cuddle/IndexMappable.hs b/src/Codec/CBOR/Cuddle/IndexMappable.hs
index a77a27c..1f96444 100644
--- a/src/Codec/CBOR/Cuddle/IndexMappable.hs
+++ b/src/Codec/CBOR/Cuddle/IndexMappable.hs
@@ -22,8 +22,18 @@ import Codec.CBOR.Cuddle.CDDL (
   XXTopLevel,
   XXType2,
  )
+import Codec.CBOR.Cuddle.CDDL.CTree (
+  CTreePhase,
+  XCddl (..),
+  XTerm (..),
+  XXTopLevel (..),
+  XXType2 (..),
+ )
+import Codec.CBOR.Cuddle.Parser (ParserStage, XCddl (..), XTerm (..), XXTopLevel (..), XXType2 (..))
+import Codec.CBOR.Cuddle.Pretty (PrettyStage, XCddl (..), XTerm (..), XXTopLevel (..))
 import Data.Bifunctor (Bifunctor (..))
 import Data.Coerce (Coercible, coerce)
+import Data.Void (absurd)
 
 class IndexMappable f i j where
   mapIndex :: f i -> f j
@@ -127,3 +137,31 @@ instance IndexMappable XTerm i j => IndexMappable Group i j where
 
 instance IndexMappable XTerm i j => IndexMappable GrpChoice i j where
   mapIndex (GrpChoice gs e) = GrpChoice (mapIndex <$> gs) $ mapIndex e
+
+-- ParserStage -> PrettyStage
+
+instance IndexMappable XCddl ParserStage PrettyStage where
+  mapIndex (ParserXCddl c) = PrettyXCddl c
+
+instance IndexMappable XTerm ParserStage PrettyStage where
+  mapIndex (ParserXTerm c) = PrettyXTerm c
+
+instance IndexMappable XXType2 ParserStage PrettyStage where
+  mapIndex (ParserXXType2 v) = absurd v
+
+instance IndexMappable XXTopLevel ParserStage PrettyStage where
+  mapIndex (ParserXXTopLevel c) = PrettyXXTopLevel c
+
+-- ParserStage -> CTreePhase
+
+instance IndexMappable XCddl ParserStage CTreePhase where
+  mapIndex (ParserXCddl c) = CTreeXCddl c
+
+instance IndexMappable XXTopLevel ParserStage CTreePhase where
+  mapIndex (ParserXXTopLevel c) = CTreeXXTopLevel c
+
+instance IndexMappable XXType2 ParserStage CTreePhase where
+  mapIndex (ParserXXType2 c) = CTreeXXType2 c
+
+instance IndexMappable XTerm ParserStage CTreePhase where
+  mapIndex (ParserXTerm c) = CTreeXTerm c
diff --git a/src/Codec/CBOR/Cuddle/Parser.hs b/src/Codec/CBOR/Cuddle/Parser.hs
index 6152325..235329e 100644
--- a/src/Codec/CBOR/Cuddle/Parser.hs
+++ b/src/Codec/CBOR/Cuddle/Parser.hs
@@ -32,6 +32,7 @@ import Data.Maybe (isJust)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.Encoding (encodeUtf8)
+import Data.Void (Void)
 import GHC.Generics (Generic)
 import GHC.Word (Word64, Word8)
 import Optics.Core ((&), (.~))
@@ -45,6 +46,8 @@ data ParserStage
 newtype instance XXTopLevel ParserStage = ParserXXTopLevel Comment
   deriving (Generic)
 
+newtype instance XXType2 ParserStage = ParserXXType2 Void
+
 newtype instance XTerm ParserStage = ParserXTerm {unParserXTerm :: Comment}
   deriving (Generic, Semigroup, Monoid)
 

From b7bf155bd0a5ec59bc9b3916f0e9b04c1ef8b459 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Wed, 8 Oct 2025 16:29:25 +0300
Subject: [PATCH 10/15] Tests fixed

---
 cuddle.cabal                                 |   1 +
 src/Codec/CBOR/Cuddle/CDDL.hs                |   4 +-
 src/Codec/CBOR/Cuddle/Huddle.hs              |  67 ++++---
 src/Codec/CBOR/Cuddle/IndexMappable.hs       |  15 ++
 src/Codec/CBOR/Cuddle/Parser.hs              |   8 +-
 src/Codec/CBOR/Cuddle/Pretty.hs              |  11 +-
 test/Test/Codec/CBOR/Cuddle/CDDL/Examples.hs |   8 +-
 test/Test/Codec/CBOR/Cuddle/CDDL/Gen.hs      |  55 ++++--
 test/Test/Codec/CBOR/Cuddle/CDDL/Parser.hs   | 194 ++++++++++---------
 test/Test/Codec/CBOR/Cuddle/CDDL/Pretty.hs   |  49 ++---
 test/Test/Codec/CBOR/Cuddle/Huddle.hs        |  11 +-
 11 files changed, 248 insertions(+), 175 deletions(-)

diff --git a/cuddle.cabal b/cuddle.cabal
index ca6aee1..ccce127 100644
--- a/cuddle.cabal
+++ b/cuddle.cabal
@@ -150,6 +150,7 @@ test-suite cuddle-test
     bytestring,
     cuddle,
     data-default-class,
+    generic-random,
     hspec >=2.11,
     hspec-megaparsec >=2.2,
     megaparsec,
diff --git a/src/Codec/CBOR/Cuddle/CDDL.hs b/src/Codec/CBOR/Cuddle/CDDL.hs
index 6127ba7..d34dc98 100644
--- a/src/Codec/CBOR/Cuddle/CDDL.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL.hs
@@ -151,7 +151,7 @@ deriving instance ForAllExtensions i ToExpr => ToExpr (TopLevel i)
 --      encoding, but names used as "barewords" in member keys do.
 data Name i = Name
   { name :: T.Text
-  , nameF :: XTerm i
+  , nameExt :: XTerm i
   }
   deriving (Generic)
 
@@ -167,7 +167,7 @@ instance Monoid (XTerm i) => IsString (Name i) where
   fromString x = Name (T.pack x) mempty
 
 instance HasComment (XTerm i) => HasComment (Name i) where
-  commentL = #nameF % commentL
+  commentL = #nameExt % commentL
 
 instance CollectComments (XTerm i) => CollectComments (Name i) where
   collectComments (Name _ c) = collectComments c
diff --git a/src/Codec/CBOR/Cuddle/Huddle.hs b/src/Codec/CBOR/Cuddle/Huddle.hs
index 7768e14..25702e3 100644
--- a/src/Codec/CBOR/Cuddle/Huddle.hs
+++ b/src/Codec/CBOR/Cuddle/Huddle.hs
@@ -21,6 +21,13 @@ module Codec.CBOR.Cuddle.Huddle (
   IsType0 (..),
   Value (..),
 
+  -- * AST extensions
+  HuddleStage,
+  C.XCddl (..),
+  C.XTerm (..),
+  C.XXTopLevel (..),
+  C.XXType2 (..),
+
   -- * Rules and assignment
   (=:=),
   (=:~),
@@ -109,13 +116,19 @@ import GHC.Generics (Generic)
 import Optics.Core (lens, view, (%~), (&), (.~), (^.))
 import Prelude hiding ((/))
 
-data HuddlePhase
+data HuddleStage
+
+newtype instance C.XTerm HuddleStage = HuddleXTerm C.Comment
+  deriving (Generic, Semigroup, Monoid, Show, Eq)
+
+newtype instance C.XCddl HuddleStage = HuddleXCddl [C.Comment]
+  deriving (Generic, Semigroup, Monoid, Show, Eq)
 
-newtype instance C.XTerm HuddlePhase = HuddleXTerm C.Comment
-  deriving (Generic, Semigroup, Monoid)
+newtype instance C.XXTopLevel HuddleStage = HuddleXXTopLevel C.Comment
+  deriving (Generic, Semigroup, Monoid, Show, Eq)
 
-newtype instance C.XCddl HuddlePhase = HuddleXCddl C.Comment
-  deriving (Generic, Semigroup, Monoid)
+newtype instance C.XXType2 HuddleStage = HuddleXXType2 Void
+  deriving (Generic, Semigroup, Show, Eq)
 
 data Named a = Named
   { name :: T.Text
@@ -440,7 +453,7 @@ unconstrained v = Constrained (CValue v) def []
 -- | A constraint on a 'Value' is something applied via CtlOp or RangeOp on a
 -- Type2, forming a Type1.
 data ValueConstraint a = ValueConstraint
-  { applyConstraint :: C.Type2 HuddlePhase -> C.Type1 HuddlePhase
+  { applyConstraint :: C.Type2 HuddleStage -> C.Type1 HuddleStage
   , showConstraint :: String
   }
 
@@ -470,7 +483,7 @@ instance IsSizeable CGRefType
 
 -- | Things which can be used on the RHS of the '.size' operator.
 class IsSize a where
-  sizeAsCDDL :: a -> C.Type2 HuddlePhase
+  sizeAsCDDL :: a -> C.Type2 HuddleStage
   sizeAsString :: a -> String
 
 instance IsSize Word where
@@ -1070,15 +1083,15 @@ collectFromInit rules =
 --------------------------------------------------------------------------------
 
 -- | Convert from Huddle to CDDL, generating a top level root element.
-toCDDL :: Huddle -> CDDL HuddlePhase
+toCDDL :: Huddle -> CDDL HuddleStage
 toCDDL = toCDDL' True
 
 -- | Convert from Huddle to CDDL, skipping a root element.
-toCDDLNoRoot :: Huddle -> CDDL HuddlePhase
+toCDDLNoRoot :: Huddle -> CDDL HuddleStage
 toCDDLNoRoot = toCDDL' False
 
 -- | Convert from Huddle to CDDL for the purpose of pretty-printing.
-toCDDL' :: Bool -> Huddle -> CDDL HuddlePhase
+toCDDL' :: Bool -> Huddle -> CDDL HuddleStage
 toCDDL' mkPseudoRoot hdl =
   C.fromRules
     $ ( if mkPseudoRoot
@@ -1090,12 +1103,12 @@ toCDDL' mkPseudoRoot hdl =
     toCDDLItem (HIRule r) = toCDDLRule r
     toCDDLItem (HIGroup g) = toCDDLGroup g
     toCDDLItem (HIGRule g) = toGenRuleDef g
-    toTopLevelPseudoRoot :: [Rule] -> C.Rule HuddlePhase
+    toTopLevelPseudoRoot :: [Rule] -> C.Rule HuddleStage
     toTopLevelPseudoRoot topRs =
       toCDDLRule $
         comment "Pseudo-rule introduced by Cuddle to collect root elements" $
           "huddle_root_defs" =:= arr (fromList (fmap a topRs))
-    toCDDLRule :: Rule -> C.Rule HuddlePhase
+    toCDDLRule :: Rule -> C.Rule HuddleStage
     toCDDLRule (Named n t0 c) =
       (\x -> C.Rule (C.Name n mempty) Nothing C.AssignEq x (foldMap (HuddleXTerm . C.Comment) c))
         . C.TOGType
@@ -1111,13 +1124,13 @@ toCDDL' mkPseudoRoot hdl =
     toCDDLValue' (LText t) = C.VText t
     toCDDLValue' (LBytes b) = C.VBytes b
 
-    mapToCDDLGroup :: Map -> C.Group HuddlePhase
+    mapToCDDLGroup :: Map -> C.Group HuddleStage
     mapToCDDLGroup xs = C.Group $ mapChoiceToCDDL <$> choiceToNE xs
 
-    mapChoiceToCDDL :: MapChoice -> C.GrpChoice HuddlePhase
+    mapChoiceToCDDL :: MapChoice -> C.GrpChoice HuddleStage
     mapChoiceToCDDL (MapChoice entries) = C.GrpChoice (fmap mapEntryToCDDL entries) mempty
 
-    mapEntryToCDDL :: MapEntry -> C.GroupEntry HuddlePhase
+    mapEntryToCDDL :: MapEntry -> C.GroupEntry HuddleStage
     mapEntryToCDDL (MapEntry k v occ cmnt) =
       C.GroupEntry
         (toOccurrenceIndicator occ)
@@ -1131,7 +1144,7 @@ toCDDL' mkPseudoRoot hdl =
     toOccurrenceIndicator (Occurs (Just 1) Nothing) = Just C.OIOneOrMore
     toOccurrenceIndicator (Occurs lb ub) = Just $ C.OIBounded lb ub
 
-    toCDDLType1 :: Type2 -> C.Type1 HuddlePhase
+    toCDDLType1 :: Type2 -> C.Type1 HuddleStage
     toCDDLType1 = \case
       T2Constrained (Constrained x constr _) ->
         -- TODO Need to handle choices at the top level
@@ -1150,28 +1163,28 @@ toCDDL' mkPseudoRoot hdl =
       T2Generic g -> C.Type1 (toGenericCall g) Nothing mempty
       T2GenericRef (GRef n) -> C.Type1 (C.T2Name (C.Name n mempty) Nothing) Nothing mempty
 
-    toMemberKey :: Key -> C.MemberKey HuddlePhase
+    toMemberKey :: Key -> C.MemberKey HuddleStage
     toMemberKey (LiteralKey (Literal (LText t) _)) = C.MKBareword (C.Name t mempty)
     toMemberKey (LiteralKey v) = C.MKValue $ toCDDLValue v
     toMemberKey (TypeKey t) = C.MKType (toCDDLType1 t)
 
-    toCDDLType0 :: Type0 -> C.Type0 HuddlePhase
+    toCDDLType0 :: Type0 -> C.Type0 HuddleStage
     toCDDLType0 = C.Type0 . fmap toCDDLType1 . choiceToNE
 
-    arrayToCDDLGroup :: Array -> C.Group HuddlePhase
+    arrayToCDDLGroup :: Array -> C.Group HuddleStage
     arrayToCDDLGroup xs = C.Group $ arrayChoiceToCDDL <$> choiceToNE xs
 
-    arrayChoiceToCDDL :: ArrayChoice -> C.GrpChoice HuddlePhase
+    arrayChoiceToCDDL :: ArrayChoice -> C.GrpChoice HuddleStage
     arrayChoiceToCDDL (ArrayChoice entries cmt) = C.GrpChoice (fmap arrayEntryToCDDL entries) (HuddleXTerm cmt)
 
-    arrayEntryToCDDL :: ArrayEntry -> C.GroupEntry HuddlePhase
+    arrayEntryToCDDL :: ArrayEntry -> C.GroupEntry HuddleStage
     arrayEntryToCDDL (ArrayEntry k v occ cmnt) =
       C.GroupEntry
         (toOccurrenceIndicator occ)
         (C.GEType (fmap toMemberKey k) (toCDDLType0 v))
         (HuddleXTerm cmnt)
 
-    toCDDLPostlude :: Value a -> C.Name HuddlePhase
+    toCDDLPostlude :: Value a -> C.Name HuddleStage
     toCDDLPostlude VBool = C.Name "bool" mempty
     toCDDLPostlude VUInt = C.Name "uint" mempty
     toCDDLPostlude VNInt = C.Name "nint" mempty
@@ -1189,7 +1202,7 @@ toCDDL' mkPseudoRoot hdl =
       CRef r -> C.Name (name r) mempty
       CGRef (GRef n) -> C.Name n mempty
 
-    toCDDLRanged :: Ranged -> C.Type1 HuddlePhase
+    toCDDLRanged :: Ranged -> C.Type1 HuddleStage
     toCDDLRanged (Unranged x) =
       C.Type1 (C.T2Value $ toCDDLValue x) Nothing mempty
     toCDDLRanged (Ranged lb ub rop) =
@@ -1198,11 +1211,11 @@ toCDDL' mkPseudoRoot hdl =
         (Just (C.RangeOp rop, toCDDLRangeBound ub))
         mempty
 
-    toCDDLRangeBound :: RangeBound -> C.Type2 HuddlePhase
+    toCDDLRangeBound :: RangeBound -> C.Type2 HuddleStage
     toCDDLRangeBound (RangeBoundLiteral l) = C.T2Value $ toCDDLValue l
     toCDDLRangeBound (RangeBoundRef (Named n _ _)) = C.T2Name (C.Name n mempty) Nothing
 
-    toCDDLGroup :: Named Group -> C.Rule HuddlePhase
+    toCDDLGroup :: Named Group -> C.Rule HuddleStage
     toCDDLGroup (Named n (Group t0s) c) =
       C.Rule
         (C.Name n mempty)
@@ -1220,13 +1233,13 @@ toCDDL' mkPseudoRoot hdl =
         )
         (foldMap (HuddleXTerm . C.Comment) c)
 
-    toGenericCall :: GRuleCall -> C.Type2 HuddlePhase
+    toGenericCall :: GRuleCall -> C.Type2 HuddleStage
     toGenericCall (Named n gr _) =
       C.T2Name
         (C.Name n mempty)
         (Just . C.GenericArg $ fmap toCDDLType1 (args gr))
 
-    toGenRuleDef :: GRuleDef -> C.Rule HuddlePhase
+    toGenRuleDef :: GRuleDef -> C.Rule HuddleStage
     toGenRuleDef (Named n gr c) =
       C.Rule
         (C.Name n mempty)
diff --git a/src/Codec/CBOR/Cuddle/IndexMappable.hs b/src/Codec/CBOR/Cuddle/IndexMappable.hs
index 1f96444..6f2cdeb 100644
--- a/src/Codec/CBOR/Cuddle/IndexMappable.hs
+++ b/src/Codec/CBOR/Cuddle/IndexMappable.hs
@@ -29,6 +29,7 @@ import Codec.CBOR.Cuddle.CDDL.CTree (
   XXTopLevel (..),
   XXType2 (..),
  )
+import Codec.CBOR.Cuddle.Huddle (HuddleStage, XCddl (..), XTerm (..), XXTopLevel (..), XXType2 (..))
 import Codec.CBOR.Cuddle.Parser (ParserStage, XCddl (..), XTerm (..), XXTopLevel (..), XXType2 (..))
 import Codec.CBOR.Cuddle.Pretty (PrettyStage, XCddl (..), XTerm (..), XXTopLevel (..))
 import Data.Bifunctor (Bifunctor (..))
@@ -165,3 +166,17 @@ instance IndexMappable XXType2 ParserStage CTreePhase where
 
 instance IndexMappable XTerm ParserStage CTreePhase where
   mapIndex (ParserXTerm c) = CTreeXTerm c
+
+-- ParserStage -> HuddleStage
+
+instance IndexMappable XCddl ParserStage HuddleStage where
+  mapIndex (ParserXCddl c) = HuddleXCddl c
+
+instance IndexMappable XXTopLevel ParserStage HuddleStage where
+  mapIndex (ParserXXTopLevel c) = HuddleXXTopLevel c
+
+instance IndexMappable XXType2 ParserStage HuddleStage where
+  mapIndex (ParserXXType2 c) = HuddleXXType2 c
+
+instance IndexMappable XTerm ParserStage HuddleStage where
+  mapIndex (ParserXTerm c) = HuddleXTerm c
diff --git a/src/Codec/CBOR/Cuddle/Parser.hs b/src/Codec/CBOR/Cuddle/Parser.hs
index 235329e..d71c18f 100644
--- a/src/Codec/CBOR/Cuddle/Parser.hs
+++ b/src/Codec/CBOR/Cuddle/Parser.hs
@@ -32,6 +32,7 @@ import Data.Maybe (isJust)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.Encoding (encodeUtf8)
+import Data.TreeDiff (ToExpr)
 import Data.Void (Void)
 import GHC.Generics (Generic)
 import GHC.Word (Word64, Word8)
@@ -44,15 +45,16 @@ import Text.Megaparsec.Char.Lexer qualified as L
 data ParserStage
 
 newtype instance XXTopLevel ParserStage = ParserXXTopLevel Comment
-  deriving (Generic)
+  deriving (Generic, Show, Eq, ToExpr)
 
 newtype instance XXType2 ParserStage = ParserXXType2 Void
+  deriving (Generic, Show, Eq, ToExpr)
 
 newtype instance XTerm ParserStage = ParserXTerm {unParserXTerm :: Comment}
-  deriving (Generic, Semigroup, Monoid)
+  deriving (Generic, Semigroup, Monoid, Show, Eq, ToExpr)
 
 newtype instance XCddl ParserStage = ParserXCddl [Comment]
-  deriving (Generic, Semigroup, Monoid)
+  deriving (Generic, Semigroup, Monoid, Show, Eq, ToExpr)
 
 instance HasComment (XTerm ParserStage) where
   commentL = #unParserXTerm
diff --git a/src/Codec/CBOR/Cuddle/Pretty.hs b/src/Codec/CBOR/Cuddle/Pretty.hs
index 2033f93..5914fbf 100644
--- a/src/Codec/CBOR/Cuddle/Pretty.hs
+++ b/src/Codec/CBOR/Cuddle/Pretty.hs
@@ -26,8 +26,9 @@ import Codec.CBOR.Cuddle.Pretty.Utils (renderedLen, softspace)
 import Data.ByteString.Char8 qualified as BS
 import Data.Foldable (Foldable (..))
 import Data.List.NonEmpty qualified as NE
-import Data.String (fromString)
+import Data.String (IsString, fromString)
 import Data.Text qualified as T
+import Data.TreeDiff (ToExpr)
 import Data.Void (Void, absurd)
 import GHC.Generics (Generic)
 import Optics.Core ((^.))
@@ -36,16 +37,16 @@ import Prettyprinter
 data PrettyStage
 
 newtype instance XXTopLevel PrettyStage = PrettyXXTopLevel Comment
-  deriving (Generic, CollectComments)
+  deriving (Generic, CollectComments, ToExpr, Show, Eq)
 
 newtype instance XXType2 PrettyStage = PrettyXXType2 Void
-  deriving (Generic, CollectComments)
+  deriving (Generic, CollectComments, ToExpr, Show, Eq)
 
 newtype instance XTerm PrettyStage = PrettyXTerm {unPrettyXTerm :: Comment}
-  deriving (Generic, CollectComments, Semigroup, Monoid)
+  deriving (Generic, CollectComments, Semigroup, Monoid, IsString, ToExpr, Show, Eq)
 
 newtype instance XCddl PrettyStage = PrettyXCddl [Comment]
-  deriving (Generic, CollectComments)
+  deriving (Generic, CollectComments, ToExpr, Show, Eq)
 
 instance HasComment (XTerm PrettyStage) where
   commentL = #unPrettyXTerm
diff --git a/test/Test/Codec/CBOR/Cuddle/CDDL/Examples.hs b/test/Test/Codec/CBOR/Cuddle/CDDL/Examples.hs
index 6845565..b0f10c5 100644
--- a/test/Test/Codec/CBOR/Cuddle/CDDL/Examples.hs
+++ b/test/Test/Codec/CBOR/Cuddle/CDDL/Examples.hs
@@ -4,13 +4,13 @@ module Test.Codec.CBOR.Cuddle.CDDL.Examples (spec) where
 
 import Codec.CBOR.Cuddle.CDDL (Value (..), ValueVariant (..))
 import Codec.CBOR.Cuddle.CDDL.CTree (CTree (..), CTreeRoot)
-import Codec.CBOR.Cuddle.CDDL.Postlude (PTerm (..))
-import Codec.CBOR.Cuddle.CDDL.Prelude (prependPrelude)
+import Codec.CBOR.Cuddle.CDDL.Postlude (PTerm (..), appendPostlude)
 import Codec.CBOR.Cuddle.CDDL.Resolve (
   MonoReferenced,
   NameResolutionFailure (..),
   fullResolveCDDL,
  )
+import Codec.CBOR.Cuddle.IndexMappable (IndexMappable (..))
 import Codec.CBOR.Cuddle.Parser (pCDDL)
 import Data.Text.IO qualified as T
 import Test.HUnit (assertFailure)
@@ -22,9 +22,9 @@ tryValidateFile :: FilePath -> IO (Either NameResolutionFailure (CTreeRoot MonoR
 tryValidateFile filePath = do
   contents <- T.readFile filePath
   cddl <- case parse pCDDL "" contents of
-    Right x -> pure $ prependPrelude x
+    Right x -> pure $ appendPostlude x
     Left x -> fail $ "Failed to parse the file:\n" <> errorBundlePretty x
-  pure $ fullResolveCDDL cddl
+  pure . fullResolveCDDL $ mapIndex cddl
 
 validateExpectSuccess :: FilePath -> Spec
 validateExpectSuccess filePath = it ("Successfully validates " <> filePath) $ do
diff --git a/test/Test/Codec/CBOR/Cuddle/CDDL/Gen.hs b/test/Test/Codec/CBOR/Cuddle/CDDL/Gen.hs
index d907b3f..dd5ae35 100644
--- a/test/Test/Codec/CBOR/Cuddle/CDDL/Gen.hs
+++ b/test/Test/Codec/CBOR/Cuddle/CDDL/Gen.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -7,6 +9,8 @@ module Test.Codec.CBOR.Cuddle.CDDL.Gen () where
 import Codec.CBOR.Cuddle.CDDL
 import Codec.CBOR.Cuddle.CDDL.CtlOp
 import Codec.CBOR.Cuddle.Comments (Comment (..))
+import Codec.CBOR.Cuddle.Parser (ParserStage, XTerm (..))
+import Codec.CBOR.Cuddle.Pretty (PrettyStage, XTerm (..), XXTopLevel (..))
 import Data.ByteString (ByteString)
 import Data.ByteString qualified as BS
 import Data.List.NonEmpty qualified as NE
@@ -15,18 +19,24 @@ import Data.Text qualified as T
 import Test.QuickCheck
 import Test.QuickCheck qualified as Gen
 
-instance Arbitrary CDDL where
+instance Arbitrary (CDDL PrettyStage) where
   arbitrary = CDDL <$> arbitrary <*> arbitrary <*> arbitrary
   shrink = genericShrink
 
-instance Arbitrary TopLevel where
+deriving newtype instance Arbitrary (XXTopLevel PrettyStage)
+
+deriving newtype instance Arbitrary (XTerm PrettyStage)
+
+instance Arbitrary (TopLevel PrettyStage) where
   arbitrary =
     Gen.oneof
-      [ TopLevelComment <$> arbitrary
+      [ XXTopLevel <$> arbitrary
       , TopLevelRule <$> arbitrary
       ]
   shrink = genericShrink
 
+deriving newtype instance Arbitrary (XTerm ParserStage)
+
 instance Arbitrary T.Text where
   arbitrary = T.pack <$> arbitrary
   shrink = fmap T.pack . shrink . T.unpack
@@ -48,7 +58,7 @@ nameMidChars = nameFstChars <> ['1' .. '9'] <> ['-', '.']
 nameEndChars :: [Char]
 nameEndChars = nameFstChars <> ['1' .. '9']
 
-instance Arbitrary Name where
+instance (Monoid (XTerm i), Arbitrary (XTerm i)) => Arbitrary (Name i) where
   arbitrary =
     let veryShortListOf = resize 3 . listOf
      in do
@@ -73,15 +83,15 @@ instance Arbitrary Assign where
   arbitrary = Gen.elements [AssignEq, AssignExt]
   shrink = genericShrink
 
-instance Arbitrary GenericParam where
+instance (Monoid (XTerm i), Arbitrary (XTerm i)) => Arbitrary (GenericParam i) where
   arbitrary = GenericParam <$> nonEmpty arbitrary
   shrink (GenericParam neName) = GenericParam <$> shrinkNE neName
 
-instance Arbitrary GenericArg where
+instance (Arbitrary (XTerm i), Monoid (XTerm i)) => Arbitrary (GenericArg i) where
   arbitrary = GenericArg <$> nonEmpty arbitrary
   shrink (GenericArg neArg) = GenericArg <$> shrinkNE neArg
 
-instance Arbitrary Rule where
+instance (Monoid (XTerm i), Arbitrary (XTerm i)) => Arbitrary (Rule i) where
   arbitrary =
     Rule
       <$> arbitrary
@@ -103,7 +113,12 @@ instance Arbitrary TyOp where
       ]
   shrink = genericShrink
 
-instance Arbitrary TypeOrGroup where
+instance
+  ( Arbitrary (XTerm i)
+  , Monoid (XTerm i)
+  ) =>
+  Arbitrary (TypeOrGroup i)
+  where
   arbitrary =
     Gen.oneof
       [ TOGGroup <$> arbitrary
@@ -111,15 +126,15 @@ instance Arbitrary TypeOrGroup where
       ]
   shrink = genericShrink
 
-instance Arbitrary Type0 where
+instance (Arbitrary (XTerm i), Monoid (XTerm i)) => Arbitrary (Type0 i) where
   arbitrary = Type0 <$> nonEmpty arbitrary
   shrink (Type0 neType1) = Type0 <$> shrinkNE neType1
 
-instance Arbitrary Type1 where
+instance (Arbitrary (XTerm i), Monoid (XTerm i)) => Arbitrary (Type1 i) where
   arbitrary = Type1 <$> arbitrary <*> arbitrary <*> arbitrary
   shrink = genericShrink
 
-instance Arbitrary Type2 where
+instance (Monoid (XTerm i), Arbitrary (XTerm i)) => Arbitrary (Type2 i) where
   arbitrary =
     recursive
       Gen.oneof
@@ -138,7 +153,6 @@ instance Arbitrary Type2 where
       [ T2Group <$> arbitrary
       , T2Tag <$> arbitrary <*> arbitrary
       ]
-  shrink = genericShrink
 
 instance Arbitrary OccurrenceIndicator where
   arbitrary =
@@ -153,15 +167,15 @@ instance Arbitrary OccurrenceIndicator where
 
   shrink = genericShrink
 
-instance Arbitrary Group where
+instance (Monoid (XTerm i), Arbitrary (XTerm i)) => Arbitrary (Group i) where
   arbitrary = Group <$> nonEmpty arbitrary
   shrink (Group gr) = Group <$> shrinkNE gr
 
-instance Arbitrary GrpChoice where
+instance (Monoid (XTerm i), Arbitrary (XTerm i)) => Arbitrary (GrpChoice i) where
   arbitrary = GrpChoice <$> listOf' arbitrary <*> pure mempty
   shrink = genericShrink
 
-instance Arbitrary GroupEntryVariant where
+instance (Monoid (XTerm i), Arbitrary (XTerm i)) => Arbitrary (GroupEntryVariant i) where
   arbitrary =
     recursive
       Gen.oneof
@@ -176,15 +190,20 @@ instance Arbitrary GroupEntryVariant where
       ]
   shrink = genericShrink
 
-instance Arbitrary GroupEntry where
+instance
+  ( Arbitrary (XTerm i)
+  , Monoid (XTerm i)
+  ) =>
+  Arbitrary (GroupEntry i)
+  where
   arbitrary =
     GroupEntry
       <$> arbitrary
-      <*> pure mempty
       <*> arbitrary
+      <*> pure mempty
   shrink = genericShrink
 
-instance Arbitrary MemberKey where
+instance (Monoid (XTerm i), Arbitrary (XTerm i)) => Arbitrary (MemberKey i) where
   arbitrary =
     recursive
       Gen.oneof
diff --git a/test/Test/Codec/CBOR/Cuddle/CDDL/Parser.hs b/test/Test/Codec/CBOR/Cuddle/CDDL/Parser.hs
index 53d777e..efedf4b 100644
--- a/test/Test/Codec/CBOR/Cuddle/CDDL/Parser.hs
+++ b/test/Test/Codec/CBOR/Cuddle/CDDL/Parser.hs
@@ -4,11 +4,10 @@ module Test.Codec.CBOR.Cuddle.CDDL.Parser where
 
 import Codec.CBOR.Cuddle.CDDL
 import Codec.CBOR.Cuddle.CDDL.CtlOp qualified as CtlOp
-import Codec.CBOR.Cuddle.Comments (Comment (..))
+import Codec.CBOR.Cuddle.IndexMappable (IndexMappable (..))
 import Codec.CBOR.Cuddle.Parser
 import Codec.CBOR.Cuddle.Parser.Lexer (Parser)
-import Codec.CBOR.Cuddle.Pretty ()
-import Data.Default.Class (Default (..))
+import Codec.CBOR.Cuddle.Pretty (PrettyStage)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Text qualified as T
 import Data.TreeDiff (ToExpr (..), ansiWlBgEditExprCompact, exprDiff)
@@ -36,11 +35,11 @@ parserSpec = do
 
 roundtripSpec :: Spec
 roundtripSpec = describe "Roundtripping should be id" $ do
-  it "Trip Name" $ trip pName
+  it "Trip Name" $ tripIndexed pName
   xit "Trip Value" $ trip pValue
-  xit "Trip Type0" $ trip pType0
-  xit "Trip GroupEntry" $ trip pGrpEntry
-  xit "Trip Rule" $ trip pRule
+  xit "Trip Type0" $ tripIndexed pType0
+  xit "Trip GroupEntry" $ tripIndexed pGrpEntry
+  xit "Trip Rule" $ tripIndexed pRule
   where
     -- We show that, for a printed CDDL document p, print (parse p) == p. Note
     -- that we do not show that parse (print p) is p for a given generated
@@ -60,6 +59,17 @@ roundtripSpec = describe "Roundtripping should be id" $ do
                 toExpr x `exprDiff` toExpr parsed
             )
             $ printed `shouldBe` printText parsed
+    tripIndexed ::
+      forall a.
+      ( IndexMappable a ParserStage PrettyStage
+      , Eq (a PrettyStage)
+      , ToExpr (a PrettyStage)
+      , Show (a PrettyStage)
+      , Pretty (a PrettyStage)
+      , Arbitrary (a PrettyStage)
+      ) =>
+      Parser (a ParserStage) -> Property
+    tripIndexed = trip . fmap (mapIndex @a @ParserStage @PrettyStage)
     printText :: Pretty a => a -> T.Text
     printText = renderStrict . layoutPretty defaultLayoutOptions . pretty
 
@@ -179,15 +189,15 @@ type2Spec = describe "type2" $ do
                     { gcGroupEntries =
                         [ GroupEntry
                             { geOccurrenceIndicator = Nothing
-                            , geComment = Comment mempty
+                            , geExt = mempty
                             , geVariant =
                                 GEType
                                   ( Just
                                       ( MKType
                                           ( Type1
-                                              { t1Main = T2Name (Name {name = "int", nameComment = Comment mempty}) Nothing
+                                              { t1Main = T2Name (Name {name = "int", nameExt = mempty}) Nothing
                                               , t1TyOp = Nothing
-                                              , t1Comment = Comment mempty
+                                              , t1Comment = mempty
                                               }
                                           )
                                       )
@@ -195,16 +205,16 @@ type2Spec = describe "type2" $ do
                                   ( Type0
                                       { t0Type1 =
                                           Type1
-                                            { t1Main = T2Name (Name {name = "string", nameComment = Comment mempty}) Nothing
+                                            { t1Main = T2Name (Name {name = "string", nameExt = mempty}) Nothing
                                             , t1TyOp = Nothing
-                                            , t1Comment = Comment mempty
+                                            , t1Comment = mempty
                                             }
                                             :| []
                                       }
                                   )
                             }
                         ]
-                    , gcComment = Comment mempty
+                    , gcComment = mempty
                     }
                     :| []
               }
@@ -218,15 +228,15 @@ type2Spec = describe "type2" $ do
                     { gcGroupEntries =
                         [ GroupEntry
                             { geOccurrenceIndicator = Just OIZeroOrMore
-                            , geComment = Comment mempty
+                            , geExt = mempty
                             , geVariant =
                                 GEType
                                   ( Just
                                       ( MKType
                                           ( Type1
-                                              { t1Main = T2Name (Name {name = "int", nameComment = Comment mempty}) Nothing
+                                              { t1Main = T2Name (Name {name = "int", nameExt = mempty}) Nothing
                                               , t1TyOp = Nothing
-                                              , t1Comment = Comment mempty
+                                              , t1Comment = mempty
                                               }
                                           )
                                       )
@@ -234,16 +244,16 @@ type2Spec = describe "type2" $ do
                                   ( Type0
                                       { t0Type1 =
                                           Type1
-                                            { t1Main = T2Name (Name {name = "string", nameComment = Comment mempty}) Nothing
+                                            { t1Main = T2Name (Name {name = "string", nameExt = mempty}) Nothing
                                             , t1TyOp = Nothing
-                                            , t1Comment = Comment mempty
+                                            , t1Comment = mempty
                                             }
                                             :| []
                                       }
                                   )
                             }
                         ]
-                    , gcComment = Comment mempty
+                    , gcComment = mempty
                     }
                     :| []
               }
@@ -257,18 +267,18 @@ type2Spec = describe "type2" $ do
                     { gcGroupEntries =
                         [ GroupEntry
                             { geOccurrenceIndicator = Nothing
-                            , geComment = Comment mempty
+                            , geExt = mempty
                             , geVariant =
                                 GEType
                                   ( Just
-                                      (MKType (Type1 {t1Main = T2Value (value $ VUInt 1), t1TyOp = Nothing, t1Comment = Comment mempty}))
+                                      (MKType (Type1 {t1Main = T2Value (value $ VUInt 1), t1TyOp = Nothing, t1Comment = mempty}))
                                   )
                                   ( Type0
                                       { t0Type1 =
                                           Type1
-                                            { t1Main = T2Name (Name {name = "string", nameComment = Comment mempty}) Nothing
+                                            { t1Main = T2Name (Name {name = "string", nameExt = mempty}) Nothing
                                             , t1TyOp = Nothing
-                                            , t1Comment = Comment mempty
+                                            , t1Comment = mempty
                                             }
                                             :| []
                                       }
@@ -276,18 +286,18 @@ type2Spec = describe "type2" $ do
                             }
                         , GroupEntry
                             { geOccurrenceIndicator = Nothing
-                            , geComment = Comment mempty
+                            , geExt = mempty
                             , geVariant =
                                 GEType
                                   ( Just
-                                      (MKType (Type1 {t1Main = T2Value (value $ VUInt 2), t1TyOp = Nothing, t1Comment = Comment mempty}))
+                                      (MKType (Type1 {t1Main = T2Value (value $ VUInt 2), t1TyOp = Nothing, t1Comment = mempty}))
                                   )
                                   ( Type0
                                       { t0Type1 =
                                           Type1
-                                            { t1Main = T2Name (Name {name = "int", nameComment = Comment mempty}) Nothing
+                                            { t1Main = T2Name (Name {name = "int", nameExt = mempty}) Nothing
                                             , t1TyOp = Nothing
-                                            , t1Comment = Comment mempty
+                                            , t1Comment = mempty
                                             }
                                             :| []
                                       }
@@ -295,25 +305,25 @@ type2Spec = describe "type2" $ do
                             }
                         , GroupEntry
                             { geOccurrenceIndicator = Nothing
-                            , geComment = Comment mempty
+                            , geExt = mempty
                             , geVariant =
                                 GEType
                                   ( Just
-                                      (MKType (Type1 {t1Main = T2Value (value $ VUInt 3), t1TyOp = Nothing, t1Comment = Comment mempty}))
+                                      (MKType (Type1 {t1Main = T2Value (value $ VUInt 3), t1TyOp = Nothing, t1Comment = mempty}))
                                   )
                                   ( Type0
                                       { t0Type1 =
                                           Type1
-                                            { t1Main = T2Name (Name {name = "bytes", nameComment = Comment mempty}) Nothing
+                                            { t1Main = T2Name (Name {name = "bytes", nameExt = mempty}) Nothing
                                             , t1TyOp = Nothing
-                                            , t1Comment = Comment mempty
+                                            , t1Comment = mempty
                                             }
                                             :| []
                                       }
                                   )
                             }
                         ]
-                    , gcComment = Comment mempty
+                    , gcComment = mempty
                     }
                     :| []
               }
@@ -328,45 +338,45 @@ type2Spec = describe "type2" $ do
                     { gcGroupEntries =
                         [ GroupEntry
                             { geOccurrenceIndicator = Nothing
-                            , geComment = Comment mempty
+                            , geExt = mempty
                             , geVariant =
                                 GEType
                                   Nothing
                                   ( Type0
                                       { t0Type1 =
                                           Type1
-                                            { t1Main = T2Name (Name {name = "int", nameComment = Comment mempty}) Nothing
+                                            { t1Main = T2Name (Name {name = "int", nameExt = mempty}) Nothing
                                             , t1TyOp = Nothing
-                                            , t1Comment = Comment mempty
+                                            , t1Comment = mempty
                                             }
                                             :| []
                                       }
                                   )
                             }
                         ]
-                    , gcComment = Comment mempty
+                    , gcComment = mempty
                     }
                     :| [ GrpChoice
                            { gcGroupEntries =
                                [ GroupEntry
                                    { geOccurrenceIndicator = Nothing
-                                   , geComment = Comment mempty
+                                   , geExt = mempty
                                    , geVariant =
                                        GEType
                                          Nothing
                                          ( Type0
                                              { t0Type1 =
                                                  Type1
-                                                   { t1Main = T2Name (Name {name = "string", nameComment = Comment mempty}) Nothing
+                                                   { t1Main = T2Name (Name {name = "string", nameExt = mempty}) Nothing
                                                    , t1TyOp = Nothing
-                                                   , t1Comment = Comment mempty
+                                                   , t1Comment = mempty
                                                    }
                                                    :| []
                                              }
                                          )
                                    }
                                ]
-                           , gcComment = Comment mempty
+                           , gcComment = mempty
                            }
                        ]
               }
@@ -381,35 +391,35 @@ type2Spec = describe "type2" $ do
                     { gcGroupEntries =
                         [ GroupEntry
                             { geOccurrenceIndicator = Nothing
-                            , geComment = Comment mempty
+                            , geExt = mempty
                             , geVariant =
                                 GEType
                                   Nothing
                                   ( Type0
                                       { t0Type1 =
-                                          Type1 {t1Main = T2Value (value $ VUInt 0), t1TyOp = Nothing, t1Comment = Comment mempty} :| []
+                                          Type1 {t1Main = T2Value (value $ VUInt 0), t1TyOp = Nothing, t1Comment = mempty} :| []
                                       }
                                   )
                             }
                         ]
-                    , gcComment = Comment mempty
+                    , gcComment = mempty
                     }
                     :| [ GrpChoice
                            { gcGroupEntries =
                                [ GroupEntry
                                    { geOccurrenceIndicator = Nothing
-                                   , geComment = Comment mempty
+                                   , geExt = mempty
                                    , geVariant =
                                        GEType
                                          Nothing
                                          ( Type0
                                              { t0Type1 =
-                                                 Type1 {t1Main = T2Value (value $ VUInt 1), t1TyOp = Nothing, t1Comment = Comment mempty} :| []
+                                                 Type1 {t1Main = T2Value (value $ VUInt 1), t1TyOp = Nothing, t1Comment = mempty} :| []
                                              }
                                          )
                                    }
                                ]
-                           , gcComment = Comment mempty
+                           , gcComment = mempty
                            }
                        ]
               }
@@ -423,18 +433,18 @@ type2Spec = describe "type2" $ do
                     { gcGroupEntries =
                         [ GroupEntry
                             { geOccurrenceIndicator = Nothing
-                            , geComment = Comment mempty
+                            , geExt = mempty
                             , geVariant =
                                 GEType
                                   Nothing
                                   ( Type0
                                       { t0Type1 =
-                                          Type1 {t1Main = T2Value (value $ VUInt 1), t1TyOp = Nothing, t1Comment = Comment mempty} :| []
+                                          Type1 {t1Main = T2Value (value $ VUInt 1), t1TyOp = Nothing, t1Comment = mempty} :| []
                                       }
                                   )
                             }
                         ]
-                    , gcComment = Comment mempty
+                    , gcComment = mempty
                     }
                     :| []
               }
@@ -448,35 +458,35 @@ type2Spec = describe "type2" $ do
                     { gcGroupEntries =
                         [ GroupEntry
                             { geOccurrenceIndicator = Nothing
-                            , geComment = Comment mempty
+                            , geExt = mempty
                             , geVariant =
                                 GEType
                                   Nothing
                                   ( Type0
                                       { t0Type1 =
-                                          Type1 {t1Main = T2Value (value $ VUInt 2), t1TyOp = Nothing, t1Comment = Comment mempty} :| []
+                                          Type1 {t1Main = T2Value (value $ VUInt 2), t1TyOp = Nothing, t1Comment = mempty} :| []
                                       }
                                   )
                             }
                         , GroupEntry
                             { geOccurrenceIndicator = Nothing
-                            , geComment = Comment mempty
+                            , geExt = mempty
                             , geVariant =
                                 GEType
                                   Nothing
                                   ( Type0
                                       { t0Type1 =
                                           Type1
-                                            { t1Main = T2Name (Name {name = "soon", nameComment = Comment mempty}) Nothing
+                                            { t1Main = T2Name (Name {name = "soon", nameExt = mempty}) Nothing
                                             , t1TyOp = Nothing
-                                            , t1Comment = Comment mempty
+                                            , t1Comment = mempty
                                             }
                                             :| []
                                       }
                                   )
                             }
                         ]
-                    , gcComment = Comment mempty
+                    , gcComment = mempty
                     }
                     :| []
               }
@@ -488,16 +498,16 @@ grpEntrySpec = describe "GroupEntry" $ do
     parse pGrpEntry "" "int"
       `shouldParse` GroupEntry
         { geOccurrenceIndicator = Nothing
-        , geComment = Comment mempty
+        , geExt = mempty
         , geVariant =
             GEType
               Nothing
               ( Type0
                   { t0Type1 =
                       Type1
-                        { t1Main = T2Name (Name {name = "int", nameComment = Comment mempty}) Nothing
+                        { t1Main = T2Name (Name {name = "int", nameExt = mempty}) Nothing
                         , t1TyOp = Nothing
-                        , t1Comment = Comment mempty
+                        , t1Comment = mempty
                         }
                         :| []
                   }
@@ -507,16 +517,16 @@ grpEntrySpec = describe "GroupEntry" $ do
     parse pGrpEntry "" "int // notConsideredHere"
       `shouldParse` GroupEntry
         { geOccurrenceIndicator = Nothing
-        , geComment = Comment mempty
+        , geExt = mempty
         , geVariant =
             GEType
               Nothing
               ( Type0
                   { t0Type1 =
                       Type1
-                        { t1Main = T2Name (Name {name = "int", nameComment = Comment mempty}) Nothing
+                        { t1Main = T2Name (Name {name = "int", nameExt = mempty}) Nothing
                         , t1TyOp = Nothing
-                        , t1Comment = Comment mempty
+                        , t1Comment = mempty
                         }
                         :| []
                   }
@@ -526,7 +536,7 @@ grpEntrySpec = describe "GroupEntry" $ do
     parse pGrpEntry "" "a<0 ... #6(0)>"
       `shouldParse` GroupEntry
         { geOccurrenceIndicator = Nothing
-        , geComment = Comment mempty
+        , geExt = mempty
         , geVariant =
             GEType
               Nothing
@@ -535,7 +545,7 @@ grpEntrySpec = describe "GroupEntry" $ do
                       Type1
                         { t1Main =
                             T2Name
-                              (Name {name = "a", nameComment = Comment mempty})
+                              (Name {name = "a", nameExt = mempty})
                               ( Just
                                   ( GenericArg
                                       ( Type1
@@ -547,18 +557,18 @@ grpEntrySpec = describe "GroupEntry" $ do
                                                     Nothing
                                                     ( Type0
                                                         { t0Type1 =
-                                                            Type1 {t1Main = T2Value (value $ VUInt 0), t1TyOp = Nothing, t1Comment = Comment mempty} :| []
+                                                            Type1 {t1Main = T2Value (value $ VUInt 0), t1TyOp = Nothing, t1Comment = mempty} :| []
                                                         }
                                                     )
                                                 )
-                                          , t1Comment = Comment mempty
+                                          , t1Comment = mempty
                                           }
                                           :| []
                                       )
                                   )
                               )
                         , t1TyOp = Nothing
-                        , t1Comment = Comment mempty
+                        , t1Comment = mempty
                         }
                         :| []
                   }
@@ -568,28 +578,31 @@ grpEntrySpec = describe "GroupEntry" $ do
     parse pGrpEntry "" "0* a"
       `shouldParse` GroupEntry
         (Just (OIBounded (Just 0) Nothing))
-        def
         ( GEType
             Nothing
             (Type0 (Type1 (T2Name (Name "a" mempty) Nothing) Nothing mempty :| []))
         )
+        mempty
 
 grpChoiceSpec :: SpecWith ()
 grpChoiceSpec = describe "GroupChoice" $ do
   it "Should parse part of a group alternative" $
     parse pGrpChoice "" "int // string"
       `shouldParse` GrpChoice
-        [ GroupEntry Nothing mempty $
-            GEType
-              Nothing
-              ( Type0
-                  ( Type1
-                      (T2Name (Name "int" mempty) Nothing)
-                      Nothing
-                      mempty
-                      :| []
-                  )
-              )
+        [ GroupEntry
+            Nothing
+            ( GEType
+                Nothing
+                ( Type0
+                    ( Type1
+                        (T2Name (Name "int" mempty) Nothing)
+                        Nothing
+                        mempty
+                        :| []
+                    )
+                )
+            )
+            mempty
         ]
         mempty
 
@@ -629,27 +642,27 @@ qcFoundSpec =
       Type1
         { t1Main =
             T2Map
-              (Group {unGroup = GrpChoice {gcGroupEntries = [], gcComment = Comment mempty} :| []})
+              (Group {unGroup = GrpChoice {gcGroupEntries = [], gcComment = mempty} :| []})
         , t1TyOp =
             Just
               ( CtrlOp CtlOp.Ge
               , T2EnumRef
-                  (Name {name = "i", nameComment = Comment mempty})
+                  (Name {name = "i", nameExt = mempty})
                   ( Just
                       ( GenericArg
                           ( Type1
                               { t1Main =
                                   T2Map
-                                    (Group {unGroup = GrpChoice {gcGroupEntries = [], gcComment = Comment mempty} :| []})
+                                    (Group {unGroup = GrpChoice {gcGroupEntries = [], gcComment = mempty} :| []})
                               , t1TyOp = Nothing
-                              , t1Comment = Comment mempty
+                              , t1Comment = mempty
                               }
-                              :| [Type1 {t1Main = T2Value (value $ VUInt 3), t1TyOp = Nothing, t1Comment = Comment mempty}]
+                              :| [Type1 {t1Main = T2Value (value $ VUInt 3), t1TyOp = Nothing, t1Comment = mempty}]
                           )
                       )
                   )
               )
-        , t1Comment = Comment mempty
+        , t1Comment = mempty
         }
     parseExample "S = 0* ()" pRule $
       Rule
@@ -657,8 +670,10 @@ qcFoundSpec =
         Nothing
         AssignEq
         ( TOGGroup
-            ( GroupEntry (Just (OIBounded (Just 0) Nothing)) mempty $
-                GEGroup (Group (GrpChoice mempty mempty :| []))
+            ( GroupEntry
+                (Just (OIBounded (Just 0) Nothing))
+                (GEGroup (Group (GrpChoice mempty mempty :| [])))
+                mempty
             )
         )
         mempty
@@ -672,10 +687,11 @@ qcFoundSpec =
           ( TOGGroup
               ( GroupEntry
                   Nothing
+                  ( GEType
+                      (Just (MKValue (value $ VText "6 ybe2ddl8frq0vqa8zgrk07khrljq7p plrufpd1sff3p95")))
+                      (Type0 (Type1 (T2Value (value $ VText "u")) Nothing mempty :| []))
+                  )
                   mempty
-                  $ GEType
-                    (Just (MKValue (value $ VText "6 ybe2ddl8frq0vqa8zgrk07khrljq7p plrufpd1sff3p95")))
-                    (Type0 (Type1 (T2Value (value $ VText "u")) Nothing mempty :| []))
               )
           )
           mempty
diff --git a/test/Test/Codec/CBOR/Cuddle/CDDL/Pretty.hs b/test/Test/Codec/CBOR/Cuddle/CDDL/Pretty.hs
index 3a5a354..3666418 100644
--- a/test/Test/Codec/CBOR/Cuddle/CDDL/Pretty.hs
+++ b/test/Test/Codec/CBOR/Cuddle/CDDL/Pretty.hs
@@ -22,7 +22,7 @@ import Codec.CBOR.Cuddle.CDDL (
   ValueVariant (..),
   value,
  )
-import Codec.CBOR.Cuddle.Pretty ()
+import Codec.CBOR.Cuddle.Pretty (PrettyStage)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Text qualified as T
 import Data.TreeDiff (ToExpr (..), prettyExpr)
@@ -40,13 +40,13 @@ prettyPrintsTo x s = assertEqual (show . prettyExpr $ toExpr x) s rendered
   where
     rendered = renderString (layoutPretty defaultLayoutOptions (pretty x))
 
-t2Name :: Type2
+t2Name :: Type2 PrettyStage
 t2Name = T2Name (Name "a" mempty) mempty
 
-t1Name :: Type1
+t1Name :: Type1 PrettyStage
 t1Name = Type1 t2Name Nothing mempty
 
-mkType0 :: Type2 -> Type0
+mkType0 :: Type2 PrettyStage -> Type0 PrettyStage
 mkType0 t2 = Type0 $ Type1 t2 Nothing mempty :| []
 
 spec :: Spec
@@ -56,14 +56,14 @@ spec = describe "Pretty printer" $ do
 
 qcSpec :: Spec
 qcSpec = describe "QuickCheck" $ do
-  xprop "CDDL prettyprinter leaves no trailing spaces" $ \(cddl :: CDDL) -> do
+  xprop "CDDL prettyprinter leaves no trailing spaces" $ \(cddl :: CDDL PrettyStage) -> do
     let
       prettyStr = T.pack . renderString . layoutPretty defaultLayoutOptions $ pretty cddl
       stripLines = T.unlines . fmap T.stripEnd . T.lines
     counterexample (show . prettyExpr $ toExpr cddl) $
       prettyStr `shouldBe` stripLines prettyStr
 
-drep :: Rule
+drep :: Rule PrettyStage
 drep =
   Rule
     "drep"
@@ -77,37 +77,37 @@ drep =
                         ( GrpChoice
                             [ GroupEntry
                                 Nothing
-                                mempty
                                 (GEType Nothing (Type0 $ Type1 (T2Value . value $ VUInt 0) Nothing mempty :| []))
+                                mempty
                             , GroupEntry
                                 Nothing
-                                mempty
                                 (GEType Nothing (Type0 $ Type1 (T2Name "addr_keyhash" Nothing) Nothing mempty :| []))
+                                mempty
                             ]
                             mempty
                             :| [ GrpChoice
                                    [ GroupEntry
                                        Nothing
-                                       mempty
                                        (GEType Nothing (Type0 $ Type1 (T2Value . value $ VUInt 1) Nothing mempty :| []))
+                                       mempty
                                    , GroupEntry
                                        Nothing
-                                       mempty
                                        (GEType Nothing (Type0 $ Type1 (T2Name "script_hash" Nothing) Nothing mempty :| []))
+                                       mempty
                                    ]
                                    mempty
                                , GrpChoice
                                    [ GroupEntry
                                        Nothing
-                                       mempty
                                        (GEType Nothing (Type0 $ Type1 (T2Value . value $ VUInt 2) Nothing mempty :| []))
+                                       mempty
                                    ]
                                    mempty
                                , GrpChoice
                                    [ GroupEntry
                                        Nothing
-                                       mempty
                                        (GEType Nothing (Type0 $ Type1 (T2Value . value $ VUInt 3) Nothing mempty :| []))
+                                       mempty
                                    ]
                                    mempty
                                ]
@@ -125,22 +125,22 @@ drep =
 unitSpec :: Spec
 unitSpec = describe "HUnit" $ do
   describe "Name" $ do
-    it "names" $ Name "a" mempty `prettyPrintsTo` "a"
+    it "names" $ Name @PrettyStage "a" "" `prettyPrintsTo` "a"
   describe "Type0" $ do
-    it "name" $ Type0 (t1Name :| []) `prettyPrintsTo` "a"
+    it "name" $ Type0 @PrettyStage (t1Name :| []) `prettyPrintsTo` "a"
   describe "Type1" $ do
     it "name" $ t1Name `prettyPrintsTo` "a"
   describe "Type2" $ do
     it "T2Name" $ t2Name `prettyPrintsTo` "a"
     describe "T2Array" $ do
-      let groupEntryName = GroupEntry Nothing mempty $ GERef (Name "a" mempty) Nothing
+      let groupEntryName = GroupEntry Nothing (GERef (Name "a" mempty) Nothing) ""
       it "one element" $
         T2Array (Group (GrpChoice [groupEntryName] mempty :| [])) `prettyPrintsTo` "[a]"
       it "two elements" $
         T2Array
           ( Group
               ( GrpChoice
-                  [ GroupEntry Nothing mempty $ GEType Nothing (mkType0 . T2Value . value $ VUInt 1)
+                  [ GroupEntry Nothing (GEType Nothing (mkType0 . T2Value . value $ VUInt 1)) ""
                   , groupEntryName
                   ]
                   mempty
@@ -152,8 +152,8 @@ unitSpec = describe "HUnit" $ do
         T2Array
           ( Group
               ( GrpChoice
-                  [ GroupEntry Nothing "one" $ GEType Nothing (mkType0 . T2Value . value $ VUInt 1)
-                  , GroupEntry Nothing "two" $ GEType Nothing (mkType0 . T2Value . value $ VUInt 2)
+                  [ GroupEntry Nothing (GEType Nothing (mkType0 . T2Value . value $ VUInt 1)) "one"
+                  , GroupEntry Nothing (GEType Nothing (mkType0 . T2Value . value $ VUInt 2)) "two"
                   ]
                   mempty
                   :| []
@@ -164,9 +164,14 @@ unitSpec = describe "HUnit" $ do
         T2Array
           ( Group
               ( GrpChoice
-                  [ GroupEntry Nothing "first\nmultiline comment" $ GEType Nothing (mkType0 . T2Value . value $ VUInt 1)
-                  , GroupEntry Nothing "second\nmultiline comment" $
-                      GEType Nothing (mkType0 . T2Value . value $ VUInt 2)
+                  [ GroupEntry
+                      Nothing
+                      (GEType Nothing (mkType0 . T2Value . value $ VUInt 1))
+                      "first\nmultiline comment"
+                  , GroupEntry
+                      Nothing
+                      (GEType Nothing (mkType0 . T2Value . value $ VUInt 2))
+                      "second\nmultiline comment"
                   ]
                   mempty
                   :| []
@@ -175,7 +180,7 @@ unitSpec = describe "HUnit" $ do
           `prettyPrintsTo` "[ 1 ; first\n    ; multiline comment\n, 2 ; second\n    ; multiline comment\n]"
   describe "Rule" $ do
     it "simple assignment" $
-      Rule
+      Rule @PrettyStage
         (Name "a" mempty)
         Nothing
         AssignEq
diff --git a/test/Test/Codec/CBOR/Cuddle/Huddle.hs b/test/Test/Codec/CBOR/Cuddle/Huddle.hs
index 06a0dbf..f0d42b3 100644
--- a/test/Test/Codec/CBOR/Cuddle/Huddle.hs
+++ b/test/Test/Codec/CBOR/Cuddle/Huddle.hs
@@ -5,8 +5,9 @@
 
 module Test.Codec.CBOR.Cuddle.Huddle where
 
-import Codec.CBOR.Cuddle.CDDL (CDDL, sortCDDL)
+import Codec.CBOR.Cuddle.CDDL (CDDL, fromRules, sortCDDL)
 import Codec.CBOR.Cuddle.Huddle
+import Codec.CBOR.Cuddle.IndexMappable (IndexMappable (..))
 import Codec.CBOR.Cuddle.Parser
 import Data.Text qualified as T
 import Test.Codec.CBOR.Cuddle.CDDL.Pretty qualified as Pretty
@@ -155,10 +156,10 @@ shouldMatchParse ::
 shouldMatchParse x parseFun input = parse parseFun "" (T.pack input) `shouldParse` x
 
 shouldMatchParseCDDL ::
-  CDDL ->
+  CDDL HuddleStage ->
   String ->
   Expectation
-shouldMatchParseCDDL x = shouldMatchParse x pCDDL
+shouldMatchParseCDDL x = shouldMatchParse x . fmap mapIndex $ pCDDL
 
-toSortedCDDL :: Huddle -> CDDL
-toSortedCDDL = sortCDDL . toCDDLNoRoot
+toSortedCDDL :: Huddle -> CDDL HuddleStage
+toSortedCDDL = fromRules . sortCDDL . toCDDLNoRoot

From e44b6b4e7e371d15425b3ceb75bcccc825fb27ba Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Wed, 8 Oct 2025 16:33:23 +0300
Subject: [PATCH 11/15] Implement undefined

---
 src/Codec/CBOR/Cuddle/IndexMappable.hs | 45 ++++++++++++++++++++++----
 1 file changed, 39 insertions(+), 6 deletions(-)

diff --git a/src/Codec/CBOR/Cuddle/IndexMappable.hs b/src/Codec/CBOR/Cuddle/IndexMappable.hs
index 6f2cdeb..d3e83b3 100644
--- a/src/Codec/CBOR/Cuddle/IndexMappable.hs
+++ b/src/Codec/CBOR/Cuddle/IndexMappable.hs
@@ -8,8 +8,9 @@ import Codec.CBOR.Cuddle.CDDL (
   GenericParam (..),
   Group (..),
   GroupEntry (..),
-  GroupEntryVariant,
+  GroupEntryVariant (..),
   GrpChoice (..),
+  MemberKey (..),
   Name (..),
   Rule (..),
   TopLevel (..),
@@ -84,11 +85,33 @@ instance
   mapIndex (TOGType t) = TOGType $ mapIndex t
   mapIndex (TOGGroup g) = TOGGroup $ mapIndex g
 
-instance IndexMappable XTerm i j => IndexMappable GroupEntry i j where
+instance
+  ( IndexMappable XTerm i j
+  , IndexMappable XXType2 i j
+  ) =>
+  IndexMappable GroupEntry i j
+  where
   mapIndex (GroupEntry mo gev e) = GroupEntry mo (mapIndex gev) (mapIndex e)
 
-instance IndexMappable GroupEntryVariant i j where
-  mapIndex = undefined
+instance
+  ( IndexMappable XXType2 i j
+  , IndexMappable XTerm i j
+  ) =>
+  IndexMappable GroupEntryVariant i j
+  where
+  mapIndex (GEType mk t) = GEType (mapIndex <$> mk) $ mapIndex t
+  mapIndex (GERef n ma) = GERef (mapIndex n) (mapIndex <$> ma)
+  mapIndex (GEGroup g) = GEGroup (mapIndex g)
+
+instance
+  ( IndexMappable XXType2 i j
+  , IndexMappable XTerm i j
+  ) =>
+  IndexMappable MemberKey i j
+  where
+  mapIndex (MKType t) = MKType $ mapIndex t
+  mapIndex (MKBareword n) = MKBareword $ mapIndex n
+  mapIndex (MKValue x) = MKValue x
 
 instance
   ( IndexMappable XXType2 i j
@@ -133,10 +156,20 @@ instance
   where
   mapIndex (GenericArg g) = GenericArg $ mapIndex <$> g
 
-instance IndexMappable XTerm i j => IndexMappable Group i j where
+instance
+  ( IndexMappable XTerm i j
+  , IndexMappable XXType2 i j
+  ) =>
+  IndexMappable Group i j
+  where
   mapIndex (Group g) = Group $ mapIndex <$> g
 
-instance IndexMappable XTerm i j => IndexMappable GrpChoice i j where
+instance
+  ( IndexMappable XTerm i j
+  , IndexMappable XXType2 i j
+  ) =>
+  IndexMappable GrpChoice i j
+  where
   mapIndex (GrpChoice gs e) = GrpChoice (mapIndex <$> gs) $ mapIndex e
 
 -- ParserStage -> PrettyStage

From 144854000c1a94911b932c3dca9a44d636ef4b83 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Mon, 13 Oct 2025 14:27:05 +0300
Subject: [PATCH 12/15] Restored the no-prelude option in validation

---
 bin/Main.hs                                  | 27 +++++++--
 src/Codec/CBOR/Cuddle/CBOR/Gen.hs            |  3 +-
 src/Codec/CBOR/Cuddle/CBOR/Validator.hs      |  1 -
 src/Codec/CBOR/Cuddle/CDDL/CTree.hs          | 52 +++++++++++++++-
 src/Codec/CBOR/Cuddle/CDDL/Postlude.hs       | 64 +++-----------------
 src/Codec/CBOR/Cuddle/CDDL/Resolve.hs        |  2 +-
 src/Codec/CBOR/Cuddle/IndexMappable.hs       | 10 +++
 test/Test/Codec/CBOR/Cuddle/CDDL/Examples.hs |  4 +-
 8 files changed, 94 insertions(+), 69 deletions(-)

diff --git a/bin/Main.hs b/bin/Main.hs
index f2ee5b7..03d1e2b 100644
--- a/bin/Main.hs
+++ b/bin/Main.hs
@@ -32,10 +32,20 @@ data Opts = Opts Command String
 
 data Command
   = Format FormatOpts
-  | Validate
+  | Validate ValidateOpts
   | GenerateCBOR GenOpts
   | ValidateCBOR ValidateCBOROpts
 
+newtype ValidateOpts = ValidateOpts {vNoPrelude :: Bool}
+
+pValidateOpts :: Parser ValidateOpts
+pValidateOpts =
+  ValidateOpts
+    <$> switch
+      ( long "no-prelude"
+          <> help "Do not include the CDDL prelude."
+      )
+
 -- | Various formats for outputtting CBOR
 data CBOROutputFormat
   = AsCBOR
@@ -135,7 +145,7 @@ opts =
           <> command
             "validate"
             ( info
-                (pure Validate <**> helper)
+                (Validate <$> pValidateOpts <**> helper)
                 (progDesc "Validate the provided CDDL file")
             )
           <> command
@@ -180,10 +190,15 @@ run (Opts cmd cddlFile) = do
               | otherwise = res
            in
             putDocW 80 . pretty $ mapIndex @_ @_ @PrettyStage defs
-        Validate ->
-          case fullResolveCDDL $ mapIndex res of
-            Left err -> putStrLnErr (show err) >> exitFailure
-            Right _ -> exitSuccess
+        Validate vOpts ->
+          let
+            res'
+              | vNoPrelude vOpts = res
+              | otherwise = appendPostlude res
+           in
+            case fullResolveCDDL $ mapIndex res' of
+              Left err -> putStrLnErr (show err) >> exitFailure
+              Right _ -> exitSuccess
         (GenerateCBOR gOpts) ->
           let
             res'
diff --git a/src/Codec/CBOR/Cuddle/CBOR/Gen.hs b/src/Codec/CBOR/Cuddle/CBOR/Gen.hs
index ad3d474..20ae3fc 100644
--- a/src/Codec/CBOR/Cuddle/CBOR/Gen.hs
+++ b/src/Codec/CBOR/Cuddle/CBOR/Gen.hs
@@ -25,10 +25,9 @@ import Codec.CBOR.Cuddle.CDDL (
   Value (..),
   ValueVariant (..),
  )
-import Codec.CBOR.Cuddle.CDDL.CTree (CTree, CTreePhase, CTreeRoot (..))
+import Codec.CBOR.Cuddle.CDDL.CTree (CTree, CTreePhase, CTreeRoot (..), PTerm (..))
 import Codec.CBOR.Cuddle.CDDL.CTree qualified as CTree
 import Codec.CBOR.Cuddle.CDDL.CtlOp qualified as CtlOp
-import Codec.CBOR.Cuddle.CDDL.Postlude (PTerm (..))
 import Codec.CBOR.Cuddle.CDDL.Resolve (MonoRef (..), MonoReferenced)
 import Codec.CBOR.Term (Term (..))
 import Codec.CBOR.Term qualified as CBOR
diff --git a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
index 15029e5..e763078 100644
--- a/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
+++ b/src/Codec/CBOR/Cuddle/CBOR/Validator.hs
@@ -10,7 +10,6 @@ module Codec.CBOR.Cuddle.CBOR.Validator (
 import Codec.CBOR.Cuddle.CDDL hiding (CDDL, Group, Rule)
 import Codec.CBOR.Cuddle.CDDL.CTree
 import Codec.CBOR.Cuddle.CDDL.CtlOp
-import Codec.CBOR.Cuddle.CDDL.Postlude
 import Codec.CBOR.Cuddle.CDDL.Resolve
 import Codec.CBOR.Read
 import Codec.CBOR.Term
diff --git a/src/Codec/CBOR/Cuddle/CDDL/CTree.hs b/src/Codec/CBOR/Cuddle/CDDL/CTree.hs
index d4882b7..4fda00d 100644
--- a/src/Codec/CBOR/Cuddle/CDDL/CTree.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL/CTree.hs
@@ -15,7 +15,6 @@ import Codec.CBOR.Cuddle.CDDL (
   XXType2,
  )
 import Codec.CBOR.Cuddle.CDDL.CtlOp
-import Codec.CBOR.Cuddle.CDDL.Postlude (PTerm)
 import Codec.CBOR.Cuddle.Comments (Comment)
 import Data.Hashable (Hashable)
 import Data.List.NonEmpty qualified as NE
@@ -102,3 +101,54 @@ newtype CTreeRoot i = CTreeRoot (Map.Map (Name CTreePhase) (CTree i))
   deriving (Generic)
 
 deriving instance Show (CTree i) => Show (CTreeRoot i)
+
+-- |
+--
+--  CDDL predefines a number of names.  This subsection summarizes these
+--  names, but please see Appendix D for the exact definitions.
+--
+--  The following keywords for primitive datatypes are defined:
+--
+--  "bool"  Boolean value (major type 7, additional information 20
+--    or 21).
+--
+--  "uint"  An unsigned integer (major type 0).
+--
+--  "nint"  A negative integer (major type 1).
+--
+--  "int"  An unsigned integer or a negative integer.
+--
+--  "float16"  A number representable as a half-precision float [IEEE754]
+--    (major type 7, additional information 25).
+--
+--  "float32"  A number representable as a single-precision float
+--    [IEEE754] (major type 7, additional information 26).
+--
+--
+--  "float64"  A number representable as a double-precision float
+--    [IEEE754] (major type 7, additional information 27).
+--
+--  "float"  One of float16, float32, or float64.
+--
+--  "bstr" or "bytes"  A byte string (major type 2).
+--
+--  "tstr" or "text"  Text string (major type 3).
+--
+--  (Note that there are no predefined names for arrays or maps; these
+--  are defined with the syntax given below.)
+data PTerm
+  = PTBool
+  | PTUInt
+  | PTNInt
+  | PTInt
+  | PTHalf
+  | PTFloat
+  | PTDouble
+  | PTBytes
+  | PTText
+  | PTAny
+  | PTNil
+  | PTUndefined
+  deriving (Eq, Generic, Ord, Show)
+
+instance Hashable PTerm
diff --git a/src/Codec/CBOR/Cuddle/CDDL/Postlude.hs b/src/Codec/CBOR/Cuddle/CDDL/Postlude.hs
index 6ce4e3e..b242283 100644
--- a/src/Codec/CBOR/Cuddle/CDDL/Postlude.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL/Postlude.hs
@@ -2,64 +2,12 @@
 
 module Codec.CBOR.Cuddle.CDDL.Postlude where
 
-import Codec.CBOR.Cuddle.CDDL (CDDL (..), TopLevel (..), appendRules)
+import Codec.CBOR.Cuddle.CDDL (CDDL (..), TopLevel (..), XTerm, XXType2, appendRules)
+import Codec.CBOR.Cuddle.IndexMappable (IndexMappable (..))
 import Codec.CBOR.Cuddle.Parser (ParserStage, pCDDL)
-import Data.Hashable (Hashable)
 import Data.Maybe (mapMaybe)
-import GHC.Generics (Generic)
 import Text.Megaparsec (errorBundlePretty, parse)
 
--- |
---
---  CDDL predefines a number of names.  This subsection summarizes these
---  names, but please see Appendix D for the exact definitions.
---
---  The following keywords for primitive datatypes are defined:
---
---  "bool"  Boolean value (major type 7, additional information 20
---    or 21).
---
---  "uint"  An unsigned integer (major type 0).
---
---  "nint"  A negative integer (major type 1).
---
---  "int"  An unsigned integer or a negative integer.
---
---  "float16"  A number representable as a half-precision float [IEEE754]
---    (major type 7, additional information 25).
---
---  "float32"  A number representable as a single-precision float
---    [IEEE754] (major type 7, additional information 26).
---
---
---  "float64"  A number representable as a double-precision float
---    [IEEE754] (major type 7, additional information 27).
---
---  "float"  One of float16, float32, or float64.
---
---  "bstr" or "bytes"  A byte string (major type 2).
---
---  "tstr" or "text"  Text string (major type 3).
---
---  (Note that there are no predefined names for arrays or maps; these
---  are defined with the syntax given below.)
-data PTerm
-  = PTBool
-  | PTUInt
-  | PTNInt
-  | PTInt
-  | PTHalf
-  | PTFloat
-  | PTDouble
-  | PTBytes
-  | PTText
-  | PTAny
-  | PTNil
-  | PTUndefined
-  deriving (Eq, Generic, Ord, Show)
-
-instance Hashable PTerm
-
 -- TODO switch to quasiquotes
 cddlPostlude :: CDDL ParserStage
 cddlPostlude =
@@ -111,8 +59,12 @@ cddlPostlude =
       \ null = nil \
       \ undefined = #7.23"
 
-appendPostlude :: CDDL ParserStage -> CDDL ParserStage
-appendPostlude cddl = appendRules cddl (r : rs)
+appendPostlude ::
+  ( IndexMappable XXType2 ParserStage i
+  , IndexMappable XTerm ParserStage i
+  ) =>
+  CDDL i -> CDDL i
+appendPostlude cddl = appendRules cddl $ mapIndex <$> (r : rs)
   where
     CDDL r tls _ = cddlPostlude
     f (TopLevelRule x) = Just x
diff --git a/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs b/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
index ab777aa..cfbec24 100644
--- a/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
@@ -50,10 +50,10 @@ import Codec.CBOR.Cuddle.CDDL.CTree (
   CTreeExt,
   CTreePhase,
   CTreeRoot (..),
+  PTerm (..),
   XXType2 (..),
  )
 import Codec.CBOR.Cuddle.CDDL.CTree qualified as CTree
-import Codec.CBOR.Cuddle.CDDL.Postlude (PTerm (..))
 import Control.Monad.Except (ExceptT (..), runExceptT)
 import Control.Monad.Reader (Reader, ReaderT (..), runReader)
 import Control.Monad.State.Strict (StateT (..))
diff --git a/src/Codec/CBOR/Cuddle/IndexMappable.hs b/src/Codec/CBOR/Cuddle/IndexMappable.hs
index d3e83b3..eba4d78 100644
--- a/src/Codec/CBOR/Cuddle/IndexMappable.hs
+++ b/src/Codec/CBOR/Cuddle/IndexMappable.hs
@@ -213,3 +213,13 @@ instance IndexMappable XXType2 ParserStage HuddleStage where
 
 instance IndexMappable XTerm ParserStage HuddleStage where
   mapIndex (ParserXTerm c) = HuddleXTerm c
+
+-- ParserStage -> ParserStage
+
+instance IndexMappable XCddl ParserStage ParserStage
+
+instance IndexMappable XXTopLevel ParserStage ParserStage
+
+instance IndexMappable XXType2 ParserStage ParserStage
+
+instance IndexMappable XTerm ParserStage ParserStage
diff --git a/test/Test/Codec/CBOR/Cuddle/CDDL/Examples.hs b/test/Test/Codec/CBOR/Cuddle/CDDL/Examples.hs
index b0f10c5..0c1fd9a 100644
--- a/test/Test/Codec/CBOR/Cuddle/CDDL/Examples.hs
+++ b/test/Test/Codec/CBOR/Cuddle/CDDL/Examples.hs
@@ -3,8 +3,8 @@
 module Test.Codec.CBOR.Cuddle.CDDL.Examples (spec) where
 
 import Codec.CBOR.Cuddle.CDDL (Value (..), ValueVariant (..))
-import Codec.CBOR.Cuddle.CDDL.CTree (CTree (..), CTreeRoot)
-import Codec.CBOR.Cuddle.CDDL.Postlude (PTerm (..), appendPostlude)
+import Codec.CBOR.Cuddle.CDDL.CTree (CTree (..), CTreeRoot, PTerm (..))
+import Codec.CBOR.Cuddle.CDDL.Postlude (appendPostlude)
 import Codec.CBOR.Cuddle.CDDL.Resolve (
   MonoReferenced,
   NameResolutionFailure (..),

From ffb119f7f2aa086bf4c47951d6061a4dc9e6fabf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Mon, 13 Oct 2025 14:51:27 +0300
Subject: [PATCH 13/15] Added comment

---
 src/Codec/CBOR/Cuddle/CDDL.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/Codec/CBOR/Cuddle/CDDL.hs b/src/Codec/CBOR/Cuddle/CDDL.hs
index d34dc98..0592164 100644
--- a/src/Codec/CBOR/Cuddle/CDDL.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL.hs
@@ -86,6 +86,7 @@ data CDDL i = CDDL
   { rootDefinition :: Rule i
   , topLevelDefinitions :: [TopLevel i]
   , cddlExt :: [XXTopLevel i]
+  -- ^ This extension is used for comments that appear before the root definition
   }
   deriving (Generic)
 

From ac548d601f548f4e82b205eecafe8ed301782991 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Mon, 13 Oct 2025 15:23:41 +0300
Subject: [PATCH 14/15] rename ruleComment

---
 CHANGELOG.md                  | 3 +++
 src/Codec/CBOR/Cuddle/CDDL.hs | 4 ++--
 2 files changed, 5 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index fd8a424..2dbba6b 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,9 @@
 
 ## 1.1.0.0
 
+* Remove `Codec.CBOR.Cuddle.CDDL.Prelude`
+* Replace `cddlPrelude` with `cddlPostlude`, `prependPrelude` with `appendPostlude`
+* Move `PTerm` to `Codec.CBOR.Cuddle.CDDL.CTree`
 * Remove `CTreeRoot'`
 * Changed the type in `CTreeRoot` to a map of resolved `CTree`s
 * Changed the type of the first argument for `generateCBORTerm` and 
diff --git a/src/Codec/CBOR/Cuddle/CDDL.hs b/src/Codec/CBOR/Cuddle/CDDL.hs
index 0592164..a06ab8a 100644
--- a/src/Codec/CBOR/Cuddle/CDDL.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL.hs
@@ -258,7 +258,7 @@ data Rule i = Rule
   , ruleGenParam :: Maybe (GenericParam i)
   , ruleAssign :: Assign
   , ruleTerm :: TypeOrGroup i
-  , ruleComment :: XTerm i
+  , ruleExt :: XTerm i
   }
   deriving (Generic)
 
@@ -269,7 +269,7 @@ deriving instance ForAllExtensions i Show => Show (Rule i)
 deriving instance ForAllExtensions i ToExpr => ToExpr (Rule i)
 
 instance HasComment (XTerm i) => HasComment (Rule i) where
-  commentL = #ruleComment % commentL
+  commentL = #ruleExt % commentL
 
 compareRuleName :: Ord (XTerm i) => Rule i -> Rule i -> Ordering
 compareRuleName = compare `on` ruleName

From f596b0001b5d145af796fe60e780b4a7b6b8f417 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Mon, 13 Oct 2025 15:29:15 +0300
Subject: [PATCH 15/15] Remove type argument from OrRef

---
 CHANGELOG.md                          | 3 +++
 src/Codec/CBOR/Cuddle/CDDL/Resolve.hs | 6 +++---
 2 files changed, 6 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 2dbba6b..320f5bf 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,9 @@
 
 ## 1.1.0.0
 
+* Change the order of fields in `GroupEntry`; the extension field is now the last field
+* Add `IndexMappable` to help with traversing `CDDL` trees
+* Add an index type parameter to all `CDDL` terms
 * Remove `Codec.CBOR.Cuddle.CDDL.Prelude`
 * Replace `cddlPrelude` with `cddlPostlude`, `prependPrelude` with `appendPostlude`
 * Move `PTerm` to `Codec.CBOR.Cuddle.CDDL.CTree`
diff --git a/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs b/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
index cfbec24..6ca2392 100644
--- a/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
+++ b/src/Codec/CBOR/Cuddle/CDDL/Resolve.hs
@@ -137,13 +137,13 @@ asMap cddl = foldl' go Map.empty rules
 
 data OrReferenced
 
-type instance CTreeExt OrReferenced = OrRef (CTree OrReferenced)
+type instance CTreeExt OrReferenced = OrRef
 
 -- | Indicates that an item may be referenced rather than defined.
-data OrRef a
+data OrRef
   = -- | Reference to another node with possible generic arguments supplied
     Ref (Name CTreePhase) [CTree OrReferenced]
-  deriving (Eq, Show, Functor)
+  deriving (Eq, Show)
 
 type RefCTree = PartialCTreeRoot OrReferenced