{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Barbies.Internal.Wear
( Wear, Bare, Covered
)
where
import GHC.TypeLits (ErrorMessage (..), TypeError)
import Data.Generics.GenericN (Param)
data Bare
data Covered
type family Wear t f a where
Wear Bare f a = a
Wear Covered f a = f a
Wear (Param _ t) f a = Wear t f a
Wear t _ _ = TypeError ( 'Text "`Wear` should only be used with "
':<>: 'Text "`Bare` or `Covered`."
':$$: 'Text "`" ':<>: 'ShowType t ':<>: 'Text "`"
':<>: 'Text " is not allowed in this context."
)