From e7f5327009a95284091869d3945964c9f535bd0d Mon Sep 17 00:00:00 2001
From: Nicholas Clarke <nick@topos.org.uk>
Date: Mon, 20 Jan 2025 17:49:41 +0100
Subject: [PATCH 1/4] Generics, take 2
This commit adds an alternative attempt at generics. It has both
advantages and disadvantages.
The principal advantage is that it really allows generics to work with
HuddleM - see the example in example/Monad.hs for a demonstration. The
previous way of writing this was quite horrible.
There are two main disadvantages:
- Now, rather than treating a generic function as a regular Haskell
function, we have to treat it specially and call it with the special
syntax (<--).
- Only one generic parameter is supported. We can potentially fix this,
but it's always going to play unkindly with the (<--) syntax. That
having been said, we had only implemented up to two parameters before.
For these reasons, these new-style generics are currently implemented
alongside the existing ones for consideration.
---
cuddle.cabal | 1 +
example/Monad.hs | 13 ++--
src/Codec/CBOR/Cuddle/Huddle.hs | 93 +++++++++++++++++++++++--
src/Codec/CBOR/Cuddle/Huddle/Generic.hs | 12 ++++
src/Codec/CBOR/Cuddle/Huddle/HuddleM.hs | 38 ++++++----
5 files changed, 134 insertions(+), 23 deletions(-)
create mode 100644 src/Codec/CBOR/Cuddle/Huddle/Generic.hs
diff --git a/cuddle.cabal b/cuddle.cabal
index abd23f6..bd73f51 100644
--- a/cuddle.cabal
+++ b/cuddle.cabal
@@ -51,6 +51,7 @@ library
Codec.CBOR.Cuddle.CDDL.Prelude
Codec.CBOR.Cuddle.CDDL.Resolve
Codec.CBOR.Cuddle.Huddle
+ Codec.CBOR.Cuddle.Huddle.Generic
Codec.CBOR.Cuddle.Huddle.HuddleM
Codec.CBOR.Cuddle.Huddle.Optics
Codec.CBOR.Cuddle.Parser
diff --git a/example/Monad.hs b/example/Monad.hs
index c009431..99ceaa1 100644
--- a/example/Monad.hs
+++ b/example/Monad.hs
@@ -19,8 +19,8 @@ spec = huddleDef $ mdo
transaction <-
"transaction"
=:= mp
- [ idx 0 ==> set txIn
- , idx 1 ==> set txOut
+ [ idx 0 ==> set txIn,
+ idx 1 ==> set' <-- txOut
]
txIn <- "txIn" =:= arr ["transaction_id" ==> hash32, "index" ==> txId]
txOut <- "txOut" =:= arr [idx 0 ==> address, idx 1 ==> value]
@@ -29,6 +29,7 @@ spec = huddleDef $ mdo
hash32 <- "hash32" =:= VBytes `sized` (32 :: Word64)
value <- "value" =:= VUInt
set <- include hdl_set
+ set' <- binding' $ \x -> "set'" Huddle.=:= arr [0 <+ a x]
setRootRules [transaction]
@@ -37,15 +38,15 @@ spec2 =
spec
<> huddleDef
( mdo
- set <- include hdl_set
+ set <- unsafeIncludeFromHuddle spec "set'"
txIn <- unsafeIncludeFromHuddle spec "txIn"
txOut <- unsafeIncludeFromHuddle spec "txOut"
_transaction <-
"transaction"
=:= mp
- [ comment "Transaction inputs" $ idx 0 ==> set txIn
- , comment "Transaction outputs" $ idx 1 ==> set txOut
- , comment "Metadata" $ idx 2 ==> metadata
+ [ comment "Transaction inputs" $ idx 0 ==> set <-- txIn,
+ comment "Transaction outputs" $ idx 1 ==> set <-- txOut,
+ comment "Metadata" $ idx 2 ==> metadata
]
metadata <- "metadata" =:= VBytes
_value <- "value" =:= mp ["token" ==> VText, "quantity" ==> VUInt]
diff --git a/src/Codec/CBOR/Cuddle/Huddle.hs b/src/Codec/CBOR/Cuddle/Huddle.hs
index fabc883..b3547e5 100644
--- a/src/Codec/CBOR/Cuddle/Huddle.hs
+++ b/src/Codec/CBOR/Cuddle/Huddle.hs
@@ -8,6 +8,7 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-- | Module for building CDDL in Haskell
@@ -76,10 +77,14 @@ module Codec.CBOR.Cuddle.Huddle (
-- * Generics
GRef,
GRuleDef,
+ GRuleDef',
GRuleCall,
+ GRuleCall',
binding,
binding2,
+ binding',
callToDef,
+ (<--),
-- * Conversion to CDDL
collectFrom,
@@ -91,6 +96,7 @@ where
import Codec.CBOR.Cuddle.CDDL (CDDL, TopLevel (..), WithComments (..))
import Codec.CBOR.Cuddle.CDDL qualified as C
import Codec.CBOR.Cuddle.CDDL.CtlOp qualified as CtlOp
+import Codec.CBOR.Cuddle.Huddle.Generic (FnWithArg (..), result)
import Control.Monad (when)
import Control.Monad.State (MonadState (get), execState, modify)
import Data.ByteString (ByteString)
@@ -128,6 +134,7 @@ type Rule = Named Type0
data HuddleItem
= HIRule Rule
| HIGRule GRuleDef
+ | HIGRule' GRuleDef'
| HIGroup (Named Group)
deriving (Generic, Show)
@@ -273,6 +280,7 @@ data Type2
| T2Group (Named Group)
| -- | Call to a generic rule, binding arguments
T2Generic GRuleCall
+ | T2Generic' GRuleCall'
| -- | Reference to a generic parameter within the body of the definition
T2GenericRef GRef
deriving (Show)
@@ -475,9 +483,12 @@ sized v sz =
[]
class IsCborable a
+
instance IsCborable ByteString
-instance IsCborable (AnyRef a)
-instance IsCborable GRef
+
+instance IsCborable CRef
+
+instance IsCborable CGRef
cbor :: (IsCborable b, IsConstrainable c b) => c -> Rule -> Constrained
cbor v r@(Named n _ _) =
@@ -493,9 +504,12 @@ cbor v r@(Named n _ _) =
[r]
class IsComparable a
+
instance IsComparable Int
-instance IsComparable (AnyRef a)
-instance IsComparable GRef
+
+instance IsComparable CRef
+
+instance IsComparable CGRef
le :: (IsComparable a, IsConstrainable c a) => c -> Word64 -> Constrained
le v bound =
@@ -605,6 +619,9 @@ instance IsType0 (Named Group) where
instance IsType0 GRuleCall where
toType0 = NoChoice . T2Generic
+instance IsType0 GRuleCall' where
+ toType0 = NoChoice . T2Generic'
+
instance IsType0 GRef where
toType0 = NoChoice . T2GenericRef
@@ -617,6 +634,9 @@ instance IsType0 HuddleItem where
toType0 (HIGRule g) =
error $
"Attempt to reference generic rule from HuddleItem not supported: " <> show g
+ toType0 (HIGRule' g) =
+ error $
+ "Attempt to reference generic rule from HuddleItem not supported: " <> show g
class CanQuantify a where
-- | Apply a lower bound
@@ -933,6 +953,50 @@ binding2 fRule t0 t1 =
NoChoice x -> x
_ -> error "Cannot use a choice of types as a generic argument"
+--------------------------------------------------------------------------------
+-- Generics (Take 2)
+--------------------------------------------------------------------------------
+
+type GRuleDef' = Named (FnWithArg GRef Type0)
+
+data GRuleCallAux = GRuleCallAux
+ { defFn :: FnWithArg GRef Type0,
+ callArg :: Type2
+ }
+
+type GRuleCall' = Named GRuleCallAux
+
+binding' :: (GRef -> Rule) -> GRuleDef'
+binding' fRule =
+ Named
+ (getField @"name" $ result defFn)
+ (getField @"value" <$> defFn)
+ Nothing
+ where
+ defFn = FnWithArg fRule (freshName 0)
+
+class IsGRuleDef f where
+ toGRuleDef :: f -> GRuleDef'
+
+instance IsGRuleDef GRuleDef' where
+ toGRuleDef = id
+
+instance IsGRuleDef HuddleItem where
+ toGRuleDef (HIGRule' gd) = gd
+ toGRuleDef _ = error "Attempt to use a non-generic rule as a GRuleDef"
+
+(<--) :: (IsType0 t0, IsGRuleDef gd) => gd -> t0 -> GRuleCall'
+(toGRuleDef -> f) <-- t0 = fmap toCall f
+ where
+ toCall rd =
+ GRuleCallAux
+ { defFn = rd,
+ callArg = t2
+ }
+ t2 = case toType0 t0 of
+ NoChoice x -> x
+ _ -> error "Cannot use a choice of types as a generic argument"
+
--------------------------------------------------------------------------------
-- Collecting all top-level rules
--------------------------------------------------------------------------------
@@ -1022,6 +1086,7 @@ toCDDL' mkPseudoRoot hdl =
toCDDLItem (HIRule r) = toCDDLRule r
toCDDLItem (HIGroup g) = toCDDLGroup g
toCDDLItem (HIGRule g) = toGenRuleDef g
+ toCDDLItem (HIGRule' g) = toGenRuleDef' g
toTopLevelPseudoRoot :: [Rule] -> C.WithComments C.Rule
toTopLevelPseudoRoot topRs =
toCDDLRule $
@@ -1084,6 +1149,7 @@ toCDDL' mkPseudoRoot hdl =
T2Ref (Named n _ _) -> C.Type1 (C.T2Name (C.Name n) Nothing) Nothing
T2Group (Named n _ _) -> C.Type1 (C.T2Name (C.Name n) Nothing) Nothing
T2Generic g -> C.Type1 (toGenericCall g) Nothing
+ T2Generic' g -> C.Type1 (toGenericCall' g) Nothing
T2GenericRef (GRef n) -> C.Type1 (C.T2Name (C.Name n) Nothing) Nothing
toMemberKey :: Key -> C.MemberKey
@@ -1158,6 +1224,12 @@ toCDDL' mkPseudoRoot hdl =
(C.Name n)
(Just . C.GenericArg $ fmap toCDDLType1 (args gr))
+ toGenericCall' :: GRuleCall' -> C.Type2
+ toGenericCall' (Named n gr _) =
+ C.T2Name
+ (C.Name n)
+ (Just . C.GenericArg $ NE.singleton (toCDDLType1 (callArg gr)))
+
toGenRuleDef :: GRuleDef -> C.WithComments C.Rule
toGenRuleDef (Named n gr c) =
C.WithComments
@@ -1170,3 +1242,16 @@ toCDDL' mkPseudoRoot hdl =
where
gps =
C.GenericParam $ fmap (\(GRef t) -> C.Name t) (args gr)
+
+ toGenRuleDef' :: GRuleDef' -> C.WithComments C.Rule
+ toGenRuleDef' (Named n g c) =
+ C.WithComments
+ ( C.Rule (C.Name n) (Just gps) C.AssignEq
+ . C.TOGType
+ $ C.Type0
+ $ toCDDLType1 <$> choiceToNE (fn g (arg g))
+ )
+ (C.comment <$> c)
+ where
+ gps =
+ C.GenericParam $ fmap (\(GRef t) -> C.Name t) (NE.singleton $ arg g)
diff --git a/src/Codec/CBOR/Cuddle/Huddle/Generic.hs b/src/Codec/CBOR/Cuddle/Huddle/Generic.hs
new file mode 100644
index 0000000..e1e48d5
--- /dev/null
+++ b/src/Codec/CBOR/Cuddle/Huddle/Generic.hs
@@ -0,0 +1,12 @@
+module Codec.CBOR.Cuddle.Huddle.Generic where
+
+-- | Function carrying its argument
+data FnWithArg a result = FnWithArg
+ { fn :: a -> result,
+ arg :: a
+ }
+ deriving (Functor)
+
+-- | Evaluate a function carrying its argument to its result
+result :: FnWithArg a result -> result
+result a = fn a (arg a)
diff --git a/src/Codec/CBOR/Cuddle/Huddle/HuddleM.hs b/src/Codec/CBOR/Cuddle/Huddle/HuddleM.hs
index 6cec70e..536685d 100644
--- a/src/Codec/CBOR/Cuddle/Huddle/HuddleM.hs
+++ b/src/Codec/CBOR/Cuddle/Huddle/HuddleM.hs
@@ -1,19 +1,20 @@
-- | Monad for declaring Huddle constructs
-module Codec.CBOR.Cuddle.Huddle.HuddleM (
- module Huddle,
- (=:=),
- (=:~),
- (=::=),
- binding,
- setRootRules,
- huddleDef,
- huddleDef',
- include,
- unsafeIncludeFromHuddle,
-)
+module Codec.CBOR.Cuddle.Huddle.HuddleM
+ ( module Huddle,
+ (=:=),
+ (=:~),
+ (=::=),
+ binding,
+ binding',
+ setRootRules,
+ huddleDef,
+ huddleDef',
+ include,
+ unsafeIncludeFromHuddle,
+ )
where
-import Codec.CBOR.Cuddle.Huddle hiding (binding, (=:=), (=:~))
+import Codec.CBOR.Cuddle.Huddle hiding (binding, binding', (=:=), (=:~))
import Codec.CBOR.Cuddle.Huddle qualified as Huddle
import Control.Monad.State.Strict (State, modify, runState)
import Data.Default.Class (def)
@@ -43,6 +44,11 @@ binding ::
HuddleM (t0 -> GRuleCall)
binding fRule = include (Huddle.binding fRule)
+binding' ::
+ (GRef -> Rule) ->
+ HuddleM GRuleDef'
+binding' fRule = include (Huddle.binding' fRule)
+
-- | Renamed version of Huddle's underlying '=:=' for use in generic bindings
(=::=) :: IsType0 a => T.Text -> a -> Rule
n =::= b = n Huddle.=:= b
@@ -84,9 +90,15 @@ instance IsType0 t0 => Includable (t0 -> GRuleCall) where
modify (field @"items" %~ (OMap.|> (n, HIGRule grDef)))
pure gr
+instance Includable GRuleDef' where
+ include r =
+ modify (field @"items" %~ (OMap.|> (r ^. field @"name", HIGRule' r)))
+ >> pure r
+
instance Includable HuddleItem where
include x@(HIRule r) = include r >> pure x
include x@(HIGroup g) = include g >> pure x
+ include x@(HIGRule' g) = include g >> pure x
include x@(HIGRule g) =
let n = g ^. field @"name"
in do
From c4afe6401484e020a55ef009b3ee24faef1bd54a Mon Sep 17 00:00:00 2001
From: Nicholas Clarke <nick@topos.org.uk>
Date: Tue, 21 Jan 2025 09:40:47 +0100
Subject: [PATCH 2/4] Fix compilation in GHC 8.10.7
NE.singleton doesn't exist until a later version of base.
---
src/Codec/CBOR/Cuddle/Huddle.hs | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/src/Codec/CBOR/Cuddle/Huddle.hs b/src/Codec/CBOR/Cuddle/Huddle.hs
index b3547e5..75a4f3d 100644
--- a/src/Codec/CBOR/Cuddle/Huddle.hs
+++ b/src/Codec/CBOR/Cuddle/Huddle.hs
@@ -1228,7 +1228,7 @@ toCDDL' mkPseudoRoot hdl =
toGenericCall' (Named n gr _) =
C.T2Name
(C.Name n)
- (Just . C.GenericArg $ NE.singleton (toCDDLType1 (callArg gr)))
+ (Just . C.GenericArg $ (toCDDLType1 (callArg gr)) NE.:| [])
toGenRuleDef :: GRuleDef -> C.WithComments C.Rule
toGenRuleDef (Named n gr c) =
@@ -1254,4 +1254,4 @@ toCDDL' mkPseudoRoot hdl =
(C.comment <$> c)
where
gps =
- C.GenericParam $ fmap (\(GRef t) -> C.Name t) (NE.singleton $ arg g)
+ C.GenericParam $ fmap (\(GRef t) -> C.Name t) (arg g NE.:| [])
From 978e927c178e4d71d34db39b37f608a560dc2bf7 Mon Sep 17 00:00:00 2001
From: Nicholas Clarke <nick@topos.org.uk>
Date: Wed, 22 Jan 2025 09:50:24 +0100
Subject: [PATCH 3/4] Improve comments and error messages
---
example/Monad.hs | 10 ++++----
src/Codec/CBOR/Cuddle/Huddle.hs | 32 +++++++++++++++----------
src/Codec/CBOR/Cuddle/Huddle/Generic.hs | 4 ++--
src/Codec/CBOR/Cuddle/Huddle/HuddleM.hs | 26 ++++++++++----------
4 files changed, 40 insertions(+), 32 deletions(-)
diff --git a/example/Monad.hs b/example/Monad.hs
index 99ceaa1..626c9c2 100644
--- a/example/Monad.hs
+++ b/example/Monad.hs
@@ -19,8 +19,8 @@ spec = huddleDef $ mdo
transaction <-
"transaction"
=:= mp
- [ idx 0 ==> set txIn,
- idx 1 ==> set' <-- txOut
+ [ idx 0 ==> set txIn
+ , idx 1 ==> set' <-- txOut
]
txIn <- "txIn" =:= arr ["transaction_id" ==> hash32, "index" ==> txId]
txOut <- "txOut" =:= arr [idx 0 ==> address, idx 1 ==> value]
@@ -44,9 +44,9 @@ spec2 =
_transaction <-
"transaction"
=:= mp
- [ comment "Transaction inputs" $ idx 0 ==> set <-- txIn,
- comment "Transaction outputs" $ idx 1 ==> set <-- txOut,
- comment "Metadata" $ idx 2 ==> metadata
+ [ comment "Transaction inputs" $ idx 0 ==> set <-- txIn
+ , comment "Transaction outputs" $ idx 1 ==> set <-- txOut
+ , comment "Metadata" $ idx 2 ==> metadata
]
metadata <- "metadata" =:= VBytes
_value <- "value" =:= mp ["token" ==> VText, "quantity" ==> VUInt]
diff --git a/src/Codec/CBOR/Cuddle/Huddle.hs b/src/Codec/CBOR/Cuddle/Huddle.hs
index 75a4f3d..13d91e2 100644
--- a/src/Codec/CBOR/Cuddle/Huddle.hs
+++ b/src/Codec/CBOR/Cuddle/Huddle.hs
@@ -486,9 +486,9 @@ class IsCborable a
instance IsCborable ByteString
-instance IsCborable CRef
+instance IsCborable CRefType
-instance IsCborable CGRef
+instance IsCborable CGRefType
cbor :: (IsCborable b, IsConstrainable c b) => c -> Rule -> Constrained
cbor v r@(Named n _ _) =
@@ -507,9 +507,9 @@ class IsComparable a
instance IsComparable Int
-instance IsComparable CRef
+instance IsComparable CRefType
-instance IsComparable CGRef
+instance IsComparable CGRefType
le :: (IsComparable a, IsConstrainable c a) => c -> Word64 -> Constrained
le v bound =
@@ -633,10 +633,14 @@ instance IsType0 HuddleItem where
toType0 (HIGroup g) = toType0 g
toType0 (HIGRule g) =
error $
- "Attempt to reference generic rule from HuddleItem not supported: " <> show g
+ "Attempt to reference a raw generic rule: "
+ <> show g
+ <> ". Most likely this indicates you haven't provided generic parameters."
toType0 (HIGRule' g) =
error $
- "Attempt to reference generic rule from HuddleItem not supported: " <> show g
+ "Attempt to reference a raw generic rule: "
+ <> show g
+ <> ". Most likely this indicates you haven't provided generic parameters."
class CanQuantify a where
-- | Apply a lower bound
@@ -960,12 +964,13 @@ binding2 fRule t0 t1 =
type GRuleDef' = Named (FnWithArg GRef Type0)
data GRuleCallAux = GRuleCallAux
- { defFn :: FnWithArg GRef Type0,
- callArg :: Type2
+ { defFn :: FnWithArg GRef Type0
+ , callArg :: Type2
}
type GRuleCall' = Named GRuleCallAux
+-- | Create a generic rule definition binding a single generic parameter.
binding' :: (GRef -> Rule) -> GRuleDef'
binding' fRule =
Named
@@ -983,15 +988,18 @@ instance IsGRuleDef GRuleDef' where
instance IsGRuleDef HuddleItem where
toGRuleDef (HIGRule' gd) = gd
- toGRuleDef _ = error "Attempt to use a non-generic rule as a GRuleDef"
+ toGRuleDef hi =
+ error $
+ "Attempt to apply generic parameters to a non-generic rule: " <> show hi
+-- | Call a generic definition, applying the given type parameter.
(<--) :: (IsType0 t0, IsGRuleDef gd) => gd -> t0 -> GRuleCall'
(toGRuleDef -> f) <-- t0 = fmap toCall f
where
toCall rd =
GRuleCallAux
- { defFn = rd,
- callArg = t2
+ { defFn = rd
+ , callArg = t2
}
t2 = case toType0 t0 of
NoChoice x -> x
@@ -1228,7 +1236,7 @@ toCDDL' mkPseudoRoot hdl =
toGenericCall' (Named n gr _) =
C.T2Name
(C.Name n)
- (Just . C.GenericArg $ (toCDDLType1 (callArg gr)) NE.:| [])
+ (Just . C.GenericArg $ toCDDLType1 (callArg gr) NE.:| [])
toGenRuleDef :: GRuleDef -> C.WithComments C.Rule
toGenRuleDef (Named n gr c) =
diff --git a/src/Codec/CBOR/Cuddle/Huddle/Generic.hs b/src/Codec/CBOR/Cuddle/Huddle/Generic.hs
index e1e48d5..36fea22 100644
--- a/src/Codec/CBOR/Cuddle/Huddle/Generic.hs
+++ b/src/Codec/CBOR/Cuddle/Huddle/Generic.hs
@@ -2,8 +2,8 @@ module Codec.CBOR.Cuddle.Huddle.Generic where
-- | Function carrying its argument
data FnWithArg a result = FnWithArg
- { fn :: a -> result,
- arg :: a
+ { fn :: a -> result
+ , arg :: a
}
deriving (Functor)
diff --git a/src/Codec/CBOR/Cuddle/Huddle/HuddleM.hs b/src/Codec/CBOR/Cuddle/Huddle/HuddleM.hs
index 536685d..66c5b23 100644
--- a/src/Codec/CBOR/Cuddle/Huddle/HuddleM.hs
+++ b/src/Codec/CBOR/Cuddle/Huddle/HuddleM.hs
@@ -1,17 +1,17 @@
-- | Monad for declaring Huddle constructs
-module Codec.CBOR.Cuddle.Huddle.HuddleM
- ( module Huddle,
- (=:=),
- (=:~),
- (=::=),
- binding,
- binding',
- setRootRules,
- huddleDef,
- huddleDef',
- include,
- unsafeIncludeFromHuddle,
- )
+module Codec.CBOR.Cuddle.Huddle.HuddleM (
+ module Huddle,
+ (=:=),
+ (=:~),
+ (=::=),
+ binding,
+ binding',
+ setRootRules,
+ huddleDef,
+ huddleDef',
+ include,
+ unsafeIncludeFromHuddle,
+)
where
import Codec.CBOR.Cuddle.Huddle hiding (binding, binding', (=:=), (=:~))
From 6f7750ba100874ff6a7c59f12c5d7de146ac0bc7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Joosep=20J=C3=A4=C3=A4ger?= <joosep.jaager@iohk.io>
Date: Tue, 15 Apr 2025 17:30:47 +0300
Subject: [PATCH 4/4] Changed fixity of (=:=) and (=:~) to be same as (==)
---
src/Codec/CBOR/Cuddle/Huddle.hs | 4 ++--
src/Codec/CBOR/Cuddle/Huddle/HuddleM.hs | 4 ++--
2 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/src/Codec/CBOR/Cuddle/Huddle.hs b/src/Codec/CBOR/Cuddle/Huddle.hs
index 13d91e2..bb4f960 100644
--- a/src/Codec/CBOR/Cuddle/Huddle.hs
+++ b/src/Codec/CBOR/Cuddle/Huddle.hs
@@ -708,12 +708,12 @@ infixl 8 ==>
(=:=) :: IsType0 a => T.Text -> a -> Rule
n =:= b = Named n (toType0 b) Nothing
-infixl 1 =:=
+infixl 4 =:=
(=:~) :: T.Text -> Group -> Named Group
n =:~ b = Named n b Nothing
-infixl 1 =:~
+infixl 4 =:~
class IsGroupOrArrayEntry a where
toGroupOrArrayEntry :: IsType0 x => x -> a
diff --git a/src/Codec/CBOR/Cuddle/Huddle/HuddleM.hs b/src/Codec/CBOR/Cuddle/Huddle/HuddleM.hs
index 66c5b23..71962ca 100644
--- a/src/Codec/CBOR/Cuddle/Huddle/HuddleM.hs
+++ b/src/Codec/CBOR/Cuddle/Huddle/HuddleM.hs
@@ -29,13 +29,13 @@ type HuddleM = State Huddle
(=:=) :: IsType0 a => T.Text -> a -> HuddleM Rule
n =:= b = let r = n Huddle.=:= b in include r
-infixl 1 =:=
+infixl 4 =:=
-- | Overridden version of group assignment which adds the rule to the state
(=:~) :: T.Text -> Group -> HuddleM (Named Group)
n =:~ b = let r = n Huddle.=:~ b in include r
-infixl 1 =:~
+infixl 4 =:~
binding ::
forall t0.