module Data.HSet
( HSet(..)
, HGet(..)
, Contains
, hask
, hgetLabeled
, haskLabeled
, module Data.HSet.Labeled
) where
import Control.Monad.Reader
import Data.HSet.Labeled
import Data.HSet.TypeLevel
import Data.Typeable
#if !(MIN_VERSION_base(4, 8, 0))
import Control.Applicative
#endif
data HSet (elems :: [*]) where
HSNil :: HSet '[]
HSCons :: ('False ~ (Elem elem elems)) => !elem -> !(HSet elems) -> HSet (elem ': elems)
deriving ( Typeable )
instance Show (HSet '[]) where
show HSNil = "HSNil"
instance (Show e, Show (HSet els)) => Show (HSet (e ': els)) where
show (HSCons e els) = "HSCons (" ++ show e ++ ") (" ++ show els ++ ")"
instance Eq (HSet '[]) where
HSNil == HSNil = True
instance (Eq e, Eq (HSet els)) => Eq (HSet (e ': els)) where
(HSCons e els) == (HSCons e' els') = (e == e') && (els == els')
instance Ord (HSet '[]) where
HSNil `compare` HSNil = EQ
instance (Ord e, Ord (HSet els)) => Ord (HSet (e ': els)) where
(HSCons e els) `compare` (HSCons e' els') = case e `compare` e' of
EQ -> els `compare` els'
x -> x
class (i ~ (Index e els)) => HGet els e i where
hget :: HSet els -> e
instance HGet (e ': els) e 'Z where
hget (HSCons e _) = e
instance (i ~ (Index e els), ('S i) ~ (Index e (e1 ': els)), HGet els e i) => HGet (e1 ': els) e ('S i) where
hget (HSCons _ els) = hget els
type Contains els e = HGet els e (Index e els)
hask :: (MonadReader (HSet els) m, Contains els e) => m e
hask = do
h <- ask
return $ hget h
hgetLabeled :: forall proxy label e els.
(Contains els (Labeled label e))
=> proxy label -> HSet els -> e
hgetLabeled _ hset =
let x = hget hset
in unLabeled (x :: Labeled label e)
haskLabeled :: forall proxy label e els m.
(Contains els (Labeled label e), MonadReader (HSet els) m)
=> proxy label -> m e
haskLabeled p = hgetLabeled p <$> ask