MultiConstraint_TypeFamiliesOnly.hs

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

module Main where

import           Data.Kind

{-
λ: :load ../NormalTypeFamilyMultiConstraint.hs
[1 of 1] Compiling Main             ( ../NormalTypeFamilyMultiConstraint.hs, interpreted )
Ok, one module loaded.
λ: main
I can show it: [False,True,False]
I can eq it: True
I can only show it: [False,True,True,True]
-}
main :: IO ()
main = do
  useShowEq (Box [False, True, False])
  simpleBox (Box [False, True, True, True])

data Box (cs :: [Type -> Constraint]) where
  Box :: forall (cs :: [Type -> Constraint]) x. MultiConstraint cs x => x -> Box cs

type family MultiConstraint (xs :: [Type -> Constraint]) a :: Constraint where
  MultiConstraint '[] a = ()
  MultiConstraint (x ': xs) a = (x a, MultiConstraint xs a)

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

simpleBox :: Box '[Show] -> IO ()
simpleBox box = case box of
  Box x -> do
    putStrLn $ "I can only show it: " ++ show x