hset 1.1.0 → 2.0.0

raw patch · 13 files changed

+458/−236 lines, 13 filesdep +deepseqdep +taggeddep −mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq, tagged

Dependencies removed: mtl

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−2
• hset.cabal +14/−5
• src/Data/HSet.hs +7/−192
• src/Data/HSet/Get.hs +45/−0
• src/Data/HSet/Labeled.hs +0/−9
• src/Data/HSet/Modify.hs +44/−0
• src/Data/HSet/Remove.hs +51/−0
• src/Data/HSet/Reverse.hs +35/−0
• src/Data/HSet/SubHSet.hs +103/−0
• src/Data/HSet/Type.hs +47/−0
• src/Data/HSet/TypeLevel.hs +26/−15
• src/Data/HSet/Union.hs +64/−0
• test/Main.hs +8/−13

@@ -1,12 +1,24 @@ # FUTURE FEATUES-* `HUnion` typeclass to authomatically merge two sets * `HDiff` typeclass to authomatically calculate difference between two hsets * Use `Data.Set TypeRep Dynamic` as internal representation of hset to   increase access speed to arbitrary fields-* Add support of updating hset elements (make it not just read only) * Add lens support  # CHANGELOG++## 2.0.0+### Changed+* `HGetable` renamed to `HGettable` because of popular grammar nazi demand.+* Monolithic module `Data.HSet` is splitted to submodules+* `HSet` is now lazy on it's tail because it must be ... I suppose.+### Added+* `NFData` instance for `HSet`+* `HRemove` typeclass to remove specific element from `HSet` by index+* `HUnion` typeclass to merge two subsets+* `HModify` typeclass to modify value and type of arbitrary element of `HSet`+### Deleted+* `mtl` dependency dropped in favor of using lens combinators for+  `MonadReader` and `MonadState`  ## 1.1.0 ### Added

@@ -1,6 +1,6 @@ name:                hset-version:             1.1.0-synopsis:            Primitive heterogenous read-only set+version:             2.0.0+synopsis:            Primitive list with elements of unique types. license:             BSD3 license-file:        LICENSE author:              s9gf4ult@@ -21,11 +21,19 @@   ghc-options: -Wall    exposed-modules:     Data.HSet-                     , Data.HSet.Labeled+                     , Data.HSet.Get+                     , Data.HSet.Modify+                     , Data.HSet.Remove+                     , Data.HSet.Reverse+                     , Data.HSet.SubHSet+                     , Data.HSet.Type                      , Data.HSet.TypeLevel+                     , Data.HSet.Union +   build-depends:       base >=4.7 && < 5-                     , mtl+                     , deepseq+                     , tagged    default-extensions: CPP                     , ConstraintKinds@@ -33,6 +41,7 @@                     , DeriveDataTypeable                     , FlexibleContexts                     , FlexibleInstances+                    , FunctionalDependencies                     , GADTs                     , KindSignatures                     , MultiParamTypeClasses@@ -68,4 +77,4 @@   build-depends: HUnit                , base >=4.7 && < 5                , hset-               , mtl+               , tagged

@@ -1,195 +1,10 @@ module Data.HSet-       ( HSet(..)-       , HGet(..)-       , HGetable-       , hask-       , SubHSet(..)-       , SubHSetable-       , hdelete-       , hnarrow-         -- * Work with 'Labeled' elements-       , hgetLabeled-       , haskLabeled-         -- * Reexports-       , module Data.HSet.Labeled+       ( module X        ) 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--{- | Heterogeneous set (list) of elements with unique types. Useful-with MonadReader.-->>> let x = HSCons (10 :: Int) $ HSCons (20 :: Double) HSNil->>> x-HSCons (10) (HSCons (20.0) (HSNil))-->>> hget x :: Int-10-->>> hget x :: Double-20.0--Note that 'hget' takes specific element from list of uniquely typed-elements depending on what type is required to be returned.---}--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---- | Typeclass for sets and elements.-class (i ~ (Index e els)) => HGet els e i where-  -- | Gets any data from HSet for you-  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---- | Enables deriving of the fact that 'e' is contained within 'els' and it's--- safe to say that 'hget' can be performed on this particular pair.-type HGetable els e = HGet els e (Index e els)--hask :: (MonadReader (HSet els) m, HGetable els e) => m e-hask = do-  h <- ask-  return $ hget h---{- | Takes subset of some hset, including subset of same elements in-different order-->>> let x = (HSCons "hello" $ HSCons 1234 $ HSCons 12.123 HSNil) :: HSet '[String, Int, Double]-->>> subHSet x :: HSet '[Double, Int]-HSCons (12.123) (HSCons (1234) (HSNil))-->>> subHSet x :: HSet '[String, Double]-HSCons ("hello") (HSCons (12.123) (HSNil))-->>> subHSet x :: HSet '[Int, String]-HSCons (1234) (HSCons ("hello") (HSNil))---}--class (eq ~ TEq els els2) => SubHSet els els2 eq where-  subHSet :: HSet els -> HSet els2--instance (eq ~ TEq els '[]) => SubHSet els '[] eq where-  subHSet _ = HSNil--instance ( HGetable els el, 'False ~ Elem el els2-         , SubHSet els els2 subeq-         , 'False ~ TEq els (el ': els2) )-         => SubHSet els (el ': els2) 'False where-  subHSet h = HSCons (hget h :: el) (subHSet h :: HSet els2)--instance ( HGetable els el, 'False ~ Elem el els2-         , SubHSet els els2 subeq-         , els ~ (el ': els2)-         , 'True ~ TEq els (el ': els2) )-         => SubHSet els (el ': els2) 'True where-  subHSet h = h--type SubHSetable els1 els2 eq = (SubHSet els1 els2 eq, eq ~ TEq els1 els2 )--{- | Removes element from HSet of specified type-->>> let x = (HSCons "sdf" $ HSCons 123 HSNil) :: HSet '[String, Int]-->>> hdelete (Proxy :: Proxy Int) x-HSCons ("sdf") (HSNil)-->>> hdelete (Proxy :: Proxy String) x-HSCons (123) (HSNil)---}--hdelete :: (SubHSetable els (Delete a els) eq)-        => proxy a -> HSet els -> HSet (Delete a els)-hdelete _ = subHSet--{- | Like 'subHSet' but with proxy for convenience-->>> let x = (HSCons "hello" $ HSCons 123 $ HSCons 345 HSNil) :: HSet '[String, Int, Integer]-->>> hnarrow (Proxy :: Proxy '[]) x-HSNil-->>> hnarrow (Proxy :: Proxy '[String]) x-HSCons ("hello") (HSNil)-->>> hnarrow (Proxy :: Proxy '[Int, Integer]) x-HSCons (123) (HSCons (345) (HSNil))-->>> hnarrow (Proxy :: Proxy '[Integer, Int]) x-HSCons (345) (HSCons (123) (HSNil))---}--hnarrow :: (SubHSetable els subels eq)-        => proxy subels -> HSet els -> HSet subels-hnarrow _ = subHSet----{- |-->>> let y = HSCons (Labeled 10 :: Labeled "x" Int) $ HSCons (Labeled 20 :: Labeled "y" Int) HSNil->>> y-HSCons (Labeled {unLabeled = 10}) (HSCons (Labeled {unLabeled = 20}) (HSNil))-->>> hgetLabeled (Proxy :: Proxy "x") y :: Int-10-->>> hgetLabeled (Proxy :: Proxy "y") y :: Int-20---}--hgetLabeled :: forall proxy label e els.-            (HGetable 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.-#if MIN_VERSION_base(4, 8, 0)-            (HGetable els (Labeled label e), MonadReader (HSet els) m)-#else-            (HGetable els (Labeled label e), MonadReader (HSet els) m, Applicative m)-#endif-            => proxy label -> m e-haskLabeled p = hgetLabeled p <$> ask+import Data.HSet.Get     as X+import Data.HSet.Modify  as X+import Data.HSet.Remove  as X+import Data.HSet.SubHSet as X+import Data.HSet.Type    as X+import Data.HSet.Union   as X

@@ -0,0 +1,45 @@+module Data.HSet.Get+       ( HGet(..)+       , HGettable+       ) where++import Data.HSet.Type+import Data.HSet.TypeLevel++#if !(MIN_VERSION_base(4, 8, 0))+import Control.Applicative+#endif+++{- | Heterogeneous read arbitrarily element from hset++>>> let x = HSCons (10 :: Int) $ HSCons (20 :: Double) HSNil+>>> x+HSCons (10) (HSCons (20.0) (HSNil))++>>> hget x :: Int+10++>>> hget x :: Double+20.0++Note that 'hget' takes specific element from list of uniquely typed+elements depending on what type is required to be returned (return+type polymorphism)++-}++class (i ~ (Index e els)) => HGet els e i | els i -> e where+  -- | Gets any data from HSet for you+  hget :: HSet els -> e++instance HGet (e ': els) e 'Z where+  hget (HSCons e _) = e++instance (('S i) ~ (Index e (e1 ': els)), HGet els e i)+         => HGet (e1 ': els) e ('S i) where+  hget (HSCons _ els) = hget els++-- | Enables deriving of the fact that 'e' is contained within 'els' and it's+-- safe to say that 'hget' can be performed on this particular pair.+type HGettable els e = HGet els e (Index e els)

@@ -1,9 +0,0 @@-module Data.HSet.Labeled where--import Data.Typeable--newtype Labeled (label :: k) (typ :: *) = Labeled { unLabeled :: typ }-    deriving ( Typeable, Show, Eq, Ord )--mkLabel :: proxy label -> e -> Labeled label e-mkLabel _ = Labeled

@@ -0,0 +1,44 @@+module Data.HSet.Modify+       ( HModify(..)+       , HModifiable+       , HMonoModifiable+       , hMonoModify+       ) where++import Data.HSet.Type+import Data.HSet.TypeLevel++#if !(MIN_VERSION_base(4, 8, 0))+import Control.Applicative+#endif++class (i ~ (Index e1 els1), i ~ (Index e2 els2))+      => HModify els1 els2 e1 e2 i+       | els1 i     -> e1  , els2 i     -> e2+       , els1 e1 e2 -> els2, els2 e1 e2 -> els1 where+  hmodify :: (e1 -> e2) -> HSet els1 -> HSet els2++instance ('False ~ Elem e2 els)+         => HModify (e1 ': els) (e2 ': els) e1 e2 'Z where+  hmodify f (HSCons e els) = HSCons (f e) els++instance ( ('S i) ~ (Index e1 (ex ': els1))+         , ('S i) ~ (Index e2 (ex ': els2))+         , HModify els1 els2 e1 e2 i+         , 'False ~ (Elem ex els2) )+         => HModify (ex ': els1) (ex ': els2) e1 e2 ('S i) where+  hmodify f (HSCons e els) = HSCons e $ hmodify f els++-- | Check that we can turn one hset to another+type HModifiable els1 els2 e1 e2 = HModify els1 els2 e1 e2 (Index e1 els1)++-- | Helper type infering that hset 'els' contains element of type 'e'+-- and can be modified+type HMonoModifiable els e = HModifiable els els e e++-- | Like 'hmodify' but do not change the hset's type+hMonoModify :: HMonoModifiable els e+            => (e -> e)+            -> HSet els+            -> HSet els+hMonoModify f h = hmodify f h

@@ -0,0 +1,51 @@+module Data.HSet.Remove+       ( HRemove(..)+       , HDeletable+       , hdelete+       ) where++import Data.HSet.Type+import Data.HSet.TypeLevel+import Data.Typeable++#if !(MIN_VERSION_base(4, 8, 0))+import Control.Applicative+#endif+++-- | Remove i's element from hset. Second argument is a resulting hset+-- type+class HRemove els1 els2 i | els1 i -> els2 where+  hremove :: Proxy i -> HSet els1 -> HSet els2++instance HRemove (e ': els) els 'Z where+  hremove _ (HSCons _ els) = els++instance ( 'False ~ (Elem e els2)+         , HRemove els1 els2 i )+         => HRemove (e ': els1) (e ': els2) ('S i) where+  hremove _ (HSCons e els) = HSCons e $ hremove (Proxy :: Proxy i) els++{- | Delete element from HSet of specified type++>>> let x = (HSCons "sdf" $ HSCons 123 HSNil) :: HSet '[String, Int]++>>> hdelete (Proxy :: Proxy Int) x+HSCons ("sdf") (HSNil)++>>> hdelete (Proxy :: Proxy String) x+HSCons (123) (HSNil)++-}++-- | Constraints that e can be removed from els1 and els2 will be+-- produced in result+type HDeletable e els1 els2 = HRemove els1 els2 (Index e els1)++-- | Delete specific element from els1 and returns HSet with els2+hdelete :: forall proxy els1 els2 e+         . (HDeletable e els1 els2)+        => proxy e+        -> HSet els1+        -> HSet els2+hdelete _ h = hremove (Proxy :: Proxy (Index e els1)) h

@@ -0,0 +1,35 @@+module Data.HSet.Reverse+       ( HReverse(..)+       , HReversible+       , hreverse+       ) where++import Data.HSet.Type+import Data.HSet.TypeLevel++-- | This is auxiliary typeclass for inversing the order of hset+-- elements+class HReverse acc els1 els2+      | acc els1 -> els2 where+  hreverse' :: HSet acc -> HSet els1 -> HSet els2++instance HReverse acc '[] acc where+  hreverse' acc _ = acc++instance ( 'False ~ (Elem e (ah ': at))+         , HReverse (e ': ah ': at) els1 els2 )+         => HReverse (ah ': at) (e ': els1) els2 where+  hreverse' acc (HSCons e els1) = hreverse' (HSCons e acc) els1++instance ( (e ': els1) ~ Reverse els2 -- Little trick to help inference of els1 from els2+         , HReverse '[e] els1 els2 )+         => HReverse '[] (e ': els1) els2 where+  hreverse' acc (HSCons e els1) = hreverse' (HSCons e acc) els1+++type HReversible els1 els2 =+  ( HReverse '[] els1 els2+  )++hreverse :: (HReversible a r) => HSet a -> HSet r+hreverse a = hreverse' HSNil a

@@ -0,0 +1,103 @@+module Data.HSet.SubHSet+       ( SubHSet(..)+       , SubHSettable+       , hnarrow+       , hgetTagged+       ) where++import Data.HSet.Get+import Data.HSet.Type+import Data.HSet.TypeLevel+import Data.Tagged++#if !(MIN_VERSION_base(4, 8, 0))+import Control.Applicative+#endif+++{- $setup+>>> import Data.Proxy+-}++{- | Takes subset of some hset, including subset of same elements in+different order++>>> let x = (HSCons "hello" $ HSCons 1234 $ HSCons 12.123 HSNil) :: HSet '[String, Int, Double]++>>> subHSet x :: HSet '[Double, Int]+HSCons (12.123) (HSCons (1234) (HSNil))++>>> subHSet x :: HSet '[String, Double]+HSCons ("hello") (HSCons (12.123) (HSNil))++>>> subHSet x :: HSet '[Int, String]+HSCons (1234) (HSCons ("hello") (HSNil))++-}++class (eq ~ TEq els els2)+      => SubHSet els els2 eq where+  subHSet :: HSet els -> HSet els2++instance (eq ~ TEq els '[]) => SubHSet els '[] eq where+  subHSet _ = HSNil++instance ( HGettable els el, 'False ~ Elem el els2+         , SubHSet els els2 subeq+         , 'False ~ TEq els (el ': els2) )+         => SubHSet els (el ': els2) 'False where+  subHSet h = HSCons (hget h :: el) (subHSet h :: HSet els2)++instance ( HGettable els el, 'False ~ Elem el els2+         , SubHSet els els2 subeq+         , els ~ (el ': els2)+         , 'True ~ TEq els (el ': els2) )+         => SubHSet els (el ': els2) 'True where+  subHSet h = h++type SubHSettable els1 els2 = (SubHSet els1 els2 (TEq els1 els2))++{- | Like 'subHSet' but with proxy for convenience++>>> let x = (HSCons "hello" $ HSCons 123 $ HSCons 345 HSNil) :: HSet '[String, Int, Integer]++>>> hnarrow (Proxy :: Proxy '[]) x+HSNil++>>> hnarrow (Proxy :: Proxy '[String]) x+HSCons ("hello") (HSNil)++>>> hnarrow (Proxy :: Proxy '[Int, Integer]) x+HSCons (123) (HSCons (345) (HSNil))++>>> hnarrow (Proxy :: Proxy '[Integer, Int]) x+HSCons (345) (HSCons (123) (HSNil))++-}++hnarrow :: (SubHSettable els subels)+        => proxy subels -> HSet els -> HSet subels+hnarrow _ = subHSet++{- |++>>> let y = HSCons (Tagged 10 :: Tagged "x" Int) $ HSCons (Tagged 20 :: Tagged "y" Int) HSNil+>>> y+HSCons (Tagged 10) (HSCons (Tagged 20) (HSNil))++>>> hgetTagged (Proxy :: Proxy "x") y :: Int+10++>>> hgetTagged (Proxy :: Proxy "y") y :: Int+20++-}++hgetTagged :: forall proxy label e els+            . (HGettable els (Tagged label e))+           => proxy label+           -> HSet els+           -> e+hgetTagged _ hset =+  let x = hget hset+  in unTagged (x :: Tagged label e)

@@ -0,0 +1,47 @@+module Data.HSet.Type where++import Data.HSet.TypeLevel+import Data.Typeable+import Control.DeepSeq++#if !(MIN_VERSION_base(4, 8, 0))+import Control.Applicative+#endif+++{- | Heterogeneous set (list of elements) with unique types. Useful+with MonadReader.++-}++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++instance NFData (HSet '[]) where+  rnf a@HSNil = a `seq` ()++instance ( NFData e, NFData (HSet els) )+         => NFData (HSet (e ': els)) where+  rnf (HSCons e els) = rnf e `seq` rnf els `seq` ()

@@ -2,12 +2,15 @@        ( Nat(..)        , Elem        , Index+       , MayIndexGo+       , MayIndex+       , MayFstIndexSnd        , TEq        , Length        , Append+       , XReverse+       , Reverse        , Delete-       , FirstEQ-       , FirstContains        , And        , HSubset        ) where@@ -27,6 +30,19 @@   Index t (t ': ts) = 'Z   Index t (tt ': ts) = 'S (Index t ts) ++type family MayIndexGo (typ :: k) (typs :: [k]) (acc :: Nat) :: (Maybe Nat) where+  MayIndexGo t (t ': ts)  acc = 'Just acc+  MayIndexGo t (tt ': ts) acc = MayIndexGo t ts ('S acc)+  MayIndexGo t '[]        acc = 'Nothing++type MayIndex typ typs = MayIndexGo typ typs 'Z+++type family MayFstIndexSnd (ts1 :: [k]) (ts2 :: [k]) :: (Maybe Nat) where+  MayFstIndexSnd (e ': els) x = MayIndex e x+  MayFstIndexSnd '[] x        = 'Nothing+ type family TEq (t1 :: k) (t2 :: k) :: Bool where   TEq a a = 'True   TEq a b = 'False@@ -41,24 +57,19 @@   Append x '[] = x   Append (x ': xs) ys = x ': (Append xs ys) +type family XReverse (acc :: [*]) (l :: [*]) :: [*] where+  XReverse acc '[] = acc+  XReverse acc (e ': els) = XReverse (e ': acc) els+++-- | Reverse list of elements+type Reverse a = XReverse '[] a+ -- | Delete element from type list type family Delete (typ :: *) (typs :: [*]) :: [*] where   Delete x '[] = '[]   Delete x (x ': ys) = Delete x ys   Delete x (y ': ys) = y ': (Delete x ys)---- | First elements of two lists are equal?-type family FirstEQ (list1 :: [*]) (list2 :: [*]) :: Bool where-  FirstEQ '[] '[]             = 'False-  FirstEQ '[] x               = 'False-  FirstEQ x '[]               = 'False-  FirstEQ (x ': xs) (x ': ys) = 'True-  FirstEQ (x ': xs) (y ': ys) = 'False--type family FirstContains (list1 :: [*]) (list2 :: [*]) :: Bool where-  FirstContains '[] x         = 'False-  FirstContains x '[]         = 'False-  FirstContains (x ': xs) els = Elem x els  type family And (a :: Bool) (b :: Bool) where   And 'False x      = 'False

@@ -0,0 +1,64 @@+module Data.HSet.Union where++import Data.HSet.Remove+import Data.HSet.Type+import Data.HSet.TypeLevel+import Data.Typeable++#if !(MIN_VERSION_base(4, 8, 0))+import Control.Applicative+#endif++class ( fidx ~ (MayFstIndexSnd els1 els2)+      , sidx ~ (MayFstIndexSnd els2 els1) )+      => HUnion els1 els2 elsr fidx sidx+       | els1 els2 fidx sidx -> elsr where+  hunion :: HSet els1 -> HSet els2 -> HSet elsr++instance HUnion '[] '[] '[] 'Nothing 'Nothing where+  hunion _ _ = HSNil++instance HUnion '[] (e ': els) (e ': els) 'Nothing 'Nothing where+  hunion _ a = a++instance HUnion (e ': els) '[] (e ': els) 'Nothing 'Nothing where+  hunion a _ = a++instance ( HUnionable els1 els2 elsr+         , 'False ~ (Elem e1 (e2 ': elsr))+         , 'False ~ (Elem e2 elsr)+         , 'Nothing ~ (MayFstIndexSnd (e1 ': els1) (e2 ': els2))+         , 'Nothing ~ (MayFstIndexSnd (e2 ': els2) (e1 ': els1)) )+         => HUnion (e1 ': els1) (e2 ': els2) (e1 ': e2 ': elsr) 'Nothing 'Nothing where+  hunion (HSCons e1 els1) (HSCons e2 els2) = HSCons e1 $ HSCons e2 $ hunion els1 els2++instance ( HUnionable els1 els2 elsr+         , 'False ~ (Elem e elsr) )+         => HUnion (e ': els1) (e ': els2) (e ': elsr) ('Just 'Z) ('Just 'Z) where+  hunion (HSCons e els1) (HSCons _ els2) = HSCons e $ hunion els1 els2++instance ( HRemove els2 elsx fi+         , HUnionable els1 elsx elsr+         , 'False ~ (Elem e1 elsr)+         , ('Just ('S fi)) ~ (MayFstIndexSnd (e1 ': els1) (e2 ': els2))+         , ('Just si) ~ (MayFstIndexSnd (e2 ': els2) (e1 ': els1)) )+         => HUnion (e1 ': els1) (e2 ': els2) (e1 ': elsr) ('Just ('S fi)) ('Just si) where+  hunion (HSCons e1 els1) (HSCons _ els2) = HSCons e1 $ hunion els1 $ hremove (Proxy :: Proxy fi) els2++instance ( HRemove els2 elsx fi+         , HUnionable els1 elsx elsr+         , 'False ~ (Elem e1 elsr)+         , ('Just fi) ~ (MayFstIndexSnd (e1 ': els1) els2)+         , 'Nothing ~ (MayFstIndexSnd els2 (e1 ': els1)) )+         => HUnion (e1 ': els1) els2 (e1 ': elsr) ('Just fi) 'Nothing where+  hunion (HSCons e1 els1) els2 = HSCons e1 $ hunion els1 $ hremove (Proxy :: Proxy fi) els2++instance ( HUnionable els1 els2 elsr+         , 'False ~ (Elem e1 elsr)+         , 'Nothing ~ (MayFstIndexSnd (e1 ': els1) (e2 ': els2))+         , ('Just si) ~ (MayFstIndexSnd (e2 ': els2) (e1 ': els1)) )+         => HUnion (e1 ': els1) (e2 ': els2) (e1 ': elsr) 'Nothing ('Just si) where+  hunion (HSCons e1 els1) (HSCons _ els2) = HSCons e1 $ hunion els1 els2++type HUnionable els1 els2 elsr =+  HUnion els1 els2 elsr (MayFstIndexSnd els1 els2) (MayFstIndexSnd els2 els1)

@@ -1,9 +1,9 @@ module Main where  import Control.Monad-import Control.Monad.Reader import Data.HSet import Data.Proxy+import Data.Tagged import Test.HUnit  hset :: HSet '[Int, Double, Integer, Float]@@ -31,17 +31,12 @@ hsetFloat :: Float hsetFloat = hget hset -this :: (Double, Float)-this =-  let h = (,) <$> hask <*> hask-  in runReader h hset- data Label = This | That -labeledHSet :: HSet '[Labeled 'This Int, Labeled 'That Int, Labeled "hello" String]-labeledHSet = HSCons (Labeled 1)-              $ HSCons (Labeled 2)-              $ HSCons (Labeled "olleh")+labeledHSet :: HSet '[Tagged 'This Int, Tagged 'That Int, Tagged "hello" String]+labeledHSet = HSCons (Tagged 1)+              $ HSCons (Tagged 2)+              $ HSCons (Tagged "olleh")               HSNil  main :: IO ()@@ -55,8 +50,8 @@       , TestCase $ hsetFloat @?= 4       ]     , TestList-      [ TestCase $ (hgetLabeled (Proxy :: Proxy 'This) labeledHSet) @?= (1 :: Int)-      , TestCase $ (hgetLabeled (Proxy :: Proxy 'That) labeledHSet) @?= (2 :: Int)-      , TestCase $ (hgetLabeled (Proxy :: Proxy "hello") labeledHSet) @?= "olleh"+      [ TestCase $ (hgetTagged (Proxy :: Proxy 'This) labeledHSet) @?= (1 :: Int)+      , TestCase $ (hgetTagged (Proxy :: Proxy 'That) labeledHSet) @?= (2 :: Int)+      , TestCase $ (hgetTagged (Proxy :: Proxy "hello") labeledHSet) @?= "olleh"       ]     ]