MultiConstraint.hs

{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}

module MultiConstraint where

import           Data.Kind

data Box (c :: Type -> Constraint) where
  Box :: forall c x. c x => x -> Box c

data Dict (c :: Constraint) where
  Dict :: c => Dict c

class MultiConstraint (xs :: [Type -> Constraint]) a where
  type AllC a xs :: Constraint
  multiDict :: Dict (AllC a xs)

instance MultiConstraint '[] a where
  type AllC a '[] = ()
  multiDict = Dict

instance (f a, MultiConstraint fs a) => MultiConstraint (f ': fs) a where
  type AllC a (f ': fs) = (f a, AllC a fs)
  multiDict = case (multiDict @fs @a) of
    Dict -> Dict

useShowEq :: Box (MultiConstraint '[Show, Eq]) -> IO ()
useShowEq box = case box of
  Box (x :: x) -> case multiDict @'[Show, Eq] @x of
    Dict -> do
      putStrLn $ "I can show it: " ++ show x
      putStrLn $ "I can eq it: " ++ show (x == x)

{-
λ: useShowEq (Box [False, True, False])
I can show it: [False,True,False]
I can eq it: True
-}

This can be simplified heavily using -XUnsaturatedTypeFamilies:

https://gist.github.com/ramirez7/be39df7d32ac4f413b7c4152fb1934b2

Turns out you can get this nice Box interface w/type families alone without -XUnsaturatedTypeFamilies:

https://gist.github.com/ramirez7/bcca51360df273e4a7a5a682e28fd7fa