How to avoid the need to explicitly write complex KnownNat constraints?

Question

I have a class that imposes a restriction KnownNat:

class KnownNat (Card a) => HasFin a where
  type Card a :: Nat
  ...

And I have instances of this class for several basic types of "building block":

instance HasFin () where
  type Card () = 1
  ...

instance HasFin Bool where
  type Card Bool = 2
  ...

I plan to build many “composite” types from these types of building blocks using amounts and products. Currently, I have to explicitly write a compound constraint KnownNatwhen I instantiate HasFinfor one of these composite types:

instance (HasFin a, HasFin b, KnownNat (Card a + Card b)) => HasFin (Either a b) where
  type Card (Either a b) = Card a + Card b
  ...

I would really like not to write:, KnownNat (Card a + Card b)in the code above.

Is there any type checking plugin that can automatically extrapolate from (HasFin a, HasFin b) =>to (KnownNat (Card a + Card b)) =>?

, ​​ ?

Answer 1

, ! ghc-typelits-knownnat

:

-- Install ghc-typelits-knownnat via your favorite build tool like any other package
-- then only this line needs to be added to enable the plugin
{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}

-- Nothing special to be done otherwise, type-level programming as usual.
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Card where

import GHC.TypeLits

class KnownNat (Card a) => HasFin a where
  type Card a :: Nat

instance HasFin () where
  type Card () = 1

instance (HasFin a, HasFin b) => HasFin (Either a b) where
  type Card (Either a b) = Card a + Card b

---

, constraints. GADT , (KnownNat a, KnownNat b) :- KnownNat (a + b).

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeApplications #-}

module Card where

import Data.Constraint
import Data.Constraint.Nat
import GHC.TypeLits

class HasFin a where
  type Card a :: Nat
  card :: Dict (KnownNat (Card a))

instance HasFin () where
  type Card () = 1
  card = Dict

instance (HasFin a, HasFin b) => HasFin (Either a b) where
  type Card (Either a b) = Card a + Card b
  card =
    case (card @a, card @b, plusNat @(Card a) @(Card b)) of
      (Dict, Dict, Sub Dict) -> Dict