Remove UnionDetails layer

src/Polysemy/Bundle.hs

@@ -58,7 +58,7 @@ runBundle
   -> Sem (Append r' r) a
 runBundle = hoistSem $ \u -> hoist runBundle $ case decomp u of
   Right (Weaving (WeavingDetails (Bundle pr e) s wv ex ins)) ->
-    Union $ UnionDetails (extendMembership @_ @r pr) $ Weaving $
+    Union (extendMembership @_ @r pr) $ Weaving $
       WeavingDetails e s wv ex ins
   Left g -> weakenList @r' @r g
 {-# INLINE runBundle #-}
@@ -72,7 +72,7 @@ subsumeBundle
   -> Sem r a
 subsumeBundle = hoistSem $ \u -> hoist subsumeBundle $ case decomp u of
   Right (Weaving (WeavingDetails (Bundle pr e) s wv ex ins)) ->
-    Union $ UnionDetails (subsumeMembership pr)
+    Union (subsumeMembership pr)
               (Weaving (WeavingDetails e s wv ex ins))
   Left g -> g
 {-# INLINE subsumeBundle #-}

src/Polysemy/Internal.hs

@@ -353,9 +353,8 @@ raiseUnder :: ∀ e2 e1 r a. Sem (e1 ': r) a -> Sem (e1 ': e2 ': r) a
 raiseUnder = hoistSem $ hoist raiseUnder . weakenUnder
   where
     weakenUnder :: ∀ m x. Union (e1 ': r) m x -> Union (e1 ': e2 ': r) m x
-    weakenUnder (Union (UnionDetails Here a)) = Union $ UnionDetails Here a
-    weakenUnder (Union (UnionDetails (There n) a)) = Union $
-      UnionDetails (There (There n)) a
+    weakenUnder (Union Here a) = Union Here a
+    weakenUnder (Union (There n) a) = Union (There (There n)) a
     {-# INLINE weakenUnder #-}
 {-# INLINE raiseUnder #-}
 
@@ -369,9 +368,8 @@ raiseUnder2 :: ∀ e2 e3 e1 r a. Sem (e1 ': r) a -> Sem (e1 ': e2 ': e3 ': r) a
 raiseUnder2 = hoistSem $ hoist raiseUnder2 . weakenUnder2
   where
     weakenUnder2 ::  ∀ m x. Union (e1 ': r) m x -> Union (e1 ': e2 ': e3 ': r) m x
-    weakenUnder2 (Union (UnionDetails Here a)) = Union $ UnionDetails Here a
-    weakenUnder2 (Union (UnionDetails (There n) a)) = Union $
-      UnionDetails (There (There (There n))) a
+    weakenUnder2 (Union Here a) = Union Here a
+    weakenUnder2 (Union (There n) a) = Union (There (There (There n))) a
     {-# INLINE weakenUnder2 #-}
 {-# INLINE raiseUnder2 #-}
 
@@ -385,9 +383,9 @@ raiseUnder3 :: ∀ e2 e3 e4 e1 r a. Sem (e1 ': r) a -> Sem (e1 ': e2 ': e3 ': e4
 raiseUnder3 = hoistSem $ hoist raiseUnder3 . weakenUnder3
   where
     weakenUnder3 ::  ∀ m x. Union (e1 ': r) m x -> Union (e1 ': e2 ': e3 ': e4 ': r) m x
-    weakenUnder3 (Union (UnionDetails Here a)) = Union $ UnionDetails Here a
-    weakenUnder3 (Union (UnionDetails (There n) a)) = Union $
-      UnionDetails (There (There (There (There n)))) a
+    weakenUnder3 (Union Here a) = Union Here a
+    weakenUnder3 (Union (There n) a) = Union
+      (There (There (There (There n)))) a
     {-# INLINE weakenUnder3 #-}
 {-# INLINE raiseUnder3 #-}
 
@@ -424,7 +422,7 @@ subsumeUsing pr =
   let
     go :: forall x. Sem (e ': r) x -> Sem r x
     go = hoistSem $ \u -> hoist go $ case decomp u of
-      Right w -> Union $ UnionDetails pr w
+      Right w -> Union pr w
       Left  g -> g
     {-# INLINE go #-}
   in

src/Polysemy/Internal/Combinators.hs

@@ -360,7 +360,7 @@ rewrite f (Sem m) = Sem $ \k -> m $ \u ->
   k $ hoist (rewrite f) $ case decompCoerce u of
     Left x -> x
     Right (Weaving (WeavingDetails e s d n y)) ->
-      Union $ UnionDetails Here $ Weaving $ WeavingDetails (f e) s d n y
+      Union Here $ Weaving $ WeavingDetails (f e) s d n y
 
 
 ------------------------------------------------------------------------------

src/Polysemy/Internal/Union.hs

@@ -15,7 +15,6 @@
 
 module Polysemy.Internal.Union
   ( Union (..)
-  , UnionDetails (..)
   , Weaving (..)
   , WeavingDetails (..)
   , Member
@@ -60,17 +59,16 @@ import Polysemy.Internal.CustomErrors
 -- | An extensible, type-safe union. The @r@ type parameter is a type-level
 -- list of effects, any one of which may be held within the 'Union'.
 data Union (r :: EffectRow) (mWoven :: Type -> Type) a where
-  Union :: !(UnionDetails r mWoven a e) -> Union r mWoven a
-
-data UnionDetails r mWoven a e = UnionDetails
-  -- A proof that the effect is actually in @r@.
-  (ElemOf e r)
-  -- The effect to wrap. The functions 'prj' and 'decomp' can help
-  -- retrieve this value later.
-  (Weaving e mWoven a)
+  Union
+      :: -- A proof that the effect is actually in @r@.
+         ElemOf e r
+         -- The effect to wrap. The functions 'prj' and 'decomp' can help
+         -- retrieve this value later.
+      -> Weaving e m a
+      -> Union r m a  
 
 instance Functor (Union r mWoven) where
-  fmap f (Union (UnionDetails w t)) = Union $ UnionDetails w $ fmap f t
+  fmap f (Union w t) = Union w $ fmap f t
   {-# INLINE fmap #-}
 
 
@@ -117,8 +115,8 @@ weave
     -> (∀ x. s x -> Maybe x)
     -> Union r m a
     -> Union r n (s a)
-weave s' d v' (Union (UnionDetails w (Weaving (WeavingDetails e s nt f v)))) =
-  Union $ UnionDetails w $ Weaving $ WeavingDetails
+weave s' d v' (Union w (Weaving (WeavingDetails e s nt f v))) =
+  Union w $ Weaving $ WeavingDetails
               e (Compose $ s <$ s')
               (fmap Compose . d . fmap nt . getCompose)
               (fmap f . getCompose)
@@ -130,8 +128,8 @@ hoist
     :: (∀ x. m x -> n x)
     -> Union r m a
     -> Union r n a
-hoist f' (Union (UnionDetails w (Weaving (WeavingDetails e s nt f v)))) =
-  Union $ UnionDetails w $ Weaving $ WeavingDetails e s (f' . nt) f v
+hoist f' (Union w (Weaving (WeavingDetails e s nt f v))) =
+  Union w $ Weaving $ WeavingDetails e s (f' . nt) f v
 {-# INLINE hoist #-}
 
 
@@ -261,30 +259,30 @@ tryMembership = tryMembership' @r @e
 -- | Decompose a 'Union'. Either this union contains an effect @e@---the head
 -- of the @r@ list---or it doesn't.
 decomp :: Union (e ': r) m a -> Either (Union r m a) (Weaving e m a)
-decomp (Union (UnionDetails p a)) =
+decomp (Union p a) =
   case p of
     Here  -> Right a
-    There pr -> Left $ Union $ UnionDetails pr a
+    There pr -> Left $ Union pr a
 {-# INLINE decomp #-}
 
 ------------------------------------------------------------------------------
 -- | Retrieve the last effect in a 'Union'.
 extract :: Union '[e] m a -> Weaving e m a
-extract (Union (UnionDetails Here a))   = a
-extract (Union (UnionDetails (There g) _)) = case g of {}
+extract (Union Here a)   = a
+extract (Union (There g) _) = case g of {}
 {-# INLINE extract #-}
 
 
 ------------------------------------------------------------------------------
 -- | An empty union contains nothing, so this function is uncallable.
 absurdU :: Union '[] m a -> b
-absurdU (Union (UnionDetails pr _)) = case pr of {}
+absurdU (Union pr _) = case pr of {}
 
 
 ------------------------------------------------------------------------------
 -- | Weaken a 'Union' so it is capable of storing a new sort of effect.
 weaken :: forall e r m a. Union r m a -> Union (e ': r) m a
-weaken (Union (UnionDetails pr a)) = Union $ UnionDetails (There pr) a
+weaken (Union pr a) = Union (There pr) a
 {-# INLINE weaken #-}
 
 
@@ -305,7 +303,7 @@ inj e = injWeaving $
 -- given an explicit proof that the effect exists in @r@
 injUsing :: forall e r rInitial a.
   ElemOf e r -> e (Sem rInitial) a -> Union r (Sem rInitial) a
-injUsing pr e = Union $ UnionDetails pr $ Weaving $ WeavingDetails
+injUsing pr e = Union pr $ Weaving $ WeavingDetails
             e (Identity ())
             (fmap Identity . runIdentity)
             runIdentity
@@ -315,7 +313,7 @@ injUsing pr e = Union $ UnionDetails pr $ Weaving $ WeavingDetails
 ------------------------------------------------------------------------------
 -- | Lift a @'Weaving' e@ into a 'Union' capable of holding it.
 injWeaving :: forall e r m a. Member e r => Weaving e m a -> Union r m a
-injWeaving = Union . UnionDetails membership
+injWeaving = Union membership
 {-# INLINE injWeaving #-}
 
 ------------------------------------------------------------------------------
@@ -336,7 +334,7 @@ prjUsing
    . ElemOf e r
   -> Union r m a
   -> Maybe (Weaving e m a)
-prjUsing pr (Union (UnionDetails sn a)) = (\Refl -> a) <$> sameMember pr sn
+prjUsing pr (Union sn a) = (\Refl -> a) <$> sameMember pr sn
 {-# INLINE prjUsing #-}
 
 ------------------------------------------------------------------------------
@@ -345,8 +343,8 @@ prjUsing pr (Union (UnionDetails sn a)) = (\Refl -> a) <$> sameMember pr sn
 decompCoerce
     :: Union (e ': r) m a
     -> Either (Union (f ': r) m a) (Weaving e m a)
-decompCoerce (Union (UnionDetails p a)) =
+decompCoerce (Union p a) =
   case p of
     Here  -> Right a
-    There pr -> Left (Union $ UnionDetails (There pr) a)
+    There pr -> Left (Union (There pr) a)
 {-# INLINE decompCoerce #-}

src/Polysemy/Tagged.hs

@@ -81,7 +81,7 @@ untag
 -- Once GHC 8.10 rolls out, I will benchmark and compare.
 untag = hoistSem $ \u -> case decompCoerce u of
   Right (Weaving (WeavingDetails (Tagged e) s wv ex ins)) ->
-    Union $ UnionDetails Here (Weaving $ WeavingDetails e s (untag . wv) ex ins)
+    Union Here (Weaving $ WeavingDetails e s (untag . wv) ex ins)
   Left g -> hoist untag g
 {-# INLINE untag #-}