deriveAutoReg with superclass constraints

I would like to use deriveAutoReg but my type requires a KnownFoo superclass constraint e.g.:

data MsgConfig = MsgConfig
  { _msgChannelWidth :: Nat
  }

type family MsgChannelWidth (cfg :: MsgConfig) :: Nat where
  MsgChannelWidth ('MsgConfig x) = x

type KnownMsgConfig cfg = KnownNat (MsgChannelWidth cfg)

data Message (cfg :: MsgConfig) = Status
  { _msg_channel :: Unsigned (MsgChannelWidth cfg)
  , _msg_data :: Vec 60 (Unsigned 8)
  , _msg_chksum  :: Unsigned 4
  }
  deriving (Bundle, Generic)

deriving instance (KnownMsgConfig cfg) => BitPack (Message cfg)
deriving instance (KnownMsgConfig cfg) => Eq (Message cfg)
deriving instance (KnownMsgConfig cfg) => NFDataX (Message cfg)
deriving instance (KnownMsgConfig cfg) => Show (Message cfg)
deriving instance (KnownMsgConfig cfg) => ShowX (Message cfg)
makeLenses ''Message
deriveAutoReg ''Message

As expected, I get an error:

    • No instance for ‘KnownNat (MsgChannelWidth cfg)’
        arising from the superclasses of an instance declaration
    • In the instance declaration for ‘AutoReg (Message cfg)’
    |
597 | deriveAutoReg ''Message
    | ^^^^^^^^^^^^^^^^^^^^^^^

My guess is that since this is a macro there is no simple way of adding the superclass constraint.
I’m not [yet] familiar enough with template haskell to alter the macro implementation so until that time comes, is there an easy way to achieve what I want here?

For context, my goal is that when Message ends up in a register (well, autoReg), I get a register for each field instead of a single large register. My real type has ~45 fields and I suspect the resulting ~1200 bit register is worsening synthesis results compared to the functionally equivalent original verilog implementation.

The problem is caused by this line:

deriving instance (KnownMsgConfig cfg) => NFDataX (Message cfg)

If you remove the (KnownMsgConfig cfg) => part then it will compile without issues.

In fact you only need the KnownMsgConfig constraint on the BitPack instance, and you should remove it from all the other instances.
And then you don’t need the standalone deriving lines anymore for everything except the BitPack instance.
So you can shorten it to:

[...]
data Message (cfg :: MsgConfig) = Status
  { _msg_channel :: Unsigned (MsgChannelWidth cfg)
  , _msg_data :: Vec 60 (Unsigned 8)
  , _msg_chksum  :: Unsigned 4
  }
  deriving (Bundle, Generic, Eq, Show, ShowX, NFDataX)

deriving instance (KnownMsgConfig cfg) => BitPack (Message cfg)
makeLenses ''Message
deriveAutoReg ''Message

Ah, you’re right.
I realise now that it’s the Vec in my original code (not present in my first example) causing issues:

data MsgConfig = MsgConfig
  { _msgChannelWidth :: Nat
  , _msgDataLen :: Nat
  }

type family MsgChannelWidth (cfg :: MsgConfig) :: Nat where
  MsgChannelWidth ('MsgConfig x _) = x

type family MsgDataLen (cfg :: MsgConfig) :: Nat where
  MsgDataLen ('MsgConfig _ x) = x

type KnownMsgConfig cfg = KnownNat (MsgChannelWidth cfg)

data Message (cfg :: MsgConfig) = Status
  { _msg_channel :: Unsigned (MsgChannelWidth cfg)
  , _msg_data :: Vec (MsgDataLen cfg) (Unsigned 8)
  , _msg_chksum  :: Unsigned 4
  }
  deriving (Bundle, Generic, NFDataX)
deriving instance (KnownMsgConfig cfg) => BitPack (Message cfg)
makeLenses ''Message
deriveAutoReg ''Message

Doesn’t work because we need KnownNat (MsgDataLen cfg) to derive NFDataX for Vec.

I suspect you ran into this problem when moving the NFDataX to a standalone deriving, like this:

type KnownMsgConfig cfg = (KnownNat (MsgDataLen cfg), KnownNat (MsgChannelWidth cfg))

data Message (cfg :: MsgConfig) = Status
  { _msg_channel :: Unsigned (MsgChannelWidth cfg)
  , _msg_data :: Vec (MsgDataLen cfg) (Unsigned 8)
  , _msg_chksum  :: Unsigned 4
  }
  deriving (Bundle, Generic)
deriving instance (KnownMsgConfig cfg) => NFDataX (Message cfg)
deriving instance (KnownMsgConfig cfg) => BitPack (Message cfg)
makeLenses ''Message
deriveAutoReg ''Message

Which then indeed gives an error:

    • Could not deduce ‘KnownNat (MsgChannelWidth cfg)’
        arising from the superclasses of an instance declaration
      from the context: KnownNat (MsgDataLen cfg)
        bound by the instance declaration at src/Protocols.hs:97:1-23
    • In the instance declaration for ‘AutoReg (Message cfg)’
   |
97 | deriveAutoReg ''Message

And this is because deriveAutoReg, perhaps naively, assumes the NFDataX constraint on AutoReg can never introduce additional constraints beyond what AutoReg itself directly implies.

In this case NFDataX Requires both (KnownNat (MsgDataLen cfg), KnownNat (MsgChannelWidth cfg)) but AutoReg only needs
KnownNat (MsgChannelWidth cfg) directly. So KnownNat (MsgDataLen cfg) is not added to the instance and the error is given.

Whether it’s a requirement that the constraints of AutoReg and NFDataX are supposed to always be identical is not clear to me from the code. However in your case it is actually the case that they are identical. The way the NFDataX instance was written above is just too restrictive:

data MsgConfig = MsgConfig
  { _msgChannelWidth :: Nat
  , _msgDataLen :: Nat
  }

type family MsgChannelWidth (cfg :: MsgConfig) :: Nat where
  MsgChannelWidth ('MsgConfig x _) = x

type family MsgDataLen (cfg :: MsgConfig) :: Nat where
  MsgDataLen ('MsgConfig _ x) = x

type KnownMsgConfig cfg = (KnownNat (MsgDataLen cfg), KnownNat (MsgChannelWidth cfg))

data Message (cfg :: MsgConfig) = Status
  { _msg_channel :: Unsigned (MsgChannelWidth cfg)
  , _msg_data :: Vec (MsgDataLen cfg) (Unsigned 8)
  , _msg_chksum  :: Unsigned 4
  }
  deriving (Bundle, Generic)
deriving instance (KnownNat (MsgDataLen cfg)) => NFDataX (Message cfg)
deriving instance (KnownMsgConfig cfg) => BitPack (Message cfg)
deriveAutoReg ''Message

Which works for me. But I can imagine that for your 45 field type it will be a hassle to split out which fields require a KnownNat and which don’t.

I’ve modified deriveAutoReg to lookup any constraints that the superclass NFDataX might have, and add them as constraints to the generated AutoReg instance.

deriving instance (KnownMsgConfig cfg) => NFDataX (Message cfg)
deriveAutoReg ''Message

Will now generate (to see this run the compiler with -ddump-splices):

instance (KnownNat (MsgDataLen cfg), KnownMsgConfig (cfg :: MsgConfig)) =>
         AutoReg (Message (cfg :: MsgConfig)) where
  autoReg = ...

There is some duplication there, as KnownNat (MsgDataLen cfg) is implied by KnownMsgConfig (cfg :: MsgConfig).
And for example a generated 3-tuple instance now also gets extra (unnecessary) NFDataX constraints:

instance (AutoReg a, AutoReg b, AutoReg c,
          NFDataX a, NFDataX b, NFDataX c) =>
         AutoReg (a, b, c)

But it works for your example given above.
You can find this fix here for now in the fix-deriveAutoReg branch.

Maybe you can test that with your full original code?