diff --git a/haskus-utils-variant.cabal b/haskus-utils-variant.cabal
--- a/haskus-utils-variant.cabal
+++ b/haskus-utils-variant.cabal
@@ -1,12 +1,12 @@
 name:                haskus-utils-variant
-version:             2.6.1
+version:             3.0
 synopsis:            Variant and EADT
 license:             BSD3
 license-file:        LICENSE
 author:              Sylvain Henry
 maintainer:          sylvain@haskus.fr
-homepage:            http://www.haskus.org
-copyright:           Sylvain Henry 2018
+homepage:            https://www.haskus.org
+copyright:           Sylvain Henry 2020
 category:            System
 build-type:          Simple
 cabal-version:       1.20
@@ -17,19 +17,19 @@
 
 source-repository head
   type: git
-  location: git://github.com/haskus/haskus-utils.git
+  location: git://github.com/haskus/packages.git
 
 library
   exposed-modules:
     Haskus.Utils.ContFlow
     Haskus.Utils.Variant
-    Haskus.Utils.Variant.OldFlow
-    Haskus.Utils.Variant.Flow
-    Haskus.Utils.Variant.Cont
+    Haskus.Utils.Variant.VEither
+    Haskus.Utils.Variant.Excepts
     Haskus.Utils.Variant.Syntax
     Haskus.Utils.VariantF
     Haskus.Utils.EADT
     Haskus.Utils.EADT.TH
+    Haskus.Utils.EGADT
 
   other-modules:
 
@@ -39,10 +39,9 @@
    ,  deepseq
    ,  exceptions                >= 0.9
    ,  template-haskell
-   ,  haskus-utils-types        >= 1.4.1
-   ,  haskus-utils-data
+   ,  haskus-utils-types        >= 1.5
+   ,  haskus-utils-data         >= 1.2
 
-  build-tools: 
   ghc-options:          -Wall
   default-language:     Haskell2010
   hs-source-dirs:       src/lib
@@ -58,8 +57,10 @@
       ,  EADT
 
    build-depends:
-         base
+         base                    >= 4.9 && < 5.0
       ,  haskus-utils-variant
+      ,  haskus-utils-types
+      ,  haskus-utils-data
       ,  tasty                   >= 0.11
       ,  tasty-quickcheck        >= 0.8
       ,  doctest                 >= 0.16
@@ -71,7 +72,7 @@
    ghc-options:         -Wall -threaded
    default-language:    Haskell2010
    build-depends:
-         base
+         base                    >= 4.9 && < 5.0
       ,  haskus-utils-variant
       ,  criterion
       ,  QuickCheck
diff --git a/src/lib/Haskus/Utils/ContFlow.hs b/src/lib/Haskus/Utils/ContFlow.hs
--- a/src/lib/Haskus/Utils/ContFlow.hs
+++ b/src/lib/Haskus/Utils/ContFlow.hs
@@ -11,74 +11,89 @@
 -- | Continuation based control-flow
 module Haskus.Utils.ContFlow
    ( ContFlow (..)
+   , ContTuple
+   , (>:>)
+   , (>-:>)
+   , (>%:>)
    , (>::>)
    , (>:-:>)
    , (>:%:>)
-   , ContListToTuple
-   , ContTupleToList
-   , StripR
-   , AddR
+   , ToMultiCont
    , MultiCont (..)
    )
 where
 
 import Haskus.Utils.Tuple
-import Haskus.Utils.Types
 
 -- | A continuation based control-flow
-newtype ContFlow (xs :: [*]) r = ContFlow (ContListToTuple xs r -> r)
+newtype ContFlow (xs :: [*]) r = ContFlow (ContTuple xs r -> r)
 
 -- | Convert a list of types into the actual data type representing the
 -- continuations.
-type family ContListToTuple (xs :: [*]) r where
-   ContListToTuple xs r = ListToTuple (AddR xs r)
+type family ContTuple (xs :: [*]) r where
+   ContTuple xs r = Tuple (ToMultiCont xs r)
 
--- | Convert a tuple of continuations into a list of types
-type family ContTupleToList t r :: [*] where
-   ContTupleToList t r = StripR (TupleToList t) r
+type family ToMultiCont xs r where
+   ToMultiCont '[] r       = '[]
+   ToMultiCont (x ': xs) r = (x -> r) ': ToMultiCont xs r
 
-type family AddR f r where
-   AddR '[] r       = '[]
-   AddR (x ': xs) r = (x -> r) ': AddR xs r
+-- | A multi-continuable type
+class MultiCont a where
+   type MultiContTypes a :: [*]
 
-type family StripR f r where
-   StripR '[] r              = '[]
-   StripR ((x -> r) ': xs) r = x ': StripR xs r
-   StripR ((x -> w) ': xs) r =
-      TypeError ( 'Text "Invalid continuation return type `"
-                  ':<>: 'ShowType w ':<>: 'Text "', expecting `"
-                  ':<>: 'ShowType r ':<>: 'Text "'")
+   -- | Convert a data into a multi-continuation
+   toCont :: a -> ContFlow (MultiContTypes a) r
 
+   -- | Convert a data into a multi-continuation (monadic)
+   toContM :: Monad m => m a -> ContFlow (MultiContTypes a) (m r)
+
+
+-- | Bind a multi-continuable type to a tuple of continuations
+(>:>) :: MultiCont a => a -> ContTuple (MultiContTypes a) r -> r
+{-# INLINABLE (>:>) #-}
+(>:>) a !cs = toCont a >::> cs
+
+infixl 0 >:>
+
+-- | Bind a single-continuable type to a 1-tuple of continuations
+(>-:>) :: (MultiCont a, MultiContTypes a ~ '[b]) => a -> (b -> r) -> r
+{-# INLINABLE (>-:>) #-}
+(>-:>) a c = toCont a >:-:> c
+
+infixl 0 >-:>
+
+-- | Bind a multi-continuable type to a tuple of continuations and
+-- reorder fields if necessary
+(>%:>) ::
+   ( MultiCont a
+   , ReorderTuple ts (ContTuple (MultiContTypes a) r)
+   ) => a -> ts -> r
+{-# INLINABLE (>%:>) #-}
+(>%:>) a !cs = toCont a >:%:> cs
+
+infixl 0 >%:>
+
+
 -- | Bind a flow to a tuple of continuations
-(>::>) :: ContFlow xs r -> ContListToTuple xs r -> r
-{-# INLINE (>::>) #-}
+(>::>) :: ContFlow xs r -> ContTuple xs r -> r
+{-# INLINABLE (>::>) #-}
 (>::>) (ContFlow f) !cs = f cs
 
 infixl 0 >::>
 
 -- | Bind a flow to a 1-tuple of continuations
 (>:-:>) :: ContFlow '[a] r -> (a -> r) -> r
-{-# INLINE (>:-:>) #-}
-(>:-:>) (ContFlow f) c = f (Single c)
+{-# INLINABLE (>:-:>) #-}
+(>:-:>) (ContFlow f) c = f (Unit c)
 
 infixl 0 >:-:>
 
 -- | Bind a flow to a tuple of continuations and
 -- reorder fields if necessary
 (>:%:>) :: forall ts xs r.
-   ( ReorderTuple ts (ContListToTuple xs r)
+   ( ReorderTuple ts (ContTuple xs r)
    ) => ContFlow xs r -> ts -> r
-{-# INLINE (>:%:>) #-}
+{-# INLINABLE (>:%:>) #-}
 (>:%:>) (ContFlow f) !cs = f (tupleReorder cs)
 
 infixl 0 >:%:>
-
-
-class MultiCont a where
-   type MultiContTypes a :: [*]
-
-   -- | Convert a data into a multi-continuation
-   toCont :: a -> ContFlow (MultiContTypes a) r
-
-   -- | Convert a data into a multi-continuation (monadic)
-   toContM :: Monad m => m a -> ContFlow (MultiContTypes a) (m r)
diff --git a/src/lib/Haskus/Utils/EADT.hs b/src/lib/Haskus/Utils/EADT.hs
--- a/src/lib/Haskus/Utils/EADT.hs
+++ b/src/lib/Haskus/Utils/EADT.hs
@@ -17,19 +17,13 @@
 
 -- | Extensible ADT
 module Haskus.Utils.EADT
-   ( EADT
+   ( EADT (..)
    , (:<:)
    , (:<<:)
    , pattern VF
    , appendEADT
    , liftEADT
    , popEADT
-   , AlterEADT
-   , alterEADT
-   , AlgEADT
-   , algEADT
-   , eadtToCont
-   , eadtToContM
    , contToEADT
    , contToEADTM
    -- * Reexport
@@ -42,12 +36,10 @@
 import Haskus.Utils.Variant
 import Haskus.Utils.Functor
 import Haskus.Utils.Types.List
+import Haskus.Utils.Types.Constraint
 import Haskus.Utils.Types
 import Haskus.Utils.ContFlow
 
-import GHC.Exts (Constraint)
-import Control.DeepSeq
-
 -- $setup
 -- >>> :set -XDataKinds
 -- >>> :set -XTypeApplications
@@ -56,37 +48,57 @@
 -- >>> :set -XTypeFamilies
 -- >>> :set -XPatternSynonyms
 -- >>> :set -XDeriveFunctor
+-- >>>
 -- >>> import Data.Functor.Classes
+-- >>>
 -- >>> data ConsF a e = ConsF a e deriving (Functor)
 -- >>> data NilF    e = NilF      deriving (Functor)
+-- >>>
 -- >>> instance Eq a => Eq1 (ConsF a) where liftEq cmp (ConsF a e1) (ConsF b e2) = a == b && cmp e1 e2
 -- >>> instance Eq1 NilF where liftEq _ _ _ = True
+-- >>>
 -- >>> :{
 -- >>> pattern Cons :: ConsF a :<: xs => a -> EADT xs -> EADT xs
 -- >>> pattern Cons a l = VF (ConsF a l)
 -- >>> pattern Nil :: NilF :<: xs => EADT xs
 -- >>> pattern Nil = VF NilF
--- >>> type List a = EADT '[ConsF a, NilF]
+-- >>> type ListF a = VariantF '[NilF, ConsF a]
+-- >>> type List a = EADT '[NilF, ConsF a]
 -- >>> :}
-
-
--- | An extensible ADT
 --
--- >>> VF NilF == (VF NilF :: EADT '[ConsF Int, NilF])
--- True
+-- >>>
 -- >>> let a = Cons "Hello" (Cons "World" Nil) :: List String
 -- >>> let b = Cons "Bonjour" (Cons "Monde" Nil) :: List String
 -- >>> a == b
 -- False
 -- >>> a == a
 -- True
-type EADT xs = Fix (VariantF xs)
 
--- TODO: GHC 8.6
--- Replace EADT with a newtype isomorphic to Fix.
--- Use "DerivingVia" to derive instances from "Fix"
-deriving newtype instance NFData (VariantF xs (EADT xs)) => NFData (EADT xs)
 
+-- | An extensible ADT
+newtype EADT fs
+   = EADT (VariantF fs (EADT fs))
+
+type instance Base (EADT fs) = VariantF fs
+
+instance Functor (VariantF fs) => Recursive (EADT fs) where
+   project (EADT a) = a
+
+instance Functor (VariantF fs) => Corecursive (EADT fs) where
+   embed = EADT
+
+instance Eq1 (VariantF fs) => Eq (EADT fs) where
+  EADT a == EADT b = eq1 a b
+
+instance Ord1 (VariantF fs) => Ord (EADT fs) where
+  compare (EADT a) (EADT b) = compare1 a b
+
+instance Show1 (VariantF fs) => Show (EADT fs) where
+  showsPrec d (EADT a) =
+    showParen (d >= 11)
+      $ showString "EADT "
+      . showsPrec1 11 a
+
 -- | Constructor `f` is in `xs`
 type family f :<: xs where
    f :<: xs = EADTF' f (EADT xs) xs
@@ -109,7 +121,7 @@
    ( e ~ EADT cs  -- allow easy use of TypeApplication to set the EADT type
    , f :<: cs     -- constraint synonym ensuring `f` is in `cs`
    ) => f (EADT cs) -> EADT cs
-pattern VF x = Fix (VariantF (VSilent x))
+pattern VF x = EADT (VariantF (VSilent x))
    -- `VSilent` matches a variant value without checking the membership: we
    -- already do it with :<:
 
@@ -119,15 +131,15 @@
    , ApplyAll (EADT zs) zs ~ Concat (ApplyAll (EADT zs) xs) (ApplyAll (EADT zs) ys)
    , Functor (VariantF xs)
    ) => EADT xs -> EADT zs
-appendEADT (Fix v) = Fix (appendVariantF @ys (fmap (appendEADT @ys) v))
+appendEADT (EADT v) = EADT (appendVariantF @ys (fmap (appendEADT @ys) v))
 
 -- | Lift an EADT into another
 liftEADT :: forall e as bs.
-   ( e ~ Fix (VariantF bs)
+   ( e ~ EADT bs
    , LiftVariantF as bs e
    , Functor (VariantF as)
    ) => EADT as -> EADT bs
-liftEADT = cata (Fix . liftVariantF)
+liftEADT = cata (EADT . liftVariantF)
 
 -- | Pop an EADT value
 popEADT :: forall f xs e.
@@ -135,57 +147,31 @@
    , e ~ EADT xs
    , f e :< ApplyAll e xs
    ) => EADT xs -> Either (VariantF (Remove f xs) (EADT xs)) (f (EADT xs))
-popEADT (Fix v) = popVariantF v
-
-type AlterEADT c xs = AlterVariantF c (EADT xs) xs
-
--- | Alter an EADT value
-alterEADT :: forall c xs.
-   ( AlterEADT c xs
-   ) => (forall f. c f => f (EADT xs) -> f (EADT xs)) -> EADT xs -> EADT xs
-alterEADT f (Fix v) = Fix (alterVariantF @c @(EADT xs) f v)
-
-type AlgEADT c r xs = AlgVariantF c (EADT xs) r xs
-
--- | Apply an algebra to an EADT value
-algEADT :: forall c r xs.
-   ( AlgEADT c r xs
-   ) => (forall f. c f => f (EADT xs) -> r) -> EADT xs -> r
-algEADT f (Fix v) = algVariantF @c @(EADT xs) @r f v
-
--- | Convert an EADT into a multi-continuation
-eadtToCont ::
-   ( ContVariant (ApplyAll (Fix (VariantF xs)) xs)
-   ) => Fix (VariantF xs) -> ContFlow (ApplyAll (Fix (VariantF xs)) xs) r
-eadtToCont (Fix v) = variantFToCont v
-
--- | Convert an EADT into a multi-continuation
-eadtToContM ::
-   ( ContVariant (ApplyAll (Fix (VariantF xs)) xs)
-   , Monad m
-   ) => m (Fix (VariantF xs))
-     -> ContFlow (ApplyAll (Fix (VariantF xs)) xs) (m r)
-eadtToContM f = variantFToContM (unfix <$> f)
+popEADT (EADT v) = popVariantF v
 
--- Orphan instance...
--- instance ContVariant (ApplyAll (EADT xs) xs) => MultiCont (EADT xs) where
---    type MultiContTypes (EADT xs) = ApplyAll (EADT xs) xs
---    toCont  = eadtToCont
---    toContM = eadtToContM
+-- | MultiCont instance
+--
+-- >>> let f x = toCont x >::> (const "[]", \(ConsF u us) -> u ++ ":" ++ f us)
+-- >>> f a
+-- "Hello:World:[]"
+instance (Functor (VariantF xs), ContVariant (ApplyAll (EADT xs) xs)) => MultiCont (EADT xs) where
+   type MultiContTypes (EADT xs) = ApplyAll (EADT xs) xs
+   toCont  (EADT v) = variantFToCont v
+   toContM f        = variantFToContM (project <$> f)
 
 -- | Convert a multi-continuation into an EADT
 contToEADT ::
-   ( ContVariant (ApplyAll (Fix (VariantF xs)) xs)
-   ) => ContFlow (ApplyAll (Fix (VariantF xs)) xs)
-                 (V (ApplyAll (Fix (VariantF xs)) xs))
-     -> Fix (VariantF xs)
-contToEADT c = Fix (contToVariantF c)
+   ( ContVariant (ApplyAll (EADT xs) xs)
+   ) => ContFlow (ApplyAll (EADT xs) xs)
+                 (V (ApplyAll (EADT xs) xs))
+     -> EADT xs
+contToEADT c = EADT (contToVariantF c)
 
 -- | Convert a multi-continuation into an EADT
 contToEADTM ::
-   ( ContVariant (ApplyAll (Fix (VariantF xs)) xs)
+   ( ContVariant (ApplyAll (EADT xs) xs)
    , Monad f
-   ) => ContFlow (ApplyAll (Fix (VariantF xs)) xs)
-                 (f (V (ApplyAll (Fix (VariantF xs)) xs)))
-     -> f (Fix (VariantF xs))
-contToEADTM f = Fix <$> contToVariantFM f
+   ) => ContFlow (ApplyAll (EADT xs) xs)
+                 (f (V (ApplyAll (EADT xs) xs)))
+     -> f (EADT xs)
+contToEADTM f = EADT <$> contToVariantFM f
diff --git a/src/lib/Haskus/Utils/EGADT.hs b/src/lib/Haskus/Utils/EGADT.hs
new file mode 100644
--- /dev/null
+++ b/src/lib/Haskus/Utils/EGADT.hs
@@ -0,0 +1,121 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Haskus.Utils.EGADT where
+
+import Unsafe.Coerce
+
+import Haskus.Utils.Monad
+import Haskus.Utils.Variant
+import Haskus.Utils.VariantF
+import Haskus.Utils.Types
+
+-- $setup
+-- >>> :set -XDataKinds
+-- >>> :set -XTypeApplications
+-- >>> :set -XTypeOperators
+-- >>> :set -XFlexibleContexts
+-- >>> :set -XTypeFamilies
+-- >>> :set -XPatternSynonyms
+-- >>> :set -XDeriveFunctor
+-- >>> :set -XGADTs
+-- >>> :set -XPolyKinds
+-- >>> :set -XPartialTypeSignatures
+-- >>>
+-- >>> :{
+-- >>> data LamF (ast :: Type -> Type) t where
+-- >>>   LamF :: ( ast a -> ast b ) -> LamF ast ( a -> b )
+-- >>> 
+-- >>> data AppF ast t where
+-- >>>   AppF :: ast ( a -> b ) -> ast a -> AppF ast b
+-- >>>
+-- >>> data VarF ast t where
+-- >>>   VarF :: String -> VarF ast Int
+-- >>>
+-- >>> type AST a = EGADT '[LamF,AppF,VarF] a
+-- >>>
+-- >>> :}
+--
+-- >>> let y = VF @(AST Int) (VarF "a")
+-- >>> :t y
+-- y :: EGADT '[LamF, AppF, VarF] Int
+--
+-- >>> :{
+-- >>> case y of
+-- >>>   VF (VarF x) -> print x
+-- >>>   _           -> putStrLn "Not a VarF"
+-- >>> :}
+-- "a"
+--
+-- >>> :{
+-- >>> f :: AST Int -> AST Int
+-- >>> f (VF (VarF x)) = VF (VarF "zz")
+-- >>> f _             = error "Unhandled case"
+-- >>> :}
+--
+-- >>> let z = VF (AppF (VF (LamF f)) (VF (VarF "a")))
+-- >>> :t z
+-- z :: EGADT '[LamF, AppF, VarF] Int
+--
+
+
+-- | An EADT with an additional type parameter
+newtype EGADT fs t = EGADT (HVariantF fs (EGADT fs) t)
+
+newtype HVariantF (fs :: [ (k -> Type) -> ( k -> Type) ]) (ast :: k -> Type) (t :: k)
+  = HVariantF (VariantF (ApplyAll ast fs) t)
+
+toHVariantAt
+  :: forall i fs ast a
+  .  KnownNat i
+  => (Index i fs) ast a -> VariantF (ApplyAll ast fs) a
+{-# INLINABLE toHVariantAt #-}
+toHVariantAt a = VariantF (Variant (natValue' @i) (unsafeCoerce a))
+
+fromHVariantAt
+  :: forall i fs ast a
+  .  KnownNat i
+  => VariantF (ApplyAll ast fs) a -> Maybe ((Index i fs) ast a)
+{-# INLINABLE fromHVariantAt #-}
+fromHVariantAt (VariantF (Variant t a)) = do
+  guard (t == natValue' @i)
+  return (unsafeCoerce a)
+
+type instance HBase (EGADT xs) = HVariantF xs
+
+instance HFunctor (HVariantF xs) => HRecursive (EGADT xs) where
+  hproject (EGADT a) = a
+
+instance HFunctor (HVariantF xs) => HCorecursive (EGADT xs) where
+  hembed = EGADT
+
+type family f :<! fs :: Constraint where
+  f :<! fs = ( MemberAtIndex (IndexOf f fs) f fs )
+
+type family MemberAtIndex (i :: Nat) f fs :: Constraint where
+  MemberAtIndex i f fs = ( KnownNat i, Index i fs ~ f )
+
+type family (:<<!) xs ys :: Constraint where
+  '[]       :<<! ys = ()
+  (x ': xs) :<<! ys = (x :<! ys, xs :<<! ys)
+
+-- | Pattern-match in an extensible GADT
+pattern VF :: forall e a f fs.
+  ( e ~ EGADT fs a  -- allow easy use of TypeApplication to set the EGADT type
+  , f :<! fs
+  ) => f (EGADT fs) a -> EGADT fs a
+pattern VF x <- ( ( \ ( EGADT (HVariantF v) ) -> fromHVariantAt @(IndexOf f fs) @fs v ) -> Just x )
+  where
+    VF x = EGADT (HVariantF (toHVariantAt @(IndexOf f fs) @fs x))
diff --git a/src/lib/Haskus/Utils/Variant.hs b/src/lib/Haskus/Utils/Variant.hs
--- a/src/lib/Haskus/Utils/Variant.hs
+++ b/src/lib/Haskus/Utils/Variant.hs
@@ -103,11 +103,12 @@
    , toVariant'
    , LiftVariant'
    , PopVariant
+   , showsVariant
    )
 where
 
 import Unsafe.Coerce
-import GHC.Exts (Any,Constraint)
+import GHC.Exts (Any)
 import Data.Typeable
 import Control.DeepSeq
 
@@ -167,7 +168,7 @@
    , Eq x
    ) => Eq (V (x ': xs))
    where
-      {-# INLINE (==) #-}
+      {-# INLINABLE (==) #-}
       (==) v1@(Variant t1 _) v2@(Variant t2 _)
          | t1 /= t2  = False
          | otherwise = case (popVariantHead v1, popVariantHead v2) of
@@ -193,7 +194,7 @@
    showVariantValue :: a -> ShowS
 
 instance ShowVariantValue (V '[]) where
-   {-# INLINE showVariantValue #-}
+   {-# INLINABLE showVariantValue #-}
    showVariantValue _ = showString "undefined"
 
 instance
@@ -202,7 +203,7 @@
    , Typeable x
    ) => ShowVariantValue (V (x ': xs))
    where
-   {-# INLINE showVariantValue #-}
+   {-# INLINABLE showVariantValue #-}
    showVariantValue v = case popVariantHead v of
          Right x -> showString "V @"
                     . showsPrec 10 (typeOf x)
@@ -210,21 +211,41 @@
                     . showsPrec 11 x
          Left xs -> showVariantValue xs
 
-instance
-   ( Show (V xs)
-   , Typeable xs
+-- | Haskell code corresponding to a Variant
+--
+-- >>> showsVariant 0 (V @Double 5.0 :: V '[Int,String,Double]) ""
+-- "V @Double 5.0 :: V '[Int, [Char], Double]"
+showsVariant ::
+   ( Typeable xs
    , ShowTypeList (V xs)
    , ShowVariantValue (V xs)
-   ) => Show (V xs)
+   ) => Int -> V xs -> ShowS
+showsVariant d v = showParen (d /= 0) $
+   showVariantValue v
+   . showString " :: "
+   -- disabled until GHC fixes #14341
+   -- . showsPrec 0 (typeOf v)
+   -- workaround:
+   . showString "V "
+   . showList__ (showTypeList v)
+
+instance Show (V '[]) where
+   {-# INLINABLE showsPrec #-}
+   showsPrec _ _ = undefined
+
+
+-- | Show instance
+--
+-- >>> show (V @Int 10  :: V '[Int,String,Double])
+-- "10"
+instance
+   ( Show x
+   , Show (V xs)
+   ) => Show (V (x ': xs))
    where
-      showsPrec d v = showParen (d /= 0) $
-         showVariantValue v
-         . showString " :: "
-         -- disabled until GHC fixes #14341
-         -- . showsPrec 0 (typeOf v)
-         -- workaround:
-         . showString "V "
-         . showList__ (showTypeList v)
+      showsPrec d v = case popVariantHead v of
+         Right x -> showsPrec d x
+         Left xs -> showsPrec d xs
 
 -- | Show a list of ShowS
 showList__ :: [ShowS] -> ShowS
@@ -242,11 +263,11 @@
    showTypeList :: a -> [ShowS]
 
 instance ShowTypeList (V '[]) where
-   {-# INLINE showTypeList #-}
+   {-# INLINABLE showTypeList #-}
    showTypeList _ = []
 
 instance (Typeable x, ShowTypeList (V xs)) => ShowTypeList (V (x ': xs)) where
-   {-# INLINE showTypeList #-}
+   {-# INLINABLE showTypeList #-}
    showTypeList _ = showsPrec 0 (typeOf (undefined :: x)) : showTypeList (undefined :: V xs)
 
 -- | Get Variant index
@@ -279,7 +300,7 @@
 -- | Set the value with the given indexed type
 --
 -- >>> toVariantAt @1 10 :: V '[Word,Int,Double]
--- V @Int 10 :: V '[Word, Int, Double]
+-- 10
 --
 toVariantAt :: forall (n :: Nat) (l :: [*]).
    ( KnownNat n
@@ -290,7 +311,7 @@
 -- | Set the first value
 --
 -- >>> toVariantHead 10 :: V '[Int,Float,Word]
--- V @Int 10 :: V '[Int, Float, Word]
+-- 10
 --
 toVariantHead :: forall x xs. x -> V (x ': xs)
 {-# INLINABLE toVariantHead #-}
@@ -300,8 +321,8 @@
 --
 -- >>> let x = V @Int 10 :: V '[Int,String,Float]
 -- >>> let y = toVariantTail @Double x
--- >>> y
--- V @Int 10 :: V '[Double, Int, [Char], Float]
+-- >>> :t y
+-- y :: V '[Double, Int, String, Float]
 --
 toVariantTail :: forall x xs. V xs -> V (x ': xs)
 {-# INLINABLE toVariantTail #-}
@@ -343,11 +364,11 @@
 --
 -- >>> let x = V @Word 10 :: V '[Int,Word,Float]
 -- >>> popVariantAt @0 x
--- Left (V @Word 10 :: V '[Word, Float])
+-- Left 10
 -- >>> popVariantAt @1 x
 -- Right 10
 -- >>> popVariantAt @2 x
--- Left (V @Word 10 :: V '[Int, Word])
+-- Left 10
 --
 popVariantAt :: forall (n :: Nat) l. 
    ( KnownNat n
@@ -363,7 +384,7 @@
 --
 -- >>> let x = V @Word 10 :: V '[Int,Word,Float]
 -- >>> popVariantHead x
--- Left (V @Word 10 :: V '[Word, Float])
+-- Left 10
 --
 -- >>> let y = V @Int 10 :: V '[Int,Word,Float]
 -- >>> popVariantHead y
@@ -380,10 +401,10 @@
 -- >>> import Data.Char (toUpper)
 -- >>> let x = V @String "Test" :: V '[Int,String,Float]
 -- >>> mapVariantAt @1 (fmap toUpper) x
--- V @[Char] "TEST" :: V '[Int, [Char], Float]
+-- "TEST"
 --
 -- >>> mapVariantAt @0 (+1) x
--- V @[Char] "Test" :: V '[Int, [Char], Float]
+-- "Test"
 mapVariantAt :: forall (n :: Nat) a b l.
    ( KnownNat n
    , a ~ Index n l
@@ -401,7 +422,7 @@
 -- >>> let f s = if s == "Test" then Just (42 :: Word) else Nothing
 -- >>> let x = V @String "Test" :: V '[Int,String,Float]
 -- >>> mapVariantAtM @1 f x
--- Just (V @Word 42 :: V '[Int, Word, Float])
+-- Just 42
 --
 -- >>> let y = V @String "NotTest" :: V '[Int,String,Float]
 -- >>> mapVariantAtM @1 f y
@@ -409,16 +430,22 @@
 --
 -- Example with `IO`:
 --
--- >>> mapVariantAtM @0 print x
--- V @[Char] "Test" :: V '[(), [Char], Float]
+-- >>> v <- mapVariantAtM @0 print x
 --
--- >>> mapVariantAtM @1 print x
+-- >>> :t v
+-- v :: V '[(), String, Float]
+--
+-- >>> v <- mapVariantAtM @1 print x
 -- "Test"
--- V @() () :: V '[Int, (), Float]
 --
--- >>> mapVariantAtM @2 print x
--- V @[Char] "Test" :: V '[Int, [Char], ()]
+-- >>> :t v
+-- v :: V '[Int, (), Float]
 --
+-- >>> v <- mapVariantAtM @2 print x
+-- 
+-- >>> :t v
+-- v :: V '[Int, [Char], ()]
+--
 mapVariantAtM :: forall (n :: Nat) a b l m .
    ( KnownNat n
    , Applicative m
@@ -466,10 +493,10 @@
 --
 -- >>> let f = mapVariantHeadTail (+5) (appendVariant @'[Double,Char])
 -- >>> f (V @Int 10 :: V '[Int,Word,Float])
--- V @Int 15 :: V '[Int, Word, Float, Double, Char]
+-- 15
 --
 -- >>> f (V @Word 20 :: V '[Int,Word,Float])
--- V @Word 20 :: V '[Int, Word, Float, Double, Char]
+-- 20
 --
 mapVariantHeadTail :: (x -> y) -> (V xs -> V ys) -> V (x ': xs) -> V (y ': ys)
 {-# INLINABLE mapVariantHeadTail #-}
@@ -504,7 +531,7 @@
    popVariant' :: V xs -> Either (V (Remove a xs)) a
 
 instance PopVariant a '[] where
-   {-# INLINE popVariant' #-}
+   {-# INLINABLE popVariant' #-}
    popVariant' _ = undefined
 
 instance forall a xs n xs' y ys.
@@ -516,7 +543,7 @@
       , xs ~ (y ': ys)
       ) => PopVariant a (y ': ys)
    where
-      {-# INLINE popVariant' #-}
+      {-# INLINABLE popVariant' #-}
       popVariant' (Variant t a)
          = case natValue' @n of
             0             -> Left (Variant t a) -- no 'a' left in xs
@@ -528,7 +555,7 @@
    splitVariant' :: V xs -> Either (V rs) (V as)
 
 instance SplitVariant as rs '[] where
-   {-# INLINE splitVariant' #-}
+   {-# INLINABLE splitVariant' #-}
    splitVariant' _ = undefined
 
 instance forall as rs xs x n m.
@@ -539,7 +566,7 @@
    , KnownNat n
    ) => SplitVariant as rs (x ': xs)
    where
-      {-# INLINE splitVariant' #-}
+      {-# INLINABLE splitVariant' #-}
       splitVariant' (Variant 0 v)
          = case natValue' @n of
             -- we assume that if `x` isn't in `as`, it is in `rs`
@@ -652,11 +679,11 @@
 --
 -- >>> let x = toVariantAt @0 10 :: V '[Int,String,Int]
 -- >>> mapVariantFirst @Int (+32) x
--- V @Int 42 :: V '[Int, [Char], Int]
+-- 42
 --
 -- >>> let y = toVariantAt @2 10 :: V '[Int,String,Int]
 -- >>> mapVariantFirst @Int (+32) y
--- V @Int 10 :: V '[Int, [Char], Int]
+-- 10
 --
 mapVariantFirst :: forall a b n l.
    ( Member a l
@@ -671,25 +698,25 @@
 --
 -- >>> let f s = if s == (42 :: Int) then Just "Yeah!" else Nothing
 -- >>> mapVariantFirstM f (toVariantAt @0 42 :: V '[Int,Float,Int])
--- Just (V @[Char] "Yeah!" :: V '[[Char], Float, Int])
+-- Just "Yeah!"
 --
 -- >>> mapVariantFirstM f (toVariantAt @2 42 :: V '[Int,Float,Int])
--- Just (V @Int 42 :: V '[[Char], Float, Int])
+-- Just 42
 --
 -- >>> mapVariantFirstM f (toVariantAt @0 10 :: V '[Int,Float,Int])
 -- Nothing
 --
 -- >>> mapVariantFirstM f (toVariantAt @2 10 :: V '[Int,Float,Int])
--- Just (V @Int 10 :: V '[[Char], Float, Int])
+-- Just 10
 --
 -- Example with `IO`:
 --
 -- >>> mapVariantFirstM @Int print (toVariantAt @0 42 :: V '[Int,Float,Int])
 -- 42
--- V @() () :: V '[(), Float, Int]
+-- ()
 --
 -- >>> mapVariantFirstM @Int print (toVariantAt @2 42 :: V '[Int,Float,Int])
--- V @Int 42 :: V '[(), Float, Int]
+-- 42
 --
 mapVariantFirstM :: forall a b n l m.
    ( Member a l
@@ -703,11 +730,11 @@
    mapVariant' :: (a -> b) -> V cs -> V (ReplaceNS is b cs)
 
 instance MapVariantIndexes a b '[] is where
-   {-# INLINE mapVariant' #-}
+   {-# INLINABLE mapVariant' #-}
    mapVariant' = undefined
 
 instance MapVariantIndexes a b cs '[] where
-   {-# INLINE mapVariant' #-}
+   {-# INLINABLE mapVariant' #-}
    mapVariant' _ v = v
 
 instance forall a b cs is i.
@@ -715,7 +742,7 @@
    , a ~ Index i cs
    , KnownNat i
    ) => MapVariantIndexes a b cs (i ': is) where
-   {-# INLINE mapVariant' #-}
+   {-# INLINABLE mapVariant' #-}
    mapVariant' f v = mapVariant' @a @b @(ReplaceN i b cs) @is f (mapVariantAt @i f v)
 
 type MapVariant a b cs =
@@ -729,10 +756,10 @@
 --
 -- >>> let add1 = mapVariant @Int (+1)
 -- >>> add1 (toVariantAt @0 10 :: V '[Int,Float,Int,Double])
--- V @Int 11 :: V '[Int, Float, Int, Double]
+-- 11
 --
 -- >>> add1 (toVariantAt @2 10 :: V '[Int,Float,Int, Double])
--- V @Int 11 :: V '[Int, Float, Int, Double]
+-- 11
 --
 mapVariant :: forall a b cs.
    ( MapVariant a b cs
@@ -744,10 +771,10 @@
 --
 -- >>> let add1 = mapNubVariant @Int (+1)
 -- >>> add1 (toVariantAt @0 10 :: V '[Int,Float,Int,Double])
--- V @Int 11 :: V '[Int, Float, Double]
+-- 11
 --
 -- >>> add1 (toVariantAt @2 10 :: V '[Int,Float,Int, Double])
--- V @Int 11 :: V '[Int, Float, Double]
+-- 11
 --
 mapNubVariant :: forall a b cs ds rs.
    ( MapVariant a b cs
@@ -765,10 +792,10 @@
 -- >>> newtype Even = Even Int deriving (Show)
 -- >>> let f x = if even x then V (Even x) else V (Odd x) :: V '[Odd, Even]
 -- >>> foldMapVariantAt @1 f (V @Int 10 :: V '[Float,Int,Double])
--- V @Even (Even 10) :: V '[Float, Odd, Even, Double]
+-- Even 10
 --
 -- >>> foldMapVariantAt @1 f (V @Float 0.5 :: V '[Float,Int,Double])
--- V @Float 0.5 :: V '[Float, Odd, Even, Double]
+-- 0.5
 --
 foldMapVariantAt :: forall (n :: Nat) l l2 .
    ( KnownNat n
@@ -837,10 +864,10 @@
 -- >>> newtype Even = Even Int deriving (Show)
 -- >>> let f x = if even x then V (Even x) else V (Odd x) :: V '[Odd, Even]
 -- >>> foldMapVariant @Int f (V @Int 10 :: V '[Float,Int,Double])
--- V @Even (Even 10) :: V '[Float, Odd, Even, Double]
+-- Even 10
 --
 -- >>> foldMapVariant @Int f (V @Float 0.5 :: V '[Float,Int,Double])
--- V @Float 0.5 :: V '[Float, Odd, Even, Double]
+-- 0.5
 --
 foldMapVariant :: forall a cs ds i.
    ( i ~ IndexOf a cs
@@ -870,7 +897,7 @@
    alterVariant' :: (forall a. c a => a -> a) -> Word -> Any -> Any
 
 instance AlterVariant c '[] where
-   {-# INLINE alterVariant' #-}
+   {-# INLINABLE alterVariant' #-}
    alterVariant' _ = undefined
 
 instance
@@ -878,7 +905,7 @@
    , c x
    ) => AlterVariant c (x ': xs)
    where
-      {-# INLINE alterVariant' #-}
+      {-# INLINABLE alterVariant' #-}
       alterVariant' f t v =
          case t of
             0 -> unsafeCoerce (f (unsafeCoerce v :: x))
@@ -911,7 +938,7 @@
    traverseVariant' :: (forall a . (Monad m, c a) => a -> m a) -> Word -> Any -> m Any
 
 instance TraverseVariant c '[] m where
-   {-# INLINE traverseVariant' #-}
+   {-# INLINABLE traverseVariant' #-}
    traverseVariant' _ = undefined
 
 instance
@@ -920,7 +947,7 @@
    , Monad m
    ) => TraverseVariant c (x ': xs) m
    where
-      {-# INLINE traverseVariant' #-}
+      {-# INLINABLE traverseVariant' #-}
       traverseVariant' f t v =
          case t of
             0 -> unsafeCoerce <$> f (unsafeCoerce v :: x)
@@ -951,37 +978,42 @@
 
 
 
-class ReduceVariant c r (b :: [*]) where
+class ReduceVariant c (b :: [*]) where
    reduceVariant' :: (forall a. c a => a -> r) -> Word -> Any -> r
 
-instance ReduceVariant c r '[] where
-   {-# INLINE reduceVariant' #-}
+instance ReduceVariant c '[] where
+   {-# INLINABLE reduceVariant' #-}
    reduceVariant' _ = undefined
 
 instance
-   ( ReduceVariant c r xs
+   ( ReduceVariant c xs
    , c x
-   ) => ReduceVariant c r (x ': xs)
+   ) => ReduceVariant c (x ': xs)
    where
-      {-# INLINE reduceVariant' #-}
+      {-# INLINABLE reduceVariant' #-}
       reduceVariant' f t v =
          case t of
             0 -> f (unsafeCoerce v :: x)
-            n -> reduceVariant' @c @r @xs f (n-1) v
+            n -> reduceVariant' @c @xs f (n-1) v
 
 -- | Reduce a variant to a single value by using a class function. You need to
 -- specify the constraints required by the modifying function.
 --
--- Usage:
---    reduceVariant @Show show v
+-- >>> let v = V "Yes" :: V '[String,Bool,Char]
+-- >>> reduceVariant @Show show v
+-- "\"Yes\""
 --
-reduceVariant :: forall c r (a :: [*]).
-   ( ReduceVariant c r a
-   ) => (forall x. c x => x -> r) -> V a  -> r
+-- >>> let n = V (10 :: Int) :: V '[Int,Word,Integer]
+-- >>> reduceVariant @Integral fromIntegral n :: Int
+-- 10
+reduceVariant :: forall c (a :: [*]) r.
+   ( ReduceVariant c a
+   ) => (forall x. c x => x -> r) -> V a -> r
 {-# INLINABLE reduceVariant #-}
-reduceVariant f (Variant t a) = reduceVariant' @c @r @a f t a
+reduceVariant f (Variant t a) = reduceVariant' @c @a f t a
 
 
+
 -----------------------------------------------------------
 -- Conversions between variants
 -----------------------------------------------------------
@@ -1011,7 +1043,7 @@
    liftVariant' :: V xs -> V ys
 
 instance LiftVariant' '[] ys where
-   {-# INLINE liftVariant' #-}
+   {-# INLINABLE liftVariant' #-}
    liftVariant' _ = undefined
 
 instance forall xs ys x.
@@ -1019,7 +1051,7 @@
       , KnownNat (IndexOf x ys)
       ) => LiftVariant' (x ': xs) ys
    where
-      {-# INLINE liftVariant' #-}
+      {-# INLINABLE liftVariant' #-}
       liftVariant' (Variant t a)
          | t == 0    = Variant (natValue' @(IndexOf x ys)) a
          | otherwise = liftVariant' @xs (Variant (t-1) a)
@@ -1056,7 +1088,7 @@
    toFlattenVariant :: Word -> a -> rs
 
 instance Flattenable (V '[]) rs where
-   {-# INLINE toFlattenVariant #-}
+   {-# INLINABLE toFlattenVariant #-}
    toFlattenVariant _ _ = undefined
 
 instance forall xs ys rs.
@@ -1064,7 +1096,7 @@
    , KnownNat (Length xs)
    ) => Flattenable (V (V xs ': ys)) (V rs)
    where
-   {-# INLINE toFlattenVariant #-}
+   {-# INLINABLE toFlattenVariant #-}
    toFlattenVariant i v = case popVariantHead v of
       Right (Variant n a) -> Variant (i+n) a
       Left vys            -> toFlattenVariant (i+natValue @(Length xs)) vys
@@ -1090,7 +1122,7 @@
    joinVariant :: V xs -> m (V (ExtractM m xs))
 
 instance JoinVariant m '[] where
-   {-# INLINE joinVariant #-}
+   {-# INLINABLE joinVariant #-}
    joinVariant _ = undefined
 
 instance forall m xs a.
@@ -1098,7 +1130,7 @@
    , ExtractM m (m a ': xs) ~ (a ': ExtractM m xs)
    , JoinVariant m xs
    ) => JoinVariant m (m a ': xs) where
-   {-# INLINE joinVariant #-}
+   {-# INLINABLE joinVariant #-}
    joinVariant (Variant 0 a) = (Variant 0 . unsafeCoerce) <$> (unsafeCoerce a :: m a)
    joinVariant (Variant n a) = prependVariant @'[a] <$> joinVariant (Variant (n-1) a :: V xs)
 
@@ -1116,11 +1148,11 @@
 
 
 instance NFData (V '[]) where
-   {-# INLINE rnf #-}
+   {-# INLINABLE rnf #-}
    rnf _ = ()
 
 instance (NFData x, NFData (V xs)) => NFData (V (x ': xs)) where
-   {-# INLINE rnf #-}
+   {-# INLINABLE rnf #-}
    rnf v = case popVariantHead v of
       Right x -> rnf x
       Left xs -> rnf xs
@@ -1174,9 +1206,10 @@
 -- | Get variant possible values in a tuple of Maybe types
 variantToTuple :: forall l t.
    ( VariantToHList l
-   , HTuple' (Map Maybe l) t
+   , HTuple (Map Maybe l)
+   , t ~ Tuple (Map Maybe l)
    ) => V l -> t
-variantToTuple = hToTuple' . variantToHList
+variantToTuple = hToTuple . variantToHList
 
 
 instance ContVariant xs => MultiCont (V xs) where
@@ -1198,58 +1231,58 @@
    contToVariantM :: Monad m => ContFlow xs (m (V xs)) -> m (V xs)
 
 instance ContVariant '[a] where
-   {-# INLINE variantToCont #-}
-   variantToCont (Variant _ a) = ContFlow $ \(Single f) ->
+   {-# INLINABLE variantToCont #-}
+   variantToCont (Variant _ a) = ContFlow $ \(Unit f) ->
       f (unsafeCoerce a)
 
-   {-# INLINE variantToContM #-}
-   variantToContM act = ContFlow $ \(Single f) -> do
+   {-# INLINABLE variantToContM #-}
+   variantToContM act = ContFlow $ \(Unit f) -> do
       Variant _ a <- act
       f (unsafeCoerce a)
 
-   {-# INLINE contToVariant #-}
+   {-# INLINABLE contToVariant #-}
    contToVariant c = c >::>
-      Single (toVariantAt @0)
+      Unit (toVariantAt @0)
 
-   {-# INLINE contToVariantM #-}
+   {-# INLINABLE contToVariantM #-}
    contToVariantM c = c >::>
-      Single (return . toVariantAt @0)
+      Unit (return . toVariantAt @0)
 
 instance ContVariant '[a,b] where
-   {-# INLINE variantToCont #-}
+   {-# INLINABLE variantToCont #-}
    variantToCont (Variant t a) = ContFlow $ \(f1,f2) ->
       case t of
          0 -> f1 (unsafeCoerce a)
          _ -> f2 (unsafeCoerce a)
 
-   {-# INLINE variantToContM #-}
+   {-# INLINABLE variantToContM #-}
    variantToContM act = ContFlow $ \(f1,f2) -> do
       Variant t a <- act
       case t of
          0 -> f1 (unsafeCoerce a)
          _ -> f2 (unsafeCoerce a)
 
-   {-# INLINE contToVariant #-}
+   {-# INLINABLE contToVariant #-}
    contToVariant c = c >::>
       ( toVariantAt @0
       , toVariantAt @1
       )
 
-   {-# INLINE contToVariantM #-}
+   {-# INLINABLE contToVariantM #-}
    contToVariantM c = c >::>
       ( return . toVariantAt @0
       , return . toVariantAt @1
       )
 
 instance ContVariant '[a,b,c] where
-   {-# INLINE variantToCont #-}
+   {-# INLINABLE variantToCont #-}
    variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3) ->
       case t of
          0 -> f1 (unsafeCoerce a)
          1 -> f2 (unsafeCoerce a)
          _ -> f3 (unsafeCoerce a)
 
-   {-# INLINE variantToContM #-}
+   {-# INLINABLE variantToContM #-}
    variantToContM act = ContFlow $ \(f1,f2,f3) -> do
       Variant t a <- act
       case t of
@@ -1257,14 +1290,14 @@
          1 -> f2 (unsafeCoerce a)
          _ -> f3 (unsafeCoerce a)
 
-   {-# INLINE contToVariant #-}
+   {-# INLINABLE contToVariant #-}
    contToVariant c = c >::>
       ( toVariantAt @0
       , toVariantAt @1
       , toVariantAt @2
       )
 
-   {-# INLINE contToVariantM #-}
+   {-# INLINABLE contToVariantM #-}
    contToVariantM c = c >::>
       ( return . toVariantAt @0
       , return . toVariantAt @1
@@ -1272,7 +1305,7 @@
       )
 
 instance ContVariant '[a,b,c,d] where
-   {-# INLINE variantToCont #-}
+   {-# INLINABLE variantToCont #-}
    variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4) ->
       case t of
          0 -> f1 (unsafeCoerce a)
@@ -1280,7 +1313,7 @@
          2 -> f3 (unsafeCoerce a)
          _ -> f4 (unsafeCoerce a)
 
-   {-# INLINE variantToContM #-}
+   {-# INLINABLE variantToContM #-}
    variantToContM act = ContFlow $ \(f1,f2,f3,f4) -> do
       Variant t a <- act
       case t of
@@ -1289,7 +1322,7 @@
          2 -> f3 (unsafeCoerce a)
          _ -> f4 (unsafeCoerce a)
 
-   {-# INLINE contToVariant #-}
+   {-# INLINABLE contToVariant #-}
    contToVariant c = c >::>
       ( toVariantAt @0
       , toVariantAt @1
@@ -1297,7 +1330,7 @@
       , toVariantAt @3
       )
 
-   {-# INLINE contToVariantM #-}
+   {-# INLINABLE contToVariantM #-}
    contToVariantM c = c >::>
       ( return . toVariantAt @0
       , return . toVariantAt @1
@@ -1306,7 +1339,7 @@
       )
 
 instance ContVariant '[a,b,c,d,e] where
-   {-# INLINE variantToCont #-}
+   {-# INLINABLE variantToCont #-}
    variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5) ->
       case t of
          0 -> f1 (unsafeCoerce a)
@@ -1315,7 +1348,7 @@
          3 -> f4 (unsafeCoerce a)
          _ -> f5 (unsafeCoerce a)
 
-   {-# INLINE variantToContM #-}
+   {-# INLINABLE variantToContM #-}
    variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5) -> do
       Variant t a <- act
       case t of
@@ -1325,7 +1358,7 @@
          3 -> f4 (unsafeCoerce a)
          _ -> f5 (unsafeCoerce a)
 
-   {-# INLINE contToVariant #-}
+   {-# INLINABLE contToVariant #-}
    contToVariant c = c >::>
       ( toVariantAt @0
       , toVariantAt @1
@@ -1334,7 +1367,7 @@
       , toVariantAt @4
       )
 
-   {-# INLINE contToVariantM #-}
+   {-# INLINABLE contToVariantM #-}
    contToVariantM c = c >::>
       ( return . toVariantAt @0
       , return . toVariantAt @1
@@ -1344,7 +1377,7 @@
       )
 
 instance ContVariant '[a,b,c,d,e,f] where
-   {-# INLINE variantToCont #-}
+   {-# INLINABLE variantToCont #-}
    variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6) ->
       case t of
          0 -> f1 (unsafeCoerce a)
@@ -1354,7 +1387,7 @@
          4 -> f5 (unsafeCoerce a)
          _ -> f6 (unsafeCoerce a)
 
-   {-# INLINE variantToContM #-}
+   {-# INLINABLE variantToContM #-}
    variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6) -> do
       Variant t a <- act
       case t of
@@ -1365,7 +1398,7 @@
          4 -> f5 (unsafeCoerce a)
          _ -> f6 (unsafeCoerce a)
 
-   {-# INLINE contToVariant #-}
+   {-# INLINABLE contToVariant #-}
    contToVariant c = c >::>
       ( toVariantAt @0
       , toVariantAt @1
@@ -1375,7 +1408,7 @@
       , toVariantAt @5
       )
 
-   {-# INLINE contToVariantM #-}
+   {-# INLINABLE contToVariantM #-}
    contToVariantM c = c >::>
       ( return . toVariantAt @0
       , return . toVariantAt @1
@@ -1386,7 +1419,7 @@
       )
 
 instance ContVariant '[a,b,c,d,e,f,g] where
-   {-# INLINE variantToCont #-}
+   {-# INLINABLE variantToCont #-}
    variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7) ->
       case t of
          0 -> f1 (unsafeCoerce a)
@@ -1397,7 +1430,7 @@
          5 -> f6 (unsafeCoerce a)
          _ -> f7 (unsafeCoerce a)
 
-   {-# INLINE variantToContM #-}
+   {-# INLINABLE variantToContM #-}
    variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7) -> do
       Variant t a <- act
       case t of
@@ -1409,7 +1442,7 @@
          5 -> f6 (unsafeCoerce a)
          _ -> f7 (unsafeCoerce a)
 
-   {-# INLINE contToVariant #-}
+   {-# INLINABLE contToVariant #-}
    contToVariant c = c >::>
       ( toVariantAt @0
       , toVariantAt @1
@@ -1420,7 +1453,7 @@
       , toVariantAt @6
       )
 
-   {-# INLINE contToVariantM #-}
+   {-# INLINABLE contToVariantM #-}
    contToVariantM c = c >::>
       ( return . toVariantAt @0
       , return . toVariantAt @1
@@ -1432,7 +1465,7 @@
       )
 
 instance ContVariant '[a,b,c,d,e,f,g,h] where
-   {-# INLINE variantToCont #-}
+   {-# INLINABLE variantToCont #-}
    variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8) ->
       case t of
          0 -> f1 (unsafeCoerce a)
@@ -1444,7 +1477,7 @@
          6 -> f7 (unsafeCoerce a)
          _ -> f8 (unsafeCoerce a)
 
-   {-# INLINE variantToContM #-}
+   {-# INLINABLE variantToContM #-}
    variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8) -> do
       Variant t a <- act
       case t of
@@ -1457,7 +1490,7 @@
          6 -> f7 (unsafeCoerce a)
          _ -> f8 (unsafeCoerce a)
 
-   {-# INLINE contToVariant #-}
+   {-# INLINABLE contToVariant #-}
    contToVariant c = c >::>
       ( toVariantAt @0
       , toVariantAt @1
@@ -1469,7 +1502,7 @@
       , toVariantAt @7
       )
 
-   {-# INLINE contToVariantM #-}
+   {-# INLINABLE contToVariantM #-}
    contToVariantM c = c >::>
       ( return . toVariantAt @0
       , return . toVariantAt @1
@@ -1482,7 +1515,7 @@
       )
 
 instance ContVariant '[a,b,c,d,e,f,g,h,i] where
-   {-# INLINE variantToCont #-}
+   {-# INLINABLE variantToCont #-}
    variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9) ->
       case t of
          0 -> f1 (unsafeCoerce a)
@@ -1495,7 +1528,7 @@
          7 -> f8 (unsafeCoerce a)
          _ -> f9 (unsafeCoerce a)
 
-   {-# INLINE variantToContM #-}
+   {-# INLINABLE variantToContM #-}
    variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9) -> do
       Variant t a <- act
       case t of
@@ -1509,7 +1542,7 @@
          7 -> f8 (unsafeCoerce a)
          _ -> f9 (unsafeCoerce a)
 
-   {-# INLINE contToVariant #-}
+   {-# INLINABLE contToVariant #-}
    contToVariant c = c >::>
       ( toVariantAt @0
       , toVariantAt @1
@@ -1522,7 +1555,7 @@
       , toVariantAt @8
       )
 
-   {-# INLINE contToVariantM #-}
+   {-# INLINABLE contToVariantM #-}
    contToVariantM c = c >::>
       ( return . toVariantAt @0
       , return . toVariantAt @1
@@ -1536,7 +1569,7 @@
       )
 
 instance ContVariant '[a,b,c,d,e,f,g,h,i,j] where
-   {-# INLINE variantToCont #-}
+   {-# INLINABLE variantToCont #-}
    variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10) ->
       case t of
          0 -> f1  (unsafeCoerce a)
@@ -1550,7 +1583,7 @@
          8 -> f9  (unsafeCoerce a)
          _ -> f10 (unsafeCoerce a)
 
-   {-# INLINE variantToContM #-}
+   {-# INLINABLE variantToContM #-}
    variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10) -> do
       Variant t a <- act
       case t of
@@ -1565,7 +1598,7 @@
          8 -> f9  (unsafeCoerce a)
          _ -> f10 (unsafeCoerce a)
 
-   {-# INLINE contToVariant #-}
+   {-# INLINABLE contToVariant #-}
    contToVariant c = c >::>
       ( toVariantAt @0
       , toVariantAt @1
@@ -1579,7 +1612,7 @@
       , toVariantAt @9
       )
 
-   {-# INLINE contToVariantM #-}
+   {-# INLINABLE contToVariantM #-}
    contToVariantM c = c >::>
       ( return . toVariantAt @0
       , return . toVariantAt @1
@@ -1594,7 +1627,7 @@
       )
 
 instance ContVariant '[a,b,c,d,e,f,g,h,i,j,k] where
-   {-# INLINE variantToCont #-}
+   {-# INLINABLE variantToCont #-}
    variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f11) ->
       case t of
          0 -> f1  (unsafeCoerce a)
@@ -1609,7 +1642,7 @@
          9 -> f10 (unsafeCoerce a)
          _ -> f11 (unsafeCoerce a)
 
-   {-# INLINE variantToContM #-}
+   {-# INLINABLE variantToContM #-}
    variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f11) -> do
       Variant t a <- act
       case t of
@@ -1625,7 +1658,7 @@
          9 -> f10 (unsafeCoerce a)
          _ -> f11 (unsafeCoerce a)
 
-   {-# INLINE contToVariant #-}
+   {-# INLINABLE contToVariant #-}
    contToVariant c = c >::>
       ( toVariantAt @0
       , toVariantAt @1
@@ -1640,7 +1673,7 @@
       , toVariantAt @10
       )
 
-   {-# INLINE contToVariantM #-}
+   {-# INLINABLE contToVariantM #-}
    contToVariantM c = c >::>
       ( return . toVariantAt @0
       , return . toVariantAt @1
@@ -1656,7 +1689,7 @@
       )
 
 instance ContVariant '[a,b,c,d,e,f,g,h,i,j,k,l] where
-   {-# INLINE variantToCont #-}
+   {-# INLINABLE variantToCont #-}
    variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f11,f12) ->
       case t of
          0  -> f1  (unsafeCoerce a)
@@ -1672,7 +1705,7 @@
          10 -> f11 (unsafeCoerce a)
          _  -> f12 (unsafeCoerce a)
 
-   {-# INLINE variantToContM #-}
+   {-# INLINABLE variantToContM #-}
    variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f11,f12) -> do
       Variant t a <- act
       case t of
@@ -1689,7 +1722,7 @@
          10 -> f11 (unsafeCoerce a)
          _  -> f12 (unsafeCoerce a)
 
-   {-# INLINE contToVariant #-}
+   {-# INLINABLE contToVariant #-}
    contToVariant c = c >::>
       ( toVariantAt @0
       , toVariantAt @1
@@ -1705,7 +1738,7 @@
       , toVariantAt @11
       )
 
-   {-# INLINE contToVariantM #-}
+   {-# INLINABLE contToVariantM #-}
    contToVariantM c = c >::>
       ( return . toVariantAt @0
       , return . toVariantAt @1
diff --git a/src/lib/Haskus/Utils/Variant/Cont.hs b/src/lib/Haskus/Utils/Variant/Cont.hs
deleted file mode 100644
--- a/src/lib/Haskus/Utils/Variant/Cont.hs
+++ /dev/null
@@ -1,99 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ImplicitParams #-}
-
--- | Continuation based control-flow
-module Haskus.Utils.Variant.Cont
-   ( fret
-   , fretN
-   , freturn
-   , freturnN
-   , frec
-   -- * Control-flow
-   , fIf
-   , Then (..)
-   , Else (..)
-   )
-where
-
-import Haskus.Utils.Tuple
-import Haskus.Utils.Types
-import Haskus.Utils.ContFlow
-
--- this define has to be defined in each module using ContFlow for now
-#define fdo ContFlow $ \__cs -> let ?__cs = __cs in do
-
--- | Call the type-indexed continuation from the tuple passed as first parameter
-fret :: forall x r t n xs.
-   ( ExtractTuple n t (x -> r)
-   , xs ~ ContTupleToList t r
-   , CheckMember x xs
-   , n ~ IndexOf x xs
-   , KnownNat n
-   , CheckNub xs
-   ) => t -> (x -> r)
-{-# INLINE fret #-}
-fret = tupleN @n @t @(x -> r)
-
--- | Implicitly call the type-indexed continuation in the context
-freturn :: forall x r t n xs.
-   ( ExtractTuple n t (x -> r)
-   , xs ~ ContTupleToList t r
-   , CheckMember x xs
-   , n ~ IndexOf x xs
-   , KnownNat n
-   , CheckNub xs
-   , ?__cs :: t
-   ) => x -> r
-{-# INLINE freturn #-}
-freturn = fret ?__cs
-
--- | Call the indexed continuation from the tuple passed as first parameter
-fretN :: forall n x r t xs.
-   ( ExtractTuple n t (x -> r)
-   , xs ~ ContTupleToList t r
-   , x ~ Index n xs
-   , KnownNat n
-   ) => t -> (x -> r)
-{-# INLINE fretN #-}
-fretN = tupleN @n @t @(x -> r)
-
-
--- | Implicitly call the type-indexed continuation in the context
-freturnN :: forall n x r t xs.
-   ( ExtractTuple n t (x -> r)
-   , xs ~ ContTupleToList t r
-   , x ~ Index n xs
-   , KnownNat n
-   , ?__cs :: t
-   ) => x -> r
-{-# INLINE freturnN #-}
-freturnN = fretN @n ?__cs
-
-
--- | Recursive call
-frec :: forall r xs.
-   ( ?__cs :: ContListToTuple xs r
-   ) => ContFlow xs r -> r
-frec f = f >::> ?__cs
-
-
-----------------------------------------
--- Control-flow
-
-data Then = Then
-data Else = Else
-
-fIf :: Bool -> ContFlow '[Then,Else] r
-{-# INLINE fIf #-}
-fIf b = fdo
-   case b of
-      True  -> freturn Then
-      False -> freturn Else
diff --git a/src/lib/Haskus/Utils/Variant/Excepts.hs b/src/lib/Haskus/Utils/Variant/Excepts.hs
new file mode 100644
--- /dev/null
+++ b/src/lib/Haskus/Utils/Variant/Excepts.hs
@@ -0,0 +1,401 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Haskus.Utils.Variant.Excepts
+   ( Excepts
+   , runE
+   , runE_
+   , liftE
+   , appendE
+   , prependE
+   , failureE
+   , successE
+   , throwE
+   , catchE
+   , catchEvalE
+   , evalE
+   , onE_
+   , onE
+   , finallyE
+   , injectExcepts
+   , withExcepts
+   , withExcepts_
+   , mapExcepts
+   , variantToExcepts
+   , veitherToExcepts
+   , catchLiftBoth
+   , catchLiftLeft
+   , catchLiftRight
+   , catchAllE
+   , catchDieE
+   , catchRemove
+   , sequenceE
+   , runBothE
+   -- * Reexport
+   , module Haskus.Utils.Variant.VEither
+   )
+where
+
+import Haskus.Utils.Monad
+import Haskus.Utils.Types
+import Haskus.Utils.Variant.VEither
+
+import Control.Monad.Catch
+#if MIN_VERSION_base(4,12,0) && !MIN_VERSION_base(4,13,0)
+import qualified Control.Monad.Fail
+import           Control.Monad.Fail ( MonadFail )
+#endif
+
+newtype Excepts es m a = Excepts (m (VEither es a))
+
+deriving instance Show (m (VEither es a)) => Show (Excepts es m a)
+
+-- | Run an Excepts
+runE :: forall es a m.
+   Excepts es m a -> m (VEither es a)
+{-# INLINABLE runE #-}
+runE (Excepts m) = m
+
+-- | Run an Excepts, discard the result value
+runE_ :: forall es a m.
+   Functor m => Excepts es m a -> m ()
+{-# INLINABLE runE_ #-}
+runE_ m = void (runE m)
+
+injectExcepts :: forall es a m.
+   Monad m => Excepts es m a -> Excepts es m (VEither es a)
+{-# INLINABLE injectExcepts #-}
+injectExcepts (Excepts m) = lift m
+
+withExcepts_ :: Monad m => (VEither es a -> m ()) -> Excepts es m a -> Excepts es m a
+{-# INLINABLE withExcepts_ #-}
+withExcepts_ f (Excepts m) = Excepts $ do
+   v <- m
+   f v
+   return v
+
+withExcepts :: Monad m => (VEither es a -> m b) -> Excepts es m a -> Excepts es m b
+{-# INLINABLE withExcepts #-}
+withExcepts f (Excepts m) = Excepts $ do
+   v <- m
+   VRight <$> f v
+
+-- | Convert a flow without error into a value
+evalE :: Monad m => Excepts '[] m a -> m a
+{-# INLINABLE evalE #-}
+evalE v = veitherToValue <$> runE v
+
+mapExcepts :: (m (VEither es a) -> n (VEither es' b)) -> Excepts es m a -> Excepts es' n b
+{-# INLINABLE mapExcepts #-}
+mapExcepts f = Excepts . f . runE
+
+-- | Lift a Excepts into another
+liftE :: forall es' es a m.
+   ( Monad m
+   , VEitherLift es es'
+   ) => Excepts es m a -> Excepts es' m a
+{-# INLINABLE liftE #-}
+liftE = mapExcepts (liftM veitherLift)
+
+-- | Append errors to an Excepts
+appendE :: forall ns es a m.
+   ( Monad m
+   ) => Excepts es m a -> Excepts (Concat es ns) m a
+{-# INLINABLE appendE #-}
+appendE = mapExcepts (liftM (veitherAppend @ns))
+
+-- | Prepend errors to an Excepts
+prependE :: forall ns es a m.
+   ( Monad m
+   , KnownNat (Length ns)
+   ) => Excepts es m a -> Excepts (Concat ns es) m a
+{-# INLINABLE prependE #-}
+prependE = mapExcepts (liftM (veitherPrepend @ns))
+
+instance Functor m => Functor (Excepts es m) where
+   {-# INLINABLE fmap #-}
+   fmap f = mapExcepts (fmap (fmap f))
+
+instance Foldable m => Foldable (Excepts es m) where
+   {-# INLINABLE foldMap #-}
+   foldMap f (Excepts m) = foldMap (veitherCont (const mempty) f) m
+
+instance Traversable m => Traversable (Excepts es m) where
+   {-# INLINABLE traverse #-}
+   traverse f (Excepts m) =
+      Excepts <$> traverse (veitherCont (pure . VLeft) (fmap VRight . f)) m
+
+instance (Functor m, Monad m) => Applicative (Excepts es m) where
+    {-# INLINABLE pure #-}
+    pure a = Excepts $ return (VRight a)
+
+    {-# INLINABLE (<*>) #-}
+    Excepts mf <*> Excepts ma = Excepts $ do
+      f <- mf
+      a <- ma
+      pure (f <*> a)
+
+    {-# INLINABLE (*>) #-}
+    m *> k = m >>= \_ -> k
+
+instance (Monad m) => Monad (Excepts es m) where
+    {-# INLINABLE (>>=) #-}
+    m >>= k = Excepts $ do
+        a <- runE m
+        case a of
+            VLeft es -> return (VLeft es)
+            VRight x -> runE (k x)
+
+#if MIN_VERSION_base(4,12,0)
+instance (MonadFail m) => MonadFail (Excepts es m) where
+#endif
+   {-# INLINABLE fail #-}
+   fail = Excepts . fail
+
+instance MonadTrans (Excepts e) where
+    {-# INLINABLE lift #-}
+    lift = Excepts . liftM VRight
+
+instance (MonadIO m) => MonadIO (Excepts es m) where
+    {-# INLINABLE liftIO #-}
+    liftIO = lift . liftIO
+
+
+-- | Throws exceptions into the base monad.
+instance MonadThrow m => MonadThrow (Excepts e m) where
+   {-# INLINABLE throwM #-}
+   throwM = lift . throwM
+
+-- | Catches exceptions from the base monad.
+instance MonadCatch m => MonadCatch (Excepts e m) where
+   catch (Excepts m) f = Excepts $ catch m (runE . f)
+
+instance MonadMask m => MonadMask (Excepts e m) where
+   mask f = Excepts $ mask $ \u -> runE $ f (q u)
+      where
+         q :: (m (VEither e a) -> m (VEither e a)) -> Excepts e m a -> Excepts e m a
+         q u (Excepts b) = Excepts (u b)
+
+   uninterruptibleMask f = Excepts $ uninterruptibleMask $ \u -> runE $ f (q u)
+      where
+         q :: (m (VEither e a) -> m (VEither e a)) -> Excepts e m a -> Excepts e m a
+         q u (Excepts b) = Excepts (u b)
+
+   generalBracket acquire release use = Excepts $ do
+      (eb, ec) <- generalBracket
+         (runE acquire)
+         (\eresource exitCase -> case eresource of
+            VLeft e -> return (VLeft e) -- nothing to release, acquire didn't succeed
+            VRight resource -> case exitCase of
+               ExitCaseSuccess (VRight b) -> runE (release resource (ExitCaseSuccess b))
+               ExitCaseException e        -> runE (release resource (ExitCaseException e))
+               _                          -> runE (release resource ExitCaseAbort))
+         (veitherCont (return . VLeft) (runE . use))
+      runE $ do
+         -- The order in which we perform those two 'Excepts' effects determines
+         -- which error will win if they are both erroring. We want the error from
+         -- 'release' to win.
+         c <- Excepts (return ec)
+         b <- Excepts (return eb)
+         return (b, c)
+
+
+
+-- | Signal an exception value @e@.
+throwE :: forall e es a m. (Monad m, e :< es) => e -> Excepts es m a
+{-# INLINABLE throwE #-}
+throwE = Excepts . pure . VLeft . V
+
+-- | Signal an exception value @e@.
+failureE :: forall e a m. Monad m => e -> Excepts '[e] m a
+{-# INLINABLE failureE #-}
+failureE = throwE
+
+-- | Signal a success
+successE :: forall a m. Monad m => a -> Excepts '[] m a
+{-# INLINABLE successE #-}
+successE = pure
+
+-- | Handle an exception. Lift both normal and exceptional flows into the result
+-- flow
+catchE :: forall e es' es'' es a m.
+   ( Monad m
+   , e :< es
+   , LiftVariant (Remove e es) es'
+   , LiftVariant es'' es'
+   ) => (e -> Excepts es'' m a) -> Excepts es m a -> Excepts es' m a
+{-# INLINABLE catchE #-}
+catchE = catchLiftBoth
+
+-- | Handle an exception. Lift both normal and exceptional flows into the result
+-- flow
+catchLiftBoth :: forall e es' es'' es a m.
+   ( Monad m
+   , e :< es
+   , LiftVariant (Remove e es) es'
+   , LiftVariant es'' es'
+   ) => (e -> Excepts es'' m a) -> Excepts es m a -> Excepts es' m a
+{-# INLINABLE catchLiftBoth #-}
+catchLiftBoth h m = Excepts $ do
+   a <- runE m
+   case a of
+      VRight r -> return (VRight r)
+      VLeft  ls -> case popVariant ls of
+         Right l -> runE (liftE (h l))
+         Left rs -> return (VLeft (liftVariant rs))
+
+-- | Handle an exception. Assume it is in the first position
+catchRemove :: forall e es a m.
+   ( Monad m
+   ) => (e -> Excepts es m a) -> Excepts (e ': es) m a -> Excepts es m a
+{-# INLINABLE catchRemove #-}
+catchRemove h m = Excepts $ do
+   a <- runE m
+   case a of
+      VRight r -> return (VRight r)
+      VLeft  ls -> case popVariantHead ls of
+         Right l -> runE (h l)
+         Left rs -> return (VLeft rs)
+
+-- | Handle an exception. Lift the remaining errors into the resulting flow
+catchLiftLeft :: forall e es es' a m.
+   ( Monad m
+   , e :< es
+   , LiftVariant (Remove e es) es'
+   ) => (e -> Excepts es' m a) -> Excepts es m a -> Excepts es' m a
+{-# INLINABLE catchLiftLeft #-}
+catchLiftLeft h m = Excepts $ do
+   a <- runE m
+   case a of
+      VRight r -> return (VRight r)
+      VLeft  ls -> case popVariant ls of
+         Right l -> runE (h l)
+         Left rs -> return (VLeft (liftVariant rs))
+
+-- | Handle an exception. Lift the handler into the resulting flow
+catchLiftRight :: forall e es es' a m.
+   ( Monad m
+   , e :< es
+   , LiftVariant es' (Remove e es)
+   ) => (e -> Excepts es' m a) -> Excepts es m a -> Excepts (Remove e es) m a
+{-# INLINABLE catchLiftRight #-}
+catchLiftRight h m = Excepts $ do
+   a <- runE m
+   case a of
+      VRight r -> return (VRight r)
+      VLeft  ls -> case popVariant ls of
+         Right l -> runE (liftE (h l))
+         Left rs -> return (VLeft rs)
+
+-- | Do something in case of error
+catchAllE :: Monad m => (V es -> Excepts es' m a) -> Excepts es m a -> Excepts es' m a
+{-# INLINABLE catchAllE #-}
+catchAllE h m = Excepts $ do
+   a <- runE m
+   case a of
+      VRight x  -> return (VRight x)
+      VLeft xs  -> runE (h xs)
+
+-- | Evaluate a Excepts. Use the provided function to handle error cases.
+catchEvalE :: Monad m => (V es -> m a) -> Excepts es m a -> m a
+{-# INLINABLE catchEvalE #-}
+catchEvalE h m = do
+   a <- runE m
+   case a of
+      VRight x  -> return x
+      VLeft xs  -> h xs
+
+-- | Catch and die in case of error
+catchDieE :: (e :< es, Monad m) => (e -> m ()) -> Excepts es m a -> Excepts (Remove e es) m a
+{-# INLINABLE catchDieE #-}
+catchDieE h m = Excepts $ do
+   a <- runE m
+   case a of
+      VRight r -> return (VRight r)
+      VLeft  ls -> case popVariant ls of
+         Right l -> h l >> error "catchDieE"
+         Left rs -> return (VLeft rs)
+
+-- | Do something in case of error
+onE_ :: Monad m => m () -> Excepts es m a -> Excepts es m a
+{-# INLINABLE onE_ #-}
+onE_ h m = Excepts $ do
+   a <- runE m
+   case a of
+      VRight _ -> return a
+      VLeft _  -> h >> return a
+
+-- | Do something in case of error
+onE :: Monad m => (V es -> m ()) -> Excepts es m a -> Excepts es m a
+{-# INLINABLE onE #-}
+onE h m = Excepts $ do
+   a <- runE m
+   case a of
+      VRight _  -> return a
+      VLeft es  -> h es >> return a
+
+-- | Finally for Excepts
+finallyE :: Monad m => m () -> Excepts es m a -> Excepts es m a
+{-# INLINABLE finallyE #-}
+finallyE h m = Excepts $ do
+   a <- runE m
+   h
+   return a
+
+-- | Convert a Variant into a Excepts
+variantToExcepts :: Monad m => V (a ': es) -> Excepts es m a
+{-# INLINABLE variantToExcepts #-}
+variantToExcepts v = Excepts (return (veitherFromVariant v))
+
+-- | Convert a VEither into a Excepts
+veitherToExcepts :: Monad m => VEither es a -> Excepts es m a
+{-# INLINABLE veitherToExcepts #-}
+veitherToExcepts v = Excepts (return v)
+
+instance MonadInIO m => MonadInIO (Excepts es m) where
+   {-# INLINABLE liftWith #-}
+   liftWith wth f =
+      Excepts $ liftWith wth (\a -> runE (f a))
+
+   {-# INLINABLE liftWith2 #-}
+   liftWith2 wth f =
+      Excepts $ liftWith2 wth (\a b -> runE (f a b))
+
+-- | Product of the execution of two Excepts
+--
+-- You can use a generic monad combinator such as
+-- `Control.Concurrent.Async.concurrently` (in "async" package) to get
+-- concurrent execution.
+--
+-- >> concurrentE = runBothE concurrently
+runBothE ::
+   ( KnownNat (Length (b:e2))
+   , Monad m
+   ) => (forall x y. m x -> m y -> m (x,y)) -> Excepts e1 m a -> Excepts e2 m b -> Excepts (Tail (Product (a:e1) (b:e2))) m (a,b)
+runBothE exec f g = Excepts do
+   (v1,v2) <- exec (runE f) (runE g)
+   pure (veitherProduct v1 v2)
+
+-- | Product of the sequential execution of two Excepts
+sequenceE ::
+   ( KnownNat (Length (b:e2))
+   , Monad m
+   ) => Excepts e1 m a -> Excepts e2 m b -> Excepts (Tail (Product (a:e1) (b:e2))) m (a,b)
+sequenceE = runBothE exec
+   where
+      exec f g = do
+         v1 <- f
+         v2 <- g
+         pure (v1,v2)
diff --git a/src/lib/Haskus/Utils/Variant/Flow.hs b/src/lib/Haskus/Utils/Variant/Flow.hs
deleted file mode 100644
--- a/src/lib/Haskus/Utils/Variant/Flow.hs
+++ /dev/null
@@ -1,346 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Haskus.Utils.Variant.Flow
-   ( Flow
-   , runFlow
-   -- * FlowT
-   , FlowT
-   , runFlowT
-   , runFlowT_
-   , evalFlowT
-   , evalCatchFlowT
-   , injectFlowT
-   , mapFlowT
-   , liftFlowT
-   , variantToFlowT
-   , success
-   , failure
-   , throwE
-   , catchE
-   , catchLiftBoth
-   , catchLiftLeft
-   , catchLiftRight
-   , catchAllE
-   , catchDie
-   , catchDieAll
-   , catchRemove
-   , onFlowError_
-   , onFlowError
-   , finallyFlow
-   -- * Reexport
-   , module Haskus.Utils.Variant
-   )
-where
-
-import Haskus.Utils.Monad
-import Haskus.Utils.Variant
-import Data.Functor.Identity
-
-import Control.Monad.Catch
-
-------------------------------------------------------------------------------
--- Flow
-------------------------------------------------------------------------------
-type Flow es     = FlowT es Identity
-
-runFlow :: Flow es a -> V (a ': es)
-{-# INLINABLE runFlow #-}
-runFlow (FlowT m) = runIdentity m
-
-------------------------------------------------------------------------------
--- FlowT
-------------------------------------------------------------------------------
-newtype FlowT es m a = FlowT (m (V (a ': es)))
-
-deriving instance Show (m (V (a ': es))) => Show (FlowT es m a)
-
-runFlowT :: FlowT es m a -> m (V (a ': es))
-{-# INLINABLE runFlowT #-}
-runFlowT (FlowT m) = m
-
-runFlowT_ :: Functor m => FlowT es m a -> m ()
-{-# INLINABLE runFlowT_ #-}
-runFlowT_ m = void (runFlowT m)
-
-injectFlowT :: Monad m => FlowT es m a -> FlowT es m (V (a ': es))
-{-# INLINABLE injectFlowT #-}
-injectFlowT (FlowT m) = return =<< lift m
-
--- | Convert a flow without error into a value
-evalFlowT :: Monad m => FlowT '[] m a -> m a
-{-# INLINABLE evalFlowT #-}
-evalFlowT v = variantToValue <$> runFlowT v
-
-mapFlowT :: (m (V (a ': es)) -> n (V (b ': es'))) -> FlowT es m a -> FlowT es' n b
-{-# INLINABLE mapFlowT #-}
-mapFlowT f m = FlowT $ f (runFlowT m)
-
--- | Lift a FlowT into another
-liftFlowT :: (Monad m, LiftVariant es es') => FlowT es m a -> FlowT es' m a
-{-# INLINABLE liftFlowT #-}
-liftFlowT (FlowT m) = FlowT $ do
-   a <- m
-   return (mapVariantHeadTail id liftVariant a)
-
-instance Functor m => Functor (FlowT es m) where
-   {-# INLINABLE fmap #-}
-   fmap f = FlowT . fmap (mapVariantHeadTail f id) . runFlowT
-
-instance Foldable m => Foldable (FlowT es m) where
-   {-# INLINABLE foldMap #-}
-   foldMap f (FlowT m) = foldMap (variantHeadTail f (const mempty)) m
-
-instance Traversable m => Traversable (FlowT es m) where
-   {-# INLINABLE traverse #-}
-   traverse f (FlowT m) =
-      FlowT <$> traverse (variantHeadTail (fmap toVariantHead . f) (pure . toVariantTail)) m
-
-instance (Functor m, Monad m) => Applicative (FlowT es m) where
-    {-# INLINABLE pure #-}
-    pure a = FlowT $ return (toVariantHead a)
-
-    {-# INLINABLE (<*>) #-}
-    FlowT f <*> FlowT v = FlowT $ do
-        mf <- f
-        case popVariantHead mf of
-            Left es -> return (toVariantTail es)
-            Right k -> do
-                mv <- v
-                case popVariantHead mv of
-                    Left es -> return (toVariantTail es)
-                    Right x -> return (toVariantHead (k x))
-
-    {-# INLINABLE (*>) #-}
-    m *> k = m >>= \_ -> k
-
-instance (Monad m) => Monad (FlowT es m) where
-    {-# INLINABLE (>>=) #-}
-    m >>= k = FlowT $ do
-        a <- runFlowT m
-        case popVariantHead a of
-            Left es -> return (toVariantTail es)
-            Right x -> runFlowT (k x)
-
-    {-# INLINABLE fail #-}
-    fail = FlowT . fail
-
-instance MonadTrans (FlowT e) where
-    {-# INLINABLE lift #-}
-    lift = FlowT . liftM toVariantHead
-
-instance (MonadIO m) => MonadIO (FlowT es m) where
-    {-# INLINABLE liftIO #-}
-    liftIO = lift . liftIO
-
-
--- | Throws exceptions into the base monad.
-instance MonadThrow m => MonadThrow (FlowT e m) where
-   {-# INLINABLE throwM #-}
-   throwM = lift . throwM
-
--- | Catches exceptions from the base monad.
-instance MonadCatch m => MonadCatch (FlowT e m) where
-   catch (FlowT m) f = FlowT $ catch m (runFlowT . f)
-
-instance MonadMask m => MonadMask (FlowT e m) where
-   mask f = FlowT $ mask $ \u -> runFlowT $ f (q u)
-      where
-         q :: (m (V (a ': e)) -> m (V (a ': e))) -> FlowT e m a -> FlowT e m a
-         q u (FlowT b) = FlowT (u b)
-
-   uninterruptibleMask f = FlowT $ uninterruptibleMask $ \u -> runFlowT $ f (q u)
-      where
-         q :: (m (V (a ': e)) -> m (V (a ': e))) -> FlowT e m a -> FlowT e m a
-         q u (FlowT b) = FlowT (u b)
-
-   generalBracket acquire release use = FlowT $ do
-      (eb, ec) <- generalBracket
-         (runFlowT acquire)
-         (\eresource exitCase -> case popVariantHead eresource of
-            Left e -> return (toVariantTail e) -- nothing to release, acquire didn't succeed
-            Right resource -> case exitCase of
-               ExitCaseSuccess v
-                  | Just b <- fromVariantAt @0 v -> runFlowT (release resource (ExitCaseSuccess b))
-               ExitCaseException e               -> runFlowT (release resource (ExitCaseException e))
-               _                                 -> runFlowT (release resource ExitCaseAbort))
-         (variantHeadTail (runFlowT . use) (return . toVariantTail))
-      return $ runFlow $ do
-         -- The order in which we perform those two 'FlowT' effects determines
-         -- which error will win if they are both erroring. We want the error from
-         -- 'release' to win.
-         c <- FlowT (return ec)
-         b <- FlowT (return eb)
-         return (b, c)
-
-
-
--- | Success value
-success :: Monad m => a -> FlowT '[] m a
-success = pure
-
--- | Signal an exception value @e@.
-throwE :: (Monad m, e :< es) => e -> FlowT es m a
-{-# INLINABLE throwE #-}
-throwE = FlowT . return . toVariantTail . V
-
--- | Signal an exception value @e@.
-failure :: Monad m => e -> FlowT '[e] m a
-{-# INLINABLE failure #-}
-failure = throwE
-
--- | Handle an exception. Lift both normal and exceptional flows into the result
--- flow
-catchE :: forall e es' es'' es a m.
-   ( Monad m
-   , e :< es
-   , LiftVariant (Remove e es) es'
-   , LiftVariant es'' es'
-   ) =>
-    FlowT es m a -> (e -> FlowT es'' m a) -> FlowT es' m a
-{-# INLINABLE catchE #-}
-m `catchE` h = m `catchLiftBoth` h
-
--- | Handle an exception. Lift both normal and exceptional flows into the result
--- flow
-catchLiftBoth :: forall e es' es'' es a m.
-   ( Monad m
-   , e :< es
-   , LiftVariant (Remove e es) es'
-   , LiftVariant es'' es'
-   ) =>
-    FlowT es m a -> (e -> FlowT es'' m a) -> FlowT es' m a
-{-# INLINABLE catchLiftBoth #-}
-m `catchLiftBoth` h = FlowT $ do
-   a <- runFlowT m
-   case popVariantHead a of
-      Right r -> return (toVariantHead r)
-      Left  ls -> case popVariant ls of
-         Right l -> runFlowT (liftFlowT (h l))
-         Left rs -> return (toVariantTail (liftVariant rs))
-
--- | Handle an exception. Assume it is in the first position
-catchRemove :: forall e es a m.
-   ( Monad m
-   ) =>
-    FlowT (e ': es) m a -> (e -> FlowT es m a) -> FlowT es m a
-{-# INLINABLE catchRemove #-}
-m `catchRemove` h = FlowT $ do
-   a <- runFlowT m
-   case popVariantHead a of
-      Right r -> return (toVariantHead r)
-      Left  ls -> case popVariantHead ls of
-         Right l -> runFlowT (h l)
-         Left rs -> return (toVariantTail rs)
-
--- | Handle an exception. Lift the remaining errors into the resulting flow
-catchLiftLeft :: forall e es es' a m.
-   ( Monad m
-   , e :< es
-   , LiftVariant (Remove e es) es'
-   ) =>
-    FlowT es m a -> (e -> FlowT es' m a) -> FlowT es' m a
-{-# INLINABLE catchLiftLeft #-}
-m `catchLiftLeft` h = FlowT $ do
-   a <- runFlowT m
-   case popVariantHead a of
-      Right r -> return (toVariantHead r)
-      Left  ls -> case popVariant ls of
-         Right l -> runFlowT (h l)
-         Left rs -> return (toVariantTail (liftVariant rs))
-
--- | Handle an exception. Lift the handler into the resulting flow
-catchLiftRight :: forall e es es' a m.
-   ( Monad m
-   , e :< es
-   , LiftVariant es' (Remove e es)
-   ) =>
-    FlowT es m a -> (e -> FlowT es' m a) -> FlowT (Remove e es) m a
-{-# INLINABLE catchLiftRight #-}
-m `catchLiftRight` h = FlowT $ do
-   a <- runFlowT m
-   case popVariantHead a of
-      Right r -> return (toVariantHead r)
-      Left  ls -> case popVariant ls of
-         Right l -> runFlowT (liftFlowT (h l))
-         Left rs -> return (toVariantTail rs)
-
--- | Do something in case of error
-catchAllE :: Monad m => FlowT es m a -> (V es -> FlowT es' m a) -> FlowT es' m a
-{-# INLINABLE catchAllE #-}
-m `catchAllE` h = FlowT $ do
-   a <- runFlowT m
-   case popVariantAt @0 a of
-      Right x  -> return (toVariantHead x)
-      Left xs  -> runFlowT (h xs)
-
--- | Evaluate a FlowT. Use the provided function to handle error cases.
-evalCatchFlowT :: Monad m => (V es -> m a) -> FlowT es m a -> m a
-{-# INLINABLE evalCatchFlowT #-}
-evalCatchFlowT h m = do
-   a <- runFlowT m
-   case popVariantAt @0 a of
-      Right x  -> return x
-      Left xs  -> h xs
-
--- | Evaluate a FlowT. Use the provided function to handle error cases.
-catchDieAll :: Monad m => FlowT es m a -> (V es -> m a) -> m a
-{-# INLINABLE catchDieAll #-}
-catchDieAll m h = evalCatchFlowT h m
-
--- | Catch and die in case of error
-catchDie :: (e :< es, Monad m) => FlowT es m a -> (e -> m ()) -> FlowT (Remove e es) m a
-{-# INLINABLE catchDie #-}
-m `catchDie` h = FlowT $ do
-   a <- runFlowT m
-   case popVariantHead a of
-      Right r -> return (toVariantHead r)
-      Left  ls -> case popVariant ls of
-         Right l -> h l >> error "catchDie"
-         Left rs -> return (toVariantTail rs)
-
--- | Do something in case of error
-onFlowError_ :: Monad m => FlowT es m a -> m () -> FlowT es m a
-{-# INLINABLE onFlowError_ #-}
-m `onFlowError_` h = FlowT $ do
-   a <- runFlowT m
-   case fromVariantHead a of
-      Just _  -> return a
-      Nothing -> h >> return a
-
--- | Do something in case of error
-onFlowError :: Monad m => FlowT es m a -> (V es -> m ()) -> FlowT es m a
-{-# INLINABLE onFlowError #-}
-m `onFlowError` h = FlowT $ do
-   a <- runFlowT m
-   case popVariantHead a of
-      Right _  -> return a
-      Left es  -> h es >> return a
-
--- | Finally for FlowT
-finallyFlow :: Monad m => FlowT es m a -> m () -> FlowT es m a
-{-# INLINABLE finallyFlow #-}
-m `finallyFlow` h = FlowT $ do
-   a <- runFlowT m
-   h
-   return a
-
--- | Convert a Variant into a FlowT
-variantToFlowT :: Monad m => V (a ': es) -> FlowT es m a
-variantToFlowT v = FlowT (return v)
-
-instance MonadInIO m => MonadInIO (FlowT es m) where
-   {-# INLINABLE liftWith #-}
-   liftWith wth f =
-      FlowT $ liftWith wth (\a -> runFlowT (f a))
-
-   {-# INLINABLE liftWith2 #-}
-   liftWith2 wth f =
-      FlowT $ liftWith2 wth (\a b -> runFlowT (f a b))
diff --git a/src/lib/Haskus/Utils/Variant/OldFlow.hs b/src/lib/Haskus/Utils/Variant/OldFlow.hs
deleted file mode 100644
--- a/src/lib/Haskus/Utils/Variant/OldFlow.hs
+++ /dev/null
@@ -1,1984 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE FlexibleInstances #-}
-
--- | Variant based control-flow (deprecated)
-module Haskus.Utils.Variant.OldFlow
-   ( Flow
-   , IOV
-   -- * Flow utils
-   , flowRes
-   , flowSingle
-   , flowSetN
-   , flowSet
-   , flowLift
-   , flowToCont
-   , flowTraverse
-   , flowFor
-   , flowTraverseFilter
-   , flowForFilter
-   , LiftVariant
-   , (:<)
-   , (:<?)
-   -- * Functor, applicative equivalents
-   , (<$<)
-   , (<*<)
-   , (<|<)
-   -- * Named operators
-   , flowMap
-   , flowBind
-   , flowBind'
-   , flowMatch
-   , flowMatchFail
-   -- * Operation on first element
-   , (.~.>)
-   , (>.~.>)
-   , (.~+>)
-   , (>.~+>)
-   , (.~^^>)
-   , (>.~^^>)
-   , (.~^>)
-   , (>.~^>)
-   , (.~$>)
-   , (>.~$>)
-   , (.~|>)
-   , (>.~|>)
-   , (.~=>)
-   , (>.~=>)
-   , (.~!>)
-   , (>.~!>)
-   , (.~!!>)
-   , (>.~!!>)
-   -- ** Pure
-   , (.-.>)
-   , (>.-.>)
-   , (<.-.)
-   , (<.-.<)
-   -- ** Const
-   , (.~~.>)
-   , (>.~~.>)
-   , (.~~+>)
-   , (>.~~+>)
-   , (.~~^^>)
-   , (>.~~^^>)
-   , (.~~^>)
-   , (>.~~^>)
-   , (.~~$>)
-   , (>.~~$>)
-   , (.~~|>)
-   , (>.~~|>)
-   , (.~~=>)
-   , (>.~~=>)
-   , (.~~!>)
-   , (>.~~!>)
-   -- * Operation on tail
-   , (..~.>)
-   , (>..~.>)
-   , (..-.>)
-   , (>..-.>)
-   , (..-..>)
-   , (>..-..>)
-   , (..~..>)
-   , (>..~..>)
-   , (..~^^>)
-   , (>..~^^>)
-   , (..~^>)
-   , (>..~^>)
-   , (..~=>)
-   , (>..~=>)
-   , (..~!>)
-   , (>..~!>)
-   , (..~!!>)
-   , (>..~!!>)
-   -- * Operation on caught element in tail
-   , (..%~^>)
-   , (>..%~^>)
-   , (..%~^^>)
-   , (>..%~^^>)
-   , (..%~$>)
-   , (>..%~$>)
-   , (..%~!!>)
-   , (>..%~!!>)
-   , (..%~!>)
-   , (>..%~!>)
-   , (..?~^>)
-   , (>..?~^>)
-   , (..?~^^>)
-   , (>..?~^^>)
-   , (..?~$>)
-   , (>..?~$>)
-   , (..?~!!>)
-   , (>..?~!!>)
-   , (..?~!>)
-   , (>..?~!>)
-   -- * Operation on caught element
-   , (%~.>)
-   , (>%~.>)
-   , (%~+>)
-   , (>%~+>)
-   , (%~^^>)
-   , (>%~^^>)
-   , (%~^>)
-   , (>%~^>)
-   , (%~$>)
-   , (>%~$>)
-   , (%~|>)
-   , (>%~|>)
-   , (%~=>)
-   , (>%~=>)
-   , (%~!>)
-   , (>%~!>)
-   , (%~!!>)
-   , (>%~!!>)
-   , (?~.>)
-   , (>?~.>)
-   , (?~+>)
-   , (>?~+>)
-   , (?~^^>)
-   , (>?~^^>)
-   , (?~^>)
-   , (>?~^>)
-   , (?~$>)
-   , (>?~$>)
-   , (?~|>)
-   , (>?~|>)
-   , (?~=>)
-   , (>?~=>)
-   , (?~!>)
-   , (>?~!>)
-   , (?~!!>)
-   , (>?~!!>)
-   -- * Operation on every element
-   , (-||)
-   , (-||>)
-   , (>-||>)
-   , (~||)
-   , (~||>)
-   , (>~||>)
-   , LiftCont (..)
-   , ExtractRHS
-   , ReplaceRHS
-   , LiftContTuple
-   , ContVariant (..)
-   -- * Helpers
-   , makeFlowOp
-   , makeFlowOpM
-   , selectTail
-   , selectFirst
-   , selectType
-   , applyConst
-   , applyPure
-   , applyM
-   , applyF
-   , combineFirst
-   , combineSameTail
-   , combineEither
-   , combineConcat
-   , combineUnion
-   , combineLiftUnselected
-   , combineLiftBoth
-   , combineSingle
-   , liftV
-   , liftF
-   )
-where
-
-import Haskus.Utils.Variant
-import Haskus.Utils.Types
-import Haskus.Utils.ContFlow
-import Haskus.Utils.Tuple
-
--- | Control-flow
-type Flow m (l :: [*]) = m (V l)
-
-type IOV l = Flow IO l
-
-----------------------------------------------------------
--- Flow utils
-----------------------------------------------------------
-
--- | Return in the first element
-flowSetN :: forall (n :: Nat) xs m.
-   ( Monad m
-   , KnownNat n
-   ) => Index n xs -> Flow m xs
-{-# INLINABLE flowSetN #-}
-flowSetN = return . toVariantAt @n
-
--- | Return in the first well-typed element
-flowSet :: (x :< xs, Monad m) => x -> Flow m xs
-{-# INLINABLE flowSet #-}
-flowSet = return . toVariant
-
--- | Return a single element
-flowSingle :: Monad m => x -> Flow m '[x]
-{-# INLINABLE flowSingle #-}
-flowSingle = flowSetN @0
-
--- | Lift a flow into another
-flowLift :: (LiftVariant xs ys , Monad m) => Flow m xs -> Flow m ys
-{-# INLINABLE flowLift #-}
-flowLift = fmap liftVariant
-
--- | Lift a flow into a ContFlow
-flowToCont :: (ContVariant xs, Monad m) => Flow m xs -> ContFlow xs (m r)
-flowToCont = variantToContM
-
--- | Traverse a list and stop on first error
-flowTraverse :: forall m a b xs.
-   ( Monad m
-   ) => (a -> Flow m (b ': xs)) -> [a] -> Flow m ([b] ': xs)
-flowTraverse f = go (flowSetN @0 [])
-   where
-      go :: Flow m ([b] ': xs) -> [a] -> Flow m ([b] ': xs)
-      go rs []     = rs >.-.> reverse
-      go rs (a:as) = go rs' as
-         where
-            -- execute (f a) if previous execution succedded.
-            -- prepend the result to the list
-            rs' = rs >.~$> \bs -> (f a >.-.> (:bs))
-
--- | Traverse a list and stop on first error
-flowFor :: forall m a b xs.
-   ( Monad m
-   ) => [a] -> (a -> Flow m (b ': xs)) -> Flow m ([b] ': xs)
-flowFor = flip flowTraverse
-
--- | Traverse a list and return only valid values
-flowTraverseFilter :: forall m a b xs.
-   ( Monad m
-   ) => (a -> Flow m (b ': xs)) -> [a] -> m [b]
-flowTraverseFilter f = go
-   where
-      go :: [a] -> m [b]
-      go []     = return []
-      go (a:as) = do
-         f a >.~.> (\b -> (b:) <$> go as)
-             >..~.> const (go as)
-
--- | Traverse a list and return only valid values
-flowForFilter :: forall m a b xs.
-   ( Monad m
-   ) => [a] -> (a -> Flow m (b ': xs)) -> m [b]
-flowForFilter = flip flowTraverseFilter
-
-
--- | Extract single flow result
-flowRes :: Functor m => Flow m '[x] -> m x
-{-# INLINABLE flowRes #-}
-flowRes = fmap variantToValue
-
-
--- | Lift an operation on a Variant into an operation on a flow
-liftm :: Monad m => (V x -> a -> m b) -> Flow m x -> a -> m b
-{-# INLINABLE liftm #-}
-liftm op x a = do
-   x' <- x
-   op x' a
-
-----------------------------------------------------------
--- Named operators
-----------------------------------------------------------
-
--- | Map a pure function onto the correct value in the flow
-flowMap :: Monad m => Flow m (x ': xs) -> (x -> y) -> Flow m (y ': xs)
-{-# INLINABLE flowMap #-}
-flowMap = (>.-.>)
-
--- | Bind two flows in a monadish way (error types union)
-flowBind :: forall xs ys zs m x.
-   ( LiftVariant xs zs
-   , LiftVariant ys zs
-   , zs ~ Union xs ys
-   , Monad m
-   ) => Flow m (x ': ys) -> (x -> Flow m xs) -> Flow m zs
-{-# INLINABLE flowBind #-}
-flowBind = (>.~|>)
-
--- | Bind two flows in a monadic way (constant error types)
-flowBind' :: Monad m => Flow m (x ': xs) -> (x -> Flow m (y ': xs)) -> Flow m (y ': xs)
-{-# INLINABLE flowBind' #-}
-flowBind' = (>.~$>)
-
--- | Match a value in a flow
-flowMatch :: forall x xs zs m.
-   ( Monad m
-   , x :< xs
-   , LiftVariant (Remove x xs) zs
-   ) => Flow m xs -> (x -> Flow m zs) -> Flow m zs
-{-# INLINABLE flowMatch #-}
-flowMatch = (>%~^>)
-
--- | Match a value in a flow and use a non-returning failure in this case
-flowMatchFail :: forall x xs m.
-   ( Monad m
-   , x :< xs
-   ) => Flow m xs -> (x -> m ()) -> Flow m (Remove x xs)
-{-# INLINABLE flowMatchFail #-}
-flowMatchFail = (>%~!!>)
-
-----------------------------------------------------------
--- First element operations
-----------------------------------------------------------
-
--- | Extract the first value, set the first value
-(.~.>) :: forall m l x a.
-   ( Monad m )
-   => V (a ': l) -> (a -> m x) -> Flow m (x ': l)
-{-# INLINABLE (.~.>) #-}
-(.~.>) v f = makeFlowOp selectFirst (applyM f) combineFirst v
-
-infixl 0 .~.>
-
--- | Extract the first value, set the first value
-(>.~.>) :: forall m l x a.
-   ( Monad m )
-   => Flow m (a ': l) -> (a -> m x) -> Flow m (x ': l)
-{-# INLINABLE (>.~.>) #-}
-(>.~.>) = liftm (.~.>)
-
-infixl 0 >.~.>
-
--- | Extract the first value, concat the result
-(.~+>) :: forall (k :: Nat) m l l2 a.
-   ( KnownNat k
-   , k ~ Length l2
-   , Monad m )
-   => V (a ': l) -> (a -> Flow m l2) -> Flow m (Concat l2 l)
-{-# INLINABLE (.~+>) #-}
-(.~+>) v f = makeFlowOp selectFirst (applyF f) combineConcat v
-
-infixl 0 .~+>
-
--- | Extract the first value, concat the results
-(>.~+>) :: forall (k :: Nat) m l l2 a.
-   ( KnownNat k
-   , k ~ Length l2
-   , Monad m )
-   => Flow m (a ': l) -> (a -> Flow m l2) -> Flow m (Concat l2 l)
-{-# INLINABLE (>.~+>) #-}
-(>.~+>) = liftm (.~+>)
-
-infixl 0 >.~+>
-
--- | Extract the first value, lift both
-(.~^^>) :: forall m a xs ys zs.
-   ( Monad m
-   , LiftVariant xs zs
-   , LiftVariant ys zs
-   ) => V (a ': ys) -> (a -> Flow m xs) -> Flow m zs
-{-# INLINABLE (.~^^>) #-}
-(.~^^>) v f = makeFlowOp selectFirst (applyF f) combineLiftBoth v
-
-infixl 0 .~^^>
-
-
--- | Extract the first value, lift both
-(>.~^^>) :: forall m a xs ys zs.
-   ( Monad m
-   , LiftVariant xs zs
-   , LiftVariant ys zs
-   ) => Flow m (a ': ys) -> (a -> Flow m xs) -> Flow m zs
-{-# INLINABLE (>.~^^>) #-}
-(>.~^^>) = liftm (.~^^>)
-
-infixl 0 >.~^^>
-
--- | Extract the first value, lift unselected
-(.~^>) :: forall m a ys zs.
-   ( Monad m
-   , LiftVariant ys zs
-   ) => V (a ': ys) -> (a -> Flow m zs) -> Flow m zs
-{-# INLINABLE (.~^>) #-}
-(.~^>) v f = makeFlowOp selectFirst (applyF f) combineLiftUnselected v
-
-infixl 0 .~^>
-
--- | Extract the first value, lift unselected
-(>.~^>) :: forall m a ys zs.
-   ( Monad m
-   , LiftVariant ys zs
-   ) => Flow m (a ': ys) -> (a -> Flow m zs) -> Flow m zs
-{-# INLINABLE (>.~^>) #-}
-(>.~^>) = liftm (.~^>)
-
-infixl 0 >.~^>
-
--- | Extract the first value, use the same tail
-(.~$>) :: forall m x xs a.
-   ( Monad m
-   ) => V (a ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs)
-{-# INLINABLE (.~$>) #-}
-(.~$>) v f = makeFlowOp selectFirst (applyF f) combineSameTail v
-
-infixl 0 .~$>
-
--- | Extract the first value, use the same tail
-(>.~$>) :: forall m x xs a.
-   ( Monad m
-   ) => Flow m (a ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs)
-{-# INLINABLE (>.~$>) #-}
-(>.~$>) = liftm (.~$>)
-
-infixl 0 >.~$>
-
--- | Take the first output, union the result
-(.~|>) ::
-   ( LiftVariant xs zs
-   , LiftVariant ys zs
-   , zs ~ Union xs ys
-   , Monad m
-   ) => V (a ': ys) -> (a -> Flow m xs) -> Flow m zs
-{-# INLINABLE (.~|>) #-}
-(.~|>) v f = makeFlowOp selectFirst (applyF f) combineUnion v
-
-infixl 0 .~|>
-
--- | Take the first output, fusion the result
-(>.~|>) ::
-   ( LiftVariant xs zs
-   , LiftVariant ys zs
-   , zs ~ Union xs ys
-   , Monad m
-   ) => Flow m (a ': ys) -> (a -> Flow m xs) -> Flow m zs
-{-# INLINABLE (>.~|>) #-}
-(>.~|>) = liftm (.~|>)
-
-infixl 0 >.~|>
-
--- | Extract the first value and perform effect. Passthrough the input value
-(.~=>) ::
-   ( Monad m
-   ) => V (a ': l) -> (a -> m ()) -> Flow m (a ': l)
-{-# INLINABLE (.~=>) #-}
-(.~=>) v f = case popVariantHead v of
-   Right u -> f u >> return v
-   Left  _ -> return v
-
-infixl 0 .~=>
-
--- | Extract the first value and perform effect. Passthrough the input value
-(>.~=>) ::
-   ( Monad m
-   ) => Flow m (a ': l) -> (a -> m ()) -> Flow m (a ': l)
-{-# INLINABLE (>.~=>) #-}
-(>.~=>) = liftm (.~=>)
-
-infixl 0 >.~=>
-
--- | Extract the first value and perform effect.
-(.~!>) ::
-   ( Monad m
-   ) => V (a ': l) -> (a -> m ()) -> m ()
-{-# INLINABLE (.~!>) #-}
-(.~!>) v f = case popVariantHead v of
-   Right u -> f u
-   Left  _ -> return ()
-
-infixl 0 .~!>
-
--- | Extract the first value and perform effect.
-(>.~!>) ::
-   ( Monad m
-   ) => Flow m (a ': l) -> (a -> m ()) -> m ()
-{-# INLINABLE (>.~!>) #-}
-(>.~!>) = liftm (.~!>)
-
-infixl 0 >.~!>
-
--- | Extract the first value and perform effect.
-(.~!!>) ::
-   ( Monad m
-   ) => V (a ': l) -> (a -> m ()) -> m (V l)
-{-# INLINABLE (.~!!>) #-}
-(.~!!>) v f = case popVariantHead v of
-   Right u -> f u >> error ".~!!> error"
-   Left  l -> return l
-
-infixl 0 .~!!>
-
--- | Extract the first value and perform effect.
-(>.~!!>) ::
-   ( Monad m
-   ) => Flow m (a ': l) -> (a -> m ()) -> m (V l)
-{-# INLINABLE (>.~!!>) #-}
-(>.~!!>) = liftm (.~!!>)
-
-infixl 0 >.~!!>
-
-----------------------------------------------------------
--- First element, pure variant
-----------------------------------------------------------
-
--- | Extract the first value, set the first value
-(.-.>) :: forall m l x a.
-   ( Monad m )
-   => V (a ': l) -> (a -> x) -> Flow m (x ': l)
-{-# INLINABLE (.-.>) #-}
-(.-.>) v f = makeFlowOp selectFirst (applyPure (liftV f)) combineFirst v
-
-infixl 0 .-.>
-
--- | Extract the first value, set the first value
-(>.-.>) :: forall m l x a.
-   ( Monad m )
-   => Flow m (a ': l) -> (a -> x) -> Flow m (x ': l)
-{-# INLINABLE (>.-.>) #-}
-(>.-.>) = liftm (.-.>)
-
-infixl 0 >.-.>
-
--- | Extract the first value, set the first value
-(<.-.) :: forall m l x a.
-   ( Monad m )
-   => (a -> x) -> V (a ': l) -> Flow m (x ': l)
-{-# INLINABLE (<.-.) #-}
-(<.-.) = flip (.-.>)
-
-infixr 0 <.-.
-
--- | Extract the first value, set the first value
-(<.-.<) :: forall m l x a.
-   ( Monad m )
-   => (a -> x) -> Flow m (a ': l) -> Flow m (x ': l)
-{-# INLINABLE (<.-.<) #-}
-(<.-.<) = flip (>.-.>)
-
-infixr 0 <.-.<
-
-----------------------------------------------------------
--- Functor, applicative
-----------------------------------------------------------
-
--- | Functor <$> equivalent
-(<$<) :: forall m l a b.
-   ( Monad m )
-   => (a -> b) -> Flow m (a ': l) -> Flow m (b ': l)
-{-# INLINABLE (<$<) #-}
-(<$<) = (<.-.<)
-
-infixl 4 <$<
-
--- | Applicative <*> equivalent
-(<*<) :: forall m l a b.
-   ( Monad m )
-   => Flow m ((a -> b) ': l) -> Flow m (a ': l) -> Flow m (b ': l)
-{-# INLINABLE (<*<) #-}
-(<*<) mf mg = mf >.~$> (mg >.-.>)
-
-infixl 4 <*<
-
--- | Applicative <*> equivalent, with error union
-(<|<) :: forall m xs ys zs y z.
-   ( Monad m
-   , LiftVariant xs zs
-   , LiftVariant ys zs
-   , zs ~ Union xs ys
-   ) => Flow m ((y -> z) ': xs) -> Flow m (y ': ys) -> Flow m (z ': zs)
-{-# INLINABLE (<|<) #-}
-(<|<) mf mg = 
-   mf >..-..> liftVariant
-      >.~$> (\f -> mg >..-..> liftVariant
-                      >.-.> f
-            )
-
-infixl 4 <|<
-
-----------------------------------------------------------
--- First element, const variant
-----------------------------------------------------------
-
--- | Extract the first value, set the first value
-(.~~.>) :: forall m l x a.
-   ( Monad m )
-   => V (a ': l) -> m x -> Flow m (x ': l)
-{-# INLINABLE (.~~.>) #-}
-(.~~.>) v f = v .~.> const f
-
-infixl 0 .~~.>
-
--- | Extract the first value, set the first value
-(>.~~.>) :: forall m l x a.
-   ( Monad m )
-   => Flow m (a ': l) -> m x -> Flow m (x ': l)
-{-# INLINABLE (>.~~.>) #-}
-(>.~~.>) = liftm (.~~.>)
-
-infixl 0 >.~~.>
-
--- | Extract the first value, concat the result
-(.~~+>) :: forall (k :: Nat) m l l2 a.
-   ( KnownNat k
-   , k ~ Length l2
-   , Monad m )
-   => V (a ': l) -> Flow m l2 -> Flow m (Concat l2 l)
-{-# INLINABLE (.~~+>) #-}
-(.~~+>) v f = v .~+> const f
-
-infixl 0 .~~+>
-
--- | Extract the first value, concat the results
-(>.~~+>) :: forall (k :: Nat) m l l2 a.
-   ( KnownNat k
-   , k ~ Length l2
-   , Monad m )
-   => Flow m (a ': l) -> Flow m l2 -> Flow m (Concat l2 l)
-{-# INLINABLE (>.~~+>) #-}
-(>.~~+>) = liftm (.~~+>)
-
-infixl 0 >.~~+>
-
--- | Extract the first value, lift the result
-(.~~^^>) :: forall m a xs ys zs.
-   ( Monad m
-   , LiftVariant xs zs
-   , LiftVariant ys zs
-   ) => V (a ': ys) -> Flow m xs -> Flow m zs
-{-# INLINABLE (.~~^^>) #-}
-(.~~^^>) v f = v .~^^> const f
-
-infixl 0 .~~^^>
-
-
--- | Extract the first value, lift the result
-(>.~~^^>) :: forall m a xs ys zs.
-   ( Monad m
-   , LiftVariant xs zs
-   , LiftVariant ys zs
-   ) => Flow m (a ': ys) -> Flow m xs -> Flow m zs
-{-# INLINABLE (>.~~^^>) #-}
-(>.~~^^>) = liftm (.~~^^>)
-
-infixl 0 >.~~^^>
-
--- | Extract the first value, connect to the expected output
-(.~~^>) :: forall m a ys zs.
-   ( Monad m
-   , LiftVariant ys zs
-   ) => V (a ': ys) -> Flow m zs -> Flow m zs
-{-# INLINABLE (.~~^>) #-}
-(.~~^>) v f = v .~^> const f
-
-infixl 0 .~~^>
-
--- | Extract the first value, connect to the expected output
-(>.~~^>) :: forall m a ys zs.
-   ( Monad m
-   , LiftVariant ys zs
-   ) => Flow m (a ': ys) -> Flow m zs -> Flow m zs
-{-# INLINABLE (>.~~^>) #-}
-(>.~~^>) = liftm (.~~^>)
-
-infixl 0 >.~~^>
-
--- | Extract the first value, use the same output type
-(.~~$>) :: forall m x xs a.
-   ( Monad m
-   ) => V (a ': xs) -> Flow m (x ': xs) -> Flow m (x ': xs)
-{-# INLINABLE (.~~$>) #-}
-(.~~$>) v f = v .~$> const f
-
-infixl 0 .~~$>
-
--- | Extract the first value, use the same output type
-(>.~~$>) :: forall m x xs a.
-   ( Monad m
-   ) => Flow m (a ': xs) -> Flow m (x ': xs) -> Flow m (x ': xs)
-{-# INLINABLE (>.~~$>) #-}
-(>.~~$>) = liftm (.~~$>)
-
-infixl 0 >.~~$>
-
--- | Take the first output, fusion the result
-(.~~|>) ::
-   ( LiftVariant xs zs
-   , LiftVariant ys zs
-   , zs ~ Union xs ys
-   , Monad m
-   ) => V (a ': ys) -> Flow m xs -> Flow m zs
-{-# INLINABLE (.~~|>) #-}
-(.~~|>) v f = v .~|> const f
-
-infixl 0 .~~|>
-
--- | Take the first output, fusion the result
-(>.~~|>) ::
-   ( LiftVariant xs zs
-   , LiftVariant ys zs
-   , zs ~ Union xs ys
-   , Monad m
-   ) => Flow m (a ': ys) -> Flow m xs -> Flow m zs
-{-# INLINABLE (>.~~|>) #-}
-(>.~~|>) = liftm (.~~|>)
-
-infixl 0 >.~~|>
-
--- | Extract the first value and perform effect. Passthrough the input value
-(.~~=>) ::
-   ( Monad m
-   ) => V (a ': l) -> m () -> Flow m (a ': l)
-{-# INLINABLE (.~~=>) #-}
-(.~~=>) v f = v .~=> const f
-
-infixl 0 .~~=>
-
--- | Extract the first value and perform effect. Passthrough the input value
-(>.~~=>) ::
-   ( Monad m
-   ) => Flow m (a ': l) -> m () -> Flow m (a ': l)
-{-# INLINABLE (>.~~=>) #-}
-(>.~~=>) = liftm (.~~=>)
-
-infixl 0 >.~~=>
-
--- | Extract the first value and perform effect.
-(.~~!>) ::
-   ( Monad m
-   ) => V (a ': l) -> m () -> m ()
-{-# INLINABLE (.~~!>) #-}
-(.~~!>) v f = v .~!> const f
-
-infixl 0 .~~!>
-
--- | Extract the first value and perform effect.
-(>.~~!>) ::
-   ( Monad m
-   ) => Flow m (a ': l) -> m () -> m ()
-{-# INLINABLE (>.~~!>) #-}
-(>.~~!>) = liftm (.~~!>)
-
-infixl 0 >.~~!>
-
-
-----------------------------------------------------------
--- Tail operations
-----------------------------------------------------------
-
--- | Extract the tail, set the first value
-(..~.>) ::
-   ( Monad m
-   ) => V (a ': l) -> (V l -> m a) -> m a
-{-# INLINABLE (..~.>) #-}
-(..~.>) v f = makeFlowOp selectTail (applyVM f) combineSingle v
-
-infixl 0 ..~.>
-
--- | Extract the tail, set the first value
-(>..~.>) ::
-   ( Monad m
-   ) => Flow m (a ': l) -> (V l -> m a) -> m a
-{-# INLINABLE (>..~.>) #-}
-(>..~.>) = liftm (..~.>)
-
-infixl 0 >..~.>
-
--- | Extract the tail, set the first value (pure function)
-(..-.>) ::
-   ( Monad m
-   ) => V (a ': l) -> (V l -> a) -> m a
-{-# INLINABLE (..-.>) #-}
-(..-.>) v f = case popVariantHead v of
-   Right u -> return u
-   Left  l -> return (f l)
-
-infixl 0 ..-.>
-
--- | Extract the tail, set the first value (pure function)
-(>..-.>) ::
-   ( Monad m
-   ) => Flow m (a ': l) -> (V l -> a) -> m a
-{-# INLINABLE (>..-.>) #-}
-(>..-.>) = liftm (..-.>)
-
-infixl 0 >..-.>
-
--- | Extract the tail, set the tail
-(..-..>) :: forall a l xs m.
-   ( Monad m
-   ) => V (a ': l) -> (V l -> V xs) -> Flow m (a ': xs)
-{-# INLINABLE (..-..>) #-}
-(..-..>) v f = case popVariantHead v of
-   Right u -> flowSetN @0 u
-   Left  l -> return (prependVariant @'[a] (f l))
-
-infixl 0 ..-..>
-
--- | Extract the tail, set the tail
-(>..-..>) ::
-   ( Monad m
-   ) => Flow m (a ': l) -> (V l -> V xs) -> Flow m (a ': xs)
-{-# INLINABLE (>..-..>) #-}
-(>..-..>) = liftm (..-..>)
-
-infixl 0 >..-..>
-
--- | Extract the tail, set the tail
-(..~..>) :: forall a l xs m.
-   ( Monad m
-   ) => V (a ': l) -> (V l -> Flow m xs) -> Flow m (a ': xs)
-{-# INLINABLE (..~..>) #-}
-(..~..>) v f = case popVariantHead v of
-   Right u -> flowSetN @0 u
-   Left  l -> prependVariant @'[a] <$> f l
-
-infixl 0 ..~..>
-
--- | Extract the tail, set the tail
-(>..~..>) ::
-   ( Monad m
-   ) => Flow m (a ': l) -> (V l -> Flow m xs) -> Flow m (a ': xs)
-{-# INLINABLE (>..~..>) #-}
-(>..~..>) = liftm (..~..>)
-
-infixl 0 >..~..>
-
--- | Extract the tail, lift the result
-(..~^^>) ::
-   ( Monad m
-   , LiftVariant xs (a ': zs)
-   ) => V (a ': l) -> (V l -> Flow m xs) -> Flow m (a ': zs)
-{-# INLINABLE (..~^^>) #-}
-(..~^^>) v f = case popVariantHead v of
-   Right u -> flowSetN @0 u
-   Left  l -> liftVariant <$> f l
-
-infixl 0 ..~^^>
-
--- | Extract the tail, lift the result
-(>..~^^>) ::
-   ( Monad m
-   , LiftVariant xs (a ': zs)
-   ) => Flow m  (a ': l) -> (V l -> Flow m xs) -> Flow m (a ': zs)
-{-# INLINABLE (>..~^^>) #-}
-(>..~^^>) = liftm (..~^^>)
-
-infixl 0 >..~^^>
-
--- | Extract the tail, connect the result
-(..~^>) ::
-   ( Monad m
-   , a :< zs
-   ) => V (a ': l) -> (V l -> Flow m zs) -> Flow m zs
-{-# INLINABLE (..~^>) #-}
-(..~^>) v f = case popVariantHead v of
-   Right u -> flowSet u
-   Left  l -> f l
-
-infixl 0 ..~^>
-
--- | Extract the tail, connect the result
-(>..~^>) ::
-   ( Monad m
-   , a :< zs
-   ) => Flow m (a ': l) -> (V l -> Flow m zs) -> Flow m zs
-{-# INLINABLE (>..~^>) #-}
-(>..~^>) = liftm (..~^>)
-
-infixl 0 >..~^>
-
--- | Match in the tail, connect to the expected result
-(..?~^>) ::
-   ( Monad m
-   , a :<? xs
-   , LiftVariant (Remove a xs) ys
-   ) => V (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys)
-{-# INLINABLE (..?~^>) #-}
-(..?~^>) v f = v ..~..> (\v' -> v' ?~^> f)
-
-infixl 0 ..?~^>
-
--- | Match in the tail, connect to the expected result
-(>..?~^>) ::
-   ( Monad m
-   , a :<? xs
-   , LiftVariant (Remove a xs) ys
-   ) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys)
-{-# INLINABLE (>..?~^>) #-}
-(>..?~^>) = liftm (..?~^>)
-
-infixl 0 >..?~^>
-
--- | Match in the tail, connect to the expected result
-(..%~^>) ::
-   ( Monad m
-   , a :< xs
-   , LiftVariant (Remove a xs) ys
-   ) => V (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys)
-{-# INLINABLE (..%~^>) #-}
-(..%~^>) v f = v ..~..> (\v' -> v' %~^> f)
-
-infixl 0 ..%~^>
-
--- | Match in the tail, connect to the expected result
-(>..%~^>) ::
-   ( Monad m
-   , a :< xs
-   , LiftVariant (Remove a xs) ys
-   ) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys)
-{-# INLINABLE (>..%~^>) #-}
-(>..%~^>) = liftm (..%~^>)
-
-infixl 0 >..%~^>
-
--- | Match in the tail, lift to the expected result
-(..?~^^>) ::
-   ( Monad m
-   , a :<? xs
-   , LiftVariant (Remove a xs) zs
-   , LiftVariant ys zs
-   ) => V (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs)
-{-# INLINABLE (..?~^^>) #-}
-(..?~^^>) v f = v ..~..> (\v' -> v' ?~^^> f)
-
-infixl 0 ..?~^^>
-
--- | Match in the tail, lift to the expected result
-(>..?~^^>) ::
-   ( Monad m
-   , a :<? xs
-   , LiftVariant (Remove a xs) zs
-   , LiftVariant ys zs
-   ) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs)
-{-# INLINABLE (>..?~^^>) #-}
-(>..?~^^>) = liftm (..?~^^>)
-
-infixl 0 >..?~^^>
-
--- | Match in the tail, lift to the expected result
-(..%~^^>) ::
-   ( Monad m
-   , a :< xs
-   , LiftVariant (Remove a xs) zs
-   , LiftVariant ys zs
-   ) => V (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs)
-{-# INLINABLE (..%~^^>) #-}
-(..%~^^>) v f = v ..~..> (\v' -> v' %~^^> f)
-
-infixl 0 ..%~^^>
-
--- | Match in the tail, lift to the expected result
-(>..%~^^>) ::
-   ( Monad m
-   , a :< xs
-   , LiftVariant (Remove a xs) zs
-   , LiftVariant ys zs
-   ) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs)
-{-# INLINABLE (>..%~^^>) #-}
-(>..%~^^>) = liftm (..%~^^>)
-
-infixl 0 >..%~^^>
-
--- | Match in the tail, keep the same types
-(..?~$>) ::
-   ( Monad m
-   , a :<? xs
-   , LiftVariant (Remove a xs) (x ': xs)
-   ) => V (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs)
-{-# INLINABLE (..?~$>) #-}
-(..?~$>) v f = case popVariantHead v of
-   Right _ -> return v
-   Left xs -> xs ?~^> f
-
-infixl 0 ..?~$>
-
--- | Match in the tail, keep the same types
-(>..?~$>) ::
-   ( Monad m
-   , a :<? xs
-   , LiftVariant (Remove a xs) (x ': xs)
-   ) => Flow m (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs)
-{-# INLINABLE (>..?~$>) #-}
-(>..?~$>) = liftm (..?~$>)
-
-infixl 0 >..?~$>
-
--- | Match in the tail, keep the same types
-(..%~$>) ::
-   ( Monad m
-   , a :< xs
-   , LiftVariant (Remove a xs) (x ': xs)
-   ) => V (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs)
-{-# INLINABLE (..%~$>) #-}
-(..%~$>) v f = case popVariantHead v of
-   Right _ -> return v
-   Left xs -> xs %~^> f
-
-infixl 0 ..%~$>
-
--- | Match in the tail, keep the same types
-(>..%~$>) ::
-   ( Monad m
-   , a :< xs
-   , LiftVariant (Remove a xs) (x ': xs)
-   ) => Flow m (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs)
-{-# INLINABLE (>..%~$>) #-}
-(>..%~$>) = liftm (..%~$>)
-
-infixl 0 >..%~$>
-
-
--- | Extract the tail and perform an effect. Passthrough the input value
-(..~=>) ::
-   ( Monad m
-   ) => V (x ': xs) -> (V xs -> m ()) -> Flow m (x ': xs)
-{-# INLINABLE (..~=>) #-}
-(..~=>) v f = case popVariantHead v of
-   Right _ -> return v
-   Left  l -> f l >> return v
-
-infixl 0 ..~=>
-
--- | Extract the tail and perform an effect. Passthrough the input value
-(>..~=>) ::
-   ( Monad m
-   ) => Flow m (x ': xs) -> (V xs -> m ()) -> Flow m (x ': xs)
-{-# INLINABLE (>..~=>) #-}
-(>..~=>) = liftm (..~=>)
-
-infixl 0 >..~=>
-
--- | Extract the tail and perform an effect
-(..~!>) ::
-   ( Monad m
-   ) => V (x ': xs) -> (V xs -> m ()) -> m ()
-{-# INLINABLE (..~!>) #-}
-(..~!>) v f = case popVariantHead v of
-   Right _ -> return ()
-   Left  l -> f l
-
-infixl 0 ..~!>
-
--- | Extract the tail and perform an effect
-(>..~!>) ::
-   ( Monad m
-   ) => Flow m (x ': xs) -> (V xs -> m ()) -> m ()
-{-# INLINABLE (>..~!>) #-}
-(>..~!>) = liftm (..~!>)
-
-infixl 0 >..~!>
-
--- | Extract the tail and perform an effect
-(..~!!>) ::
-   ( Monad m
-   ) => V (x ': xs) -> (V xs -> m ()) -> m x
-{-# INLINABLE (..~!!>) #-}
-(..~!!>) v f = case popVariantHead v of
-   Right x -> return x
-   Left xs -> f xs >> error "..~!!> error"
-
-infixl 0 ..~!!>
-
--- | Extract the tail and perform an effect
-(>..~!!>) ::
-   ( Monad m
-   ) => Flow m (x ': xs) -> (V xs -> m ()) -> m x
-{-# INLINABLE (>..~!!>) #-}
-(>..~!!>) = liftm (..~!!>)
-
-infixl 0 >..~!!>
-
--- | Match in the tail and perform an effect
-(..?~!!>) ::
-   ( Monad m
-   , y :<? xs
-   ) => V (x ': xs) -> (y -> m ()) -> Flow m (x ': Remove y xs)
-{-# INLINABLE (..?~!!>) #-}
-(..?~!!>) v f = v ..~..> (\xs -> xs ?~!!> f)
-
-infixl 0 ..?~!!>
-
--- | Match in the tail and perform an effect
-(>..?~!!>) ::
-   ( Monad m
-   , y :<? xs
-   ) => Flow m (x ': xs) -> (y -> m ()) -> Flow m (x ': Remove y xs)
-{-# INLINABLE (>..?~!!>) #-}
-(>..?~!!>) = liftm (..?~!!>)
-
-infixl 0 >..?~!!>
-
--- | Match in the tail and perform an effect
-(..%~!!>) ::
-   ( Monad m
-   , y :< xs
-   ) => V (x ': xs) -> (y -> m ()) -> Flow m (x ': Remove y xs)
-{-# INLINABLE (..%~!!>) #-}
-(..%~!!>) v f = v ..~..> (\xs -> xs %~!!> f)
-
-infixl 0 ..%~!!>
-
--- | Match in the tail and perform an effect
-(>..%~!!>) ::
-   ( Monad m
-   , y :< xs
-   ) => Flow m (x ': xs) -> (y -> m ()) -> Flow m (x ': Remove y xs)
-{-# INLINABLE (>..%~!!>) #-}
-(>..%~!!>) = liftm (..%~!!>)
-
-infixl 0 >..%~!!>
-
--- | Match in the tail and perform an effect
-(..?~!>) ::
-   ( Monad m
-   , y :<? xs
-   ) => V (x ': xs) -> (y -> m ()) -> m ()
-{-# INLINABLE (..?~!>) #-}
-(..?~!>) v f = case popVariantHead v of
-   Right _ -> return ()
-   Left xs -> xs ?~!> f
-
-infixl 0 ..?~!>
-
--- | Match in the tail and perform an effect
-(>..?~!>) ::
-   ( Monad m
-   , y :<? xs
-   ) => Flow m (x ': xs) -> (y -> m ()) -> m ()
-{-# INLINABLE (>..?~!>) #-}
-(>..?~!>) = liftm (..?~!>)
-
-infixl 0 >..?~!>
-
--- | Match in the tail and perform an effect
-(..%~!>) ::
-   ( Monad m
-   , y :< xs
-   ) => V (x ': xs) -> (y -> m ()) -> m ()
-{-# INLINABLE (..%~!>) #-}
-(..%~!>) v f = case popVariantHead v of
-   Right _ -> return ()
-   Left xs -> xs %~!> f
-
-infixl 0 ..%~!>
-
--- | Match in the tail and perform an effect
-(>..%~!>) ::
-   ( Monad m
-   , y :< xs
-   ) => Flow m (x ': xs) -> (y -> m ()) -> m ()
-{-# INLINABLE (>..%~!>) #-}
-(>..%~!>) = liftm (..%~!>)
-
-infixl 0 >..%~!>
-
-----------------------------------------------------------
--- Caught element operations
-----------------------------------------------------------
-
--- | Pop element, set the first value
-(?~.>) :: forall x xs y ys m.
-   ( ys ~ Remove x xs
-   , Monad m
-   , x :<? xs
-   ) => V xs -> (x -> m y) -> Flow m (y ': ys)
-{-# INLINABLE (?~.>) #-}
-(?~.>) v f = case popVariantMaybe v of
-   Right x -> flowSetN @0 =<< f x
-   Left ys -> prependVariant @'[y] <$> return ys
-
-infixl 0 ?~.>
-
--- | Pop element, set the first value
-(>?~.>) ::
-   ( ys ~ Remove x xs
-   , Monad m
-   , x :<? xs
-   ) => Flow m xs -> (x -> m y) -> Flow m (y ': ys)
-{-# INLINABLE (>?~.>) #-}
-(>?~.>) = liftm (?~.>)
-
-infixl 0 >?~.>
-
--- | Pop element, set the first value
-(%~.>) :: forall x xs y ys m.
-   ( ys ~ Remove x xs
-   , Monad m
-   , x :< xs
-   ) => V xs -> (x -> m y) -> Flow m (y ': ys)
-{-# INLINABLE (%~.>) #-}
-(%~.>) = (?~.>)
-
-infixl 0 %~.>
-
--- | Pop element, set the first value
-(>%~.>) ::
-   ( ys ~ Remove x xs
-   , Monad m
-   , x :< xs
-   ) => Flow m xs -> (x -> m y) -> Flow m (y ': ys)
-{-# INLINABLE (>%~.>) #-}
-(>%~.>) = liftm (%~.>)
-
-infixl 0 >%~.>
-
--- | Pop element, concat the result
-(?~+>) :: forall x xs ys m.
-   ( Monad m
-   , x :<? xs
-   , KnownNat (Length ys)
-   ) => V xs -> (x -> Flow m ys) -> Flow m (Concat ys (Remove x xs))
-{-# INLINABLE (?~+>) #-}
-(?~+>) v f = case popVariantMaybe v of
-   Right x -> appendVariant  @(Remove x xs) <$> f x
-   Left ys -> prependVariant @ys            <$> return ys
-
-infixl 0 ?~+>
-
--- | Pop element, concat the result
-(>?~+>) :: forall x xs ys m.
-   ( Monad m
-   , x :< xs
-   , KnownNat (Length ys)
-   ) => Flow m xs -> (x -> Flow m ys) -> Flow m (Concat ys (Remove x xs))
-{-# INLINABLE (>?~+>) #-}
-(>?~+>) = liftm (?~+>)
-
-infixl 0 >?~+>
-
--- | Pop element, concat the result
-(%~+>) :: forall x xs ys m.
-   ( Monad m
-   , x :< xs
-   , KnownNat (Length ys)
-   ) => V xs -> (x -> Flow m ys) -> Flow m (Concat ys (Remove x xs))
-{-# INLINABLE (%~+>) #-}
-(%~+>) = (?~+>)
-
-infixl 0 %~+>
-
--- | Pop element, concat the result
-(>%~+>) :: forall x xs ys m.
-   ( Monad m
-   , x :< xs
-   , KnownNat (Length ys)
-   ) => Flow m xs -> (x -> Flow m ys) -> Flow m (Concat ys (Remove x xs))
-{-# INLINABLE (>%~+>) #-}
-(>%~+>) = liftm (%~+>)
-
-infixl 0 >%~+>
-
--- | Pop element, lift the result
-(?~^^>) :: forall x xs ys zs m.
-   ( Monad m
-   , x :<? xs
-   , LiftVariant (Remove x xs) zs
-   , LiftVariant ys zs
-   ) => V xs -> (x -> Flow m ys) -> Flow m zs
-{-# INLINABLE (?~^^>) #-}
-(?~^^>) v f = case popVariantMaybe v of
-   Right x -> liftVariant <$> f x
-   Left ys -> liftVariant <$> return ys
-
-infixl 0 ?~^^>
-
--- | Pop element, lift the result
-(>?~^^>) :: forall x xs ys zs m.
-   ( Monad m
-   , x :<? xs
-   , LiftVariant (Remove x xs) zs
-   , LiftVariant ys zs
-   ) => Flow m xs -> (x -> Flow m ys) -> Flow m zs
-{-# INLINABLE (>?~^^>) #-}
-(>?~^^>) = liftm (?~^^>)
-
-infixl 0 >?~^^>
-
--- | Pop element, lift the result
-(%~^^>) :: forall x xs ys zs m.
-   ( Monad m
-   , x :< xs
-   , LiftVariant (Remove x xs) zs
-   , LiftVariant ys zs
-   ) => V xs -> (x -> Flow m ys) -> Flow m zs
-{-# INLINABLE (%~^^>) #-}
-(%~^^>) = (?~^^>)
-
-infixl 0 %~^^>
-
--- | Pop element, lift the result
-(>%~^^>) :: forall x xs ys zs m.
-   ( Monad m
-   , x :< xs
-   , LiftVariant (Remove x xs) zs
-   , LiftVariant ys zs
-   ) => Flow m xs -> (x -> Flow m ys) -> Flow m zs
-{-# INLINABLE (>%~^^>) #-}
-(>%~^^>) = liftm (%~^^>)
-
-infixl 0 >%~^^>
-
--- | Pop element, connect to the expected output
-(?~^>) :: forall x xs zs m.
-   ( Monad m
-   , x :<? xs
-   , LiftVariant (Remove x xs) zs
-   ) => V xs -> (x -> Flow m zs) -> Flow m zs
-{-# INLINABLE (?~^>) #-}
-(?~^>) v f = case popVariantMaybe v of
-   Right x -> f x
-   Left ys -> return (liftVariant ys)
-
-infixl 0 ?~^>
-
--- | Pop element, connect to the expected output
-(>?~^>) :: forall x xs zs m.
-   ( Monad m
-   , x :<? xs
-   , LiftVariant (Remove x xs) zs
-   ) => Flow m xs -> (x -> Flow m zs) -> Flow m zs
-{-# INLINABLE (>?~^>) #-}
-(>?~^>) = liftm (?~^>)
-
-infixl 0 >?~^>
-
--- | Pop element, connect to the expected output
-(%~^>) :: forall x xs zs m.
-   ( Monad m
-   , x :< xs
-   , LiftVariant (Remove x xs) zs
-   ) => V xs -> (x -> Flow m zs) -> Flow m zs
-{-# INLINABLE (%~^>) #-}
-(%~^>) = (?~^>)
-
-infixl 0 %~^>
-
--- | Pop element, connect to the expected output
-(>%~^>) :: forall x xs zs m.
-   ( Monad m
-   , x :< xs
-   , LiftVariant (Remove x xs) zs
-   ) => Flow m xs -> (x -> Flow m zs) -> Flow m zs
-{-# INLINABLE (>%~^>) #-}
-(>%~^>) = liftm (%~^>)
-
-infixl 0 >%~^>
-
--- | Pop element, use the same output type
-(?~$>) :: forall x xs m.
-   ( Monad m
-   , x :<? xs
-   ) => V xs -> (x -> Flow m xs) -> Flow m xs
-{-# INLINABLE (?~$>) #-}
-(?~$>) v f = case popVariantMaybe v of
-   Right x -> f x
-   Left _  -> return v
-
-infixl 0 ?~$>
-
--- | Pop element, use the same output type
-(>?~$>) :: forall x xs m.
-   ( Monad m
-   , x :<? xs
-   ) => Flow m xs -> (x -> Flow m xs) -> Flow m xs
-{-# INLINABLE (>?~$>) #-}
-(>?~$>) = liftm (?~$>)
-
-infixl 0 >?~$>
-
--- | Pop element, use the same output type
-(%~$>) :: forall x xs m.
-   ( Monad m
-   , x :< xs
-   ) => V xs -> (x -> Flow m xs) -> Flow m xs
-{-# INLINABLE (%~$>) #-}
-(%~$>) = (?~$>)
-
-infixl 0 %~$>
-
--- | Pop element, use the same output type
-(>%~$>) :: forall x xs m.
-   ( Monad m
-   , x :< xs
-   ) => Flow m xs -> (x -> Flow m xs) -> Flow m xs
-{-# INLINABLE (>%~$>) #-}
-(>%~$>) = liftm (%~$>)
-
-infixl 0 >%~$>
-
--- | Pop element, fusion the result
-(?~|>) :: forall x xs ys zs m.
-   ( Monad m
-   , x :<? xs
-   , LiftVariant (Remove x xs) zs
-   , LiftVariant ys zs
-   , zs ~ Union (Remove x xs) ys
-   ) => V xs -> (x -> Flow m ys) -> Flow m zs
-{-# INLINABLE (?~|>) #-}
-(?~|>) v f = case popVariantMaybe v of
-   Right x -> liftVariant <$> f x
-   Left ys -> return (liftVariant ys)
-
-infixl 0 ?~|>
-
--- | Pop element, fusion the result
-(>?~|>) :: forall x xs ys zs m.
-   ( Monad m
-   , x :<? xs
-   , LiftVariant (Remove x xs) zs
-   , LiftVariant ys zs
-   , zs ~ Union (Remove x xs) ys
-   ) => Flow m xs -> (x -> Flow m ys) -> Flow m zs
-{-# INLINABLE (>?~|>) #-}
-(>?~|>) = liftm (?~|>)
-
-infixl 0 >?~|>
-
--- | Pop element, fusion the result
-(%~|>) :: forall x xs ys zs m.
-   ( Monad m
-   , x :< xs
-   , LiftVariant (Remove x xs) zs
-   , LiftVariant ys zs
-   , zs ~ Union (Remove x xs) ys
-   ) => V xs -> (x -> Flow m ys) -> Flow m zs
-{-# INLINABLE (%~|>) #-}
-(%~|>) = (?~|>)
-
-infixl 0 %~|>
-
--- | Pop element, fusion the result
-(>%~|>) :: forall x xs ys zs m.
-   ( Monad m
-   , x :< xs
-   , LiftVariant (Remove x xs) zs
-   , LiftVariant ys zs
-   , zs ~ Union (Remove x xs) ys
-   ) => Flow m xs -> (x -> Flow m ys) -> Flow m zs
-{-# INLINABLE (>%~|>) #-}
-(>%~|>) = liftm (%~|>)
-
-infixl 0 >%~|>
-
--- | Pop element and perform effect. Passthrough the input value.
-(?~=>) :: forall x xs m.
-   ( Monad m
-   , x :<? xs
-   ) => V xs -> (x -> m ()) -> Flow m xs
-{-# INLINABLE (?~=>) #-}
-(?~=>) v f = case popVariantMaybe v of
-   Right x -> f x >> return v
-   Left _  -> return v
-
-infixl 0 ?~=>
-
--- | Pop element and perform effect. Passthrough the input value.
-(>?~=>) :: forall x xs m.
-   ( Monad m
-   , x :<? xs
-   ) => Flow m xs -> (x -> m ()) -> Flow m xs
-{-# INLINABLE (>?~=>) #-}
-(>?~=>) = liftm (?~=>)
-
-infixl 0 >?~=>
-
--- | Pop element and perform effect. Passthrough the input value.
-(%~=>) :: forall x xs m.
-   ( Monad m
-   , x :< xs
-   ) => V xs -> (x -> m ()) -> Flow m xs
-{-# INLINABLE (%~=>) #-}
-(%~=>) = (?~=>)
-
-infixl 0 %~=>
-
--- | Pop element and perform effect. Passthrough the input value.
-(>%~=>) :: forall x xs m.
-   ( Monad m
-   , x :< xs
-   ) => Flow m xs -> (x -> m ()) -> Flow m xs
-{-# INLINABLE (>%~=>) #-}
-(>%~=>) = liftm (%~=>)
-
-infixl 0 >%~=>
-
--- | Pop element and perform effect.
-(?~!>) :: forall x xs m.
-   ( Monad m
-   , x :<? xs
-   ) => V xs -> (x -> m ()) -> m ()
-{-# INLINABLE (?~!>) #-}
-(?~!>) v f = case popVariantMaybe v of
-   Right x -> f x
-   Left _  -> return ()
-
-infixl 0 ?~!>
-
--- | Pop element and perform effect.
-(>?~!>) :: forall x xs m.
-   ( Monad m
-   , x :<? xs
-   ) => Flow m xs -> (x -> m ()) -> m ()
-{-# INLINABLE (>?~!>) #-}
-(>?~!>) = liftm (?~!>)
-
-infixl 0 >?~!>
-
--- | Pop element and perform effect.
-(%~!>) :: forall x xs m.
-   ( Monad m
-   , x :< xs
-   ) => V xs -> (x -> m ()) -> m ()
-{-# INLINABLE (%~!>) #-}
-(%~!>) = (?~!>)
-
-infixl 0 %~!>
-
--- | Pop element and perform effect.
-(>%~!>) :: forall x xs m.
-   ( Monad m
-   , x :< xs
-   ) => Flow m xs -> (x -> m ()) -> m ()
-{-# INLINABLE (>%~!>) #-}
-(>%~!>) = liftm (%~!>)
-
-infixl 0 >%~!>
-
--- | Pop element and perform effect.
-(?~!!>) :: forall x xs m.
-   ( Monad m
-   , x :<? xs
-   ) => V xs -> (x -> m ()) -> Flow m (Remove x xs)
-{-# INLINABLE (?~!!>) #-}
-(?~!!>) v f = case popVariantMaybe v of
-   Right x -> f x >> error "?~!!> error"
-   Left u  -> return u
-
-infixl 0 ?~!!>
-
--- | Pop element and perform effect.
-(>?~!!>) :: forall x xs m.
-   ( Monad m
-   , x :<? xs
-   ) => Flow m xs -> (x -> m ()) -> Flow m (Remove x xs)
-{-# INLINABLE (>?~!!>) #-}
-(>?~!!>) = liftm (?~!!>)
-
-infixl 0 >?~!!>
-
--- | Pop element and perform effect.
-(%~!!>) :: forall x xs m.
-   ( Monad m
-   , x :< xs
-   ) => V xs -> (x -> m ()) -> Flow m (Remove x xs)
-{-# INLINABLE (%~!!>) #-}
-(%~!!>) = (?~!!>)
-
-infixl 0 %~!!>
-
--- | Pop element and perform effect.
-(>%~!!>) :: forall x xs m.
-   ( Monad m
-   , x :< xs
-   ) => Flow m xs -> (x -> m ()) -> Flow m (Remove x xs)
-{-# INLINABLE (>%~!!>) #-}
-(>%~!!>) = liftm (%~!!>)
-
-infixl 0 >%~!!>
-
---------------------------------------------------------------
--- Helpers
---------------------------------------------------------------
-
-
--- | Make a flow operator
-makeFlowOp :: Monad m =>
-      (V as -> Either (V bs) (V cs))
-      -> (V cs -> Flow m ds)
-      -> (Either (V bs) (V ds) -> es)
-      -> V as -> m es
-{-# INLINABLE makeFlowOp #-}
-makeFlowOp select apply combine v = combine <$> traverse apply (select v)
-
--- | Make a flow operator
-makeFlowOpM :: Monad m =>
-      (V as -> Either (V bs) (V cs))
-      -> (V cs -> Flow m ds)
-      -> (Either (V bs) (V ds) -> es)
-      -> Flow m as -> m es
-{-# INLINABLE makeFlowOpM #-}
-makeFlowOpM select apply combine v = v >>= makeFlowOp select apply combine
-
-
--- | Select the first value
-selectFirst :: V (x ': xs) -> Either (V xs) (V '[x])
-{-# INLINABLE selectFirst #-}
-selectFirst = fmap (toVariantAt @0) . popVariantHead
-
--- | Select the tail
-selectTail :: V (x ': xs) -> Either (V '[x]) (V xs)
-{-# INLINABLE selectTail #-}
-selectTail = flipEither . selectFirst
-   where
-      flipEither (Left x)  = Right x
-      flipEither (Right x) = Left x
-
--- | Select by type
-selectType ::
-   ( x :< xs
-   ) => V xs -> Either (V (Remove x xs)) (V '[x])
-{-# INLINABLE selectType #-}
-selectType = fmap (toVariantAt @0) . popVariant
-
--- | Const application
-applyConst :: Flow m ys -> (V xs -> Flow m ys)
-{-# INLINABLE applyConst #-}
-applyConst = const
-
--- | Pure application
-applyPure :: Monad m => (V xs -> V ys) -> V xs -> Flow m ys
-{-# INLINABLE applyPure #-}
-applyPure f = return . f
-
--- | Lift a monadic function
-applyM :: Monad m => (a -> m b) -> V '[a] -> Flow m '[b]
-{-# INLINABLE applyM #-}
-applyM = liftF
-
--- | Lift a monadic function
-applyVM :: Monad m => (V a -> m b) -> V a -> Flow m '[b]
-{-# INLINABLE applyVM #-}
-applyVM f = fmap (toVariantAt @0) . f
-
--- | Lift a monadic function
-applyF :: (a -> Flow m b) -> V '[a] -> Flow m b
-{-# INLINABLE applyF #-}
-applyF f = f . variantToValue
-
--- | Set the first value (the "correct" one)
-combineFirst :: forall x xs. Either (V xs) (V '[x]) -> V (x ': xs)
-{-# INLINABLE combineFirst #-}
-combineFirst = \case
-   Right x -> appendVariant  @xs x
-   Left xs -> prependVariant @'[x] xs
-
--- | Set the first value, keep the same tail type 
-combineSameTail :: forall x xs.
-   Either (V xs) (V (x ': xs)) -> V (x ': xs)
-{-# INLINABLE combineSameTail #-}
-combineSameTail = \case
-   Right x -> x
-   Left xs -> prependVariant @'[x] xs
-
--- | Return the valid variant unmodified
-combineEither :: Either (V xs) (V xs) -> V xs
-{-# INLINABLE combineEither #-}
-combineEither = \case
-   Right x -> x
-   Left x  -> x
-
--- | Concatenate unselected values
-combineConcat :: forall xs ys.
-   ( KnownNat (Length xs)
-   ) => Either (V ys) (V xs) -> V (Concat xs ys)
-{-# INLINABLE combineConcat #-}
-combineConcat = \case
-   Right xs -> appendVariant  @ys xs
-   Left ys  -> prependVariant @xs ys
-
--- | Union
-combineUnion ::
-   ( LiftVariant xs (Union xs ys)
-   , LiftVariant ys (Union xs ys)
-   ) => Either (V ys) (V xs) -> V (Union xs ys)
-{-# INLINABLE combineUnion #-}
-combineUnion = \case
-   Right xs -> liftVariant xs
-   Left  ys -> liftVariant ys
-
--- | Lift unselected
-combineLiftUnselected ::
-   ( LiftVariant ys xs
-   ) => Either (V ys) (V xs) -> V xs
-{-# INLINABLE combineLiftUnselected #-}
-combineLiftUnselected = \case
-   Right xs -> xs
-   Left ys  -> liftVariant ys
-
--- | Lift both
-combineLiftBoth ::
-   ( LiftVariant ys zs
-   , LiftVariant xs zs
-   ) => Either (V ys) (V xs) -> V zs
-{-# INLINABLE combineLiftBoth #-}
-combineLiftBoth = \case
-   Right xs -> liftVariant xs
-   Left ys  -> liftVariant ys
-
--- | Single value
-combineSingle :: Either (V '[x]) (V '[x]) -> x
-{-# INLINABLE combineSingle #-}
-combineSingle = \case
-   Right x -> variantToValue x
-   Left  x -> variantToValue x
-
-
--- | Lift a pure function into a Variant to Variant function
-liftV :: (a -> b) -> V '[a] -> V '[b]
-liftV = mapVariantAt @0
-
--- | Lift a function into a Flow
-liftF :: Monad m => (a -> m b) -> V '[a] -> Flow m '[b]
-liftF = mapVariantAtM @0
-
-
------------------------------------
--- Operation on every element
------------------------------------
-
--- | Replace the RHS of every function type in the list with `v`
-type family ReplaceRHS f v where
-   ReplaceRHS '[] _              = '[]
-   ReplaceRHS ((x -> _) ': xs) v = (x -> v) ': ReplaceRHS xs v
-
--- | Extract the RHS of every function type in the list
-type family ExtractRHS f where
-   ExtractRHS '[]              = '[]
-   ExtractRHS ((_ -> x) ': xs) = x ': ExtractRHS xs
-
-type LiftContTuple x = ListToTuple (ReplaceRHS (TupleToList x) (V (ExtractRHS (TupleToList x))))
-
-class LiftCont x where
-   -- | Lift a tuple of functions (a -> r1, b -> r2, ...) into a tuple of
-   -- functions (a -> V '[r1,r2,...], b -> V '[r1,r2,...], ...)
-   liftCont :: x -> LiftContTuple x
-
-instance LiftCont (Single (a -> b)) where
-   liftCont (Single a) = Single (V . a)
-
-instance LiftCont (a->b,c->d) where
-   liftCont (a,b) =
-      ( toVariantAt @0 . a
-      , toVariantAt @1 . b
-      )
-
-instance LiftCont (a->b,c->d,e->f) where
-   liftCont (a,b,c) =
-      ( toVariantAt @0 . a
-      , toVariantAt @1 . b
-      , toVariantAt @2 . c
-      )
-
-instance LiftCont (a->b,c->d,e->f,g->h) where
-   liftCont (a,b,c,d) =
-      ( toVariantAt @0 . a
-      , toVariantAt @1 . b
-      , toVariantAt @2 . c
-      , toVariantAt @3 . d
-      )
-
-instance LiftCont (a->b,c->d,e->f,g->h,i->j) where
-   liftCont (a,b,c,d,e) =
-      ( toVariantAt @0 . a
-      , toVariantAt @1 . b
-      , toVariantAt @2 . c
-      , toVariantAt @3 . d
-      , toVariantAt @4 . e
-      )
-
-instance LiftCont (a->b,c->d,e->f,g->h,i->j,k->l) where
-   liftCont (a,b,c,d,e,f) =
-      ( toVariantAt @0 . a
-      , toVariantAt @1 . b
-      , toVariantAt @2 . c
-      , toVariantAt @3 . d
-      , toVariantAt @4 . e
-      , toVariantAt @5 . f
-      )
-
-instance LiftCont (a->b,c->d,e->f,g->h,i->j,k->l,m->n) where
-   liftCont (a,b,c,d,e,f,g) =
-      ( toVariantAt @0 . a
-      , toVariantAt @1 . b
-      , toVariantAt @2 . c
-      , toVariantAt @3 . d
-      , toVariantAt @4 . e
-      , toVariantAt @5 . f
-      , toVariantAt @6 . g
-      )
-
-instance LiftCont (a->b,c->d,e->f,g->h,i->j,k->l,m->n,o->p) where
-   liftCont (a,b,c,d,e,f,g,h) =
-      ( toVariantAt @0 . a
-      , toVariantAt @1 . b
-      , toVariantAt @2 . c
-      , toVariantAt @3 . d
-      , toVariantAt @4 . e
-      , toVariantAt @5 . f
-      , toVariantAt @6 . g
-      , toVariantAt @7 . h
-      )
-
-instance LiftCont (a->b,c->d,e->f,g->h,i->j,k->l,m->n,o->p,q->r) where
-   liftCont (a,b,c,d,e,f,g,h,i) =
-      ( toVariantAt @0 . a
-      , toVariantAt @1 . b
-      , toVariantAt @2 . c
-      , toVariantAt @3 . d
-      , toVariantAt @4 . e
-      , toVariantAt @5 . f
-      , toVariantAt @6 . g
-      , toVariantAt @7 . h
-      , toVariantAt @8 . i
-      )
-
--- | Pure multi-map
---
--- Map functions on a variant and produce a resulting variant
---
--- @
---     > (V 'c' :: V '[Char,String]) -|| (ord,map toUpper)
---     V 99 :: V '[Int,String]
---
---     > (V "test" :: V '[Char,String]) -|| (ord,map toUpper)
---     V "TEST" :: V '[Int,String]
---
---     > (V "test" :: V '[Char,String]) -|| (ord,length)
---     V 4 :: V '[Int,Int]
--- @
---
-(-||) :: forall fs xs zs.
-   ( LiftCont fs
-   , zs ~ ExtractRHS (TupleToList fs)
-   , LiftContTuple fs ~ ContListToTuple xs (V zs)
-   , ContVariant xs
-   ) => V xs -> fs -> V zs
-(-||) v fs = variantToCont v >::> liftCont fs
-
--- | Applicative pure multi-map
-(-||>) :: forall m fs xs zs ks.
-   ( LiftCont fs
-   , zs ~ ExtractRHS (TupleToList fs)
-   , LiftContTuple fs ~ ContListToTuple xs (V zs)
-   , ContVariant xs
-   , ks ~ ExtractM m zs
-   , Applicative m
-   , JoinVariant m zs
-   ) => V xs -> fs -> Flow m ks
-(-||>) v fs = joinVariant (v -|| fs)
-
--- | Monadic pure multi-map
-(>-||>) :: forall m fs xs zs ks.
-   ( LiftCont fs
-   , zs ~ ExtractRHS (TupleToList fs)
-   , LiftContTuple fs ~ ContListToTuple xs (V zs)
-   , ContVariant xs
-   , ks ~ ExtractM m zs
-   , Monad m
-   , JoinVariant m zs
-   ) => Flow m xs -> fs -> Flow m ks
-(>-||>) act fs = do
-   r <- act
-   r -||> fs
-
--- | Variant multi-map
---
--- Map functions returning a variant on a variant and produce a resulting
--- flattened and nub'ed variant
---
--- @
---     mapInt64 :: Int64 -> V '[Int16,Int32,Int64]
---     mapInt64 x
---        | x <= 0xffff     = toVariantAt @0 (fromIntegral x)
---        | x <= 0xffffffff = toVariantAt @1 (fromIntegral x)
---        | otherwise       = toVariantAt @2 x
---     
---     mapInt32 :: Int32 -> V '[Int16,Int32]
---     mapInt32 x
---        | x <= 0xffff     = toVariantAt @0 (fromIntegral x)
---        | otherwise       = toVariantAt @1 x
---     
---     > V @Int64 @'[Int64,Int32] 10 ~|| (mapInt64,mapInt32)
---     V 10 :: Variant '[Int16, Int32, Int64]
--- @
---
-(~||) :: forall fs xs zs ys rs.
-   ( LiftCont fs
-   , zs ~ ExtractRHS (TupleToList fs)
-   , LiftContTuple fs ~ ContListToTuple xs (V zs)
-   , ContVariant xs
-   , ys ~ FlattenVariant zs
-   , Flattenable (V zs) (V ys)
-   , LiftVariant ys (Nub ys)
-   , rs ~ Nub ys
-   ) => V xs -> fs -> V rs
-(~||) v fs = nubVariant (flattenVariant (v -|| fs))
-
--- | Applicative variant multi-map
---
--- @
---    mapInt64 :: Int64 -> IO (V '[Int16,Int32,Int64])
---    mapInt64 x
---       | x <= 0xffff     = do
---          putStrLn "Found Int16!"
---          return (toVariantAt @0 (fromIntegral x))
---       | x <= 0xffffffff = do
---          putStrLn "Found Int32!"
---          return (toVariantAt @1 (fromIntegral x))
---       | otherwise       = do
---          putStrLn "Found Int64!"
---          return (toVariantAt @2 x)
---
---    mapInt32 :: Int32 -> IO (V '[Int16,Int32])
---    mapInt32 x
---       | x <= 0xffff     = do
---          putStrLn "Found Int16!"
---          return (toVariantAt @0 (fromIntegral x))
---       | otherwise       = do
---          putStrLn "Found Int32!"
---          return (toVariantAt @1 x)
---
---    v = V @Int64 @'[Int64,Int32] 10
---
---    > x <- v -||> (mapInt64,mapInt32)
---    Found Int16!
---
---    > :t x
---    x :: V '[V '[Int16, Int32, Int64], V '[Int16, Int32]]
---
---    > x <- v ~||> (mapInt64,mapInt32)
---    Found Int16!
---
---    > :t x
---    x :: V '[Int16, Int32, Int64]
--- @
---
-(~||>) :: forall m fs xs zs ks ys rs.
-   ( ContVariant xs
-   , LiftCont fs
-   , zs ~ ExtractRHS (TupleToList fs)
-   , LiftContTuple fs ~ ContListToTuple xs (V zs)
-   , ks ~ ExtractM m zs
-   , ys ~ FlattenVariant ks
-   , Flattenable (V ks) (V ys)
-   , rs ~ Nub ys
-   , LiftVariant ys rs
-   , Applicative m
-   , JoinVariant m zs
-   ) => V xs -> fs -> Flow m rs
-(~||>) v fs = nubVariant <$> (flattenVariant <$> joinVariant (v -|| fs))
-
--- | Monadic variant multi-map
-(>~||>) :: forall m fs xs zs ks ys rs.
-   ( ContVariant xs
-   , LiftCont fs
-   , zs ~ ExtractRHS (TupleToList fs)
-   , LiftContTuple fs ~ ContListToTuple xs (V zs)
-   , ks ~ ExtractM m zs
-   , ys ~ FlattenVariant ks
-   , Flattenable (V ks) (V ys)
-   , rs ~ Nub ys
-   , LiftVariant ys rs
-   , Monad m
-   , JoinVariant m zs
-   ) => Flow m xs -> fs -> Flow m rs
-(>~||>) act fs = do
-   r <- act
-   r ~||> fs
diff --git a/src/lib/Haskus/Utils/Variant/VEither.hs b/src/lib/Haskus/Utils/Variant/VEither.hs
new file mode 100644
--- /dev/null
+++ b/src/lib/Haskus/Utils/Variant/VEither.hs
@@ -0,0 +1,240 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
+
+-- | Variant biased towards one type
+--
+-- This allows definition of common type classes (Functor, etc.) that can't  be
+-- provided for Variant
+module Haskus.Utils.Variant.VEither
+   ( VEither
+   , pattern VLeft
+   , pattern VRight
+   , veitherFromVariant
+   , veitherToVariant
+   , veitherToValue
+   , veitherBimap
+   , VEitherLift
+   , veitherLift
+   , veitherAppend
+   , veitherPrepend
+   , veitherCont
+   , veitherToEither
+   , veitherProduct
+   , module Haskus.Utils.Variant
+   )
+where
+
+import Haskus.Utils.Variant
+import Haskus.Utils.Types
+import Data.Coerce
+
+-- $setup
+-- >>> :set -XDataKinds
+-- >>> :set -XTypeApplications
+-- >>> :set -XFlexibleContexts
+-- >>> :set -XTypeFamilies
+-- >>> import Data.Foldable
+
+
+-- | Variant biased towards one type
+newtype VEither es a
+   = VEither (V (a ': es))
+
+
+----------------------
+-- Patterns
+----------------------
+
+-- | Left value
+--
+-- >>> VLeft (V "failed" :: V '[String,Int]) :: VEither '[String,Int] Bool
+-- VLeft "failed"
+--
+pattern VLeft :: forall x xs. V xs -> VEither xs x
+pattern VLeft xs <- ((popVariantHead . veitherToVariant) -> Left xs)
+   where
+      VLeft xs = VEither (toVariantTail xs)
+
+-- | Right value
+--
+-- >>> VRight True :: VEither '[String,Int] Bool
+-- VRight True
+pattern VRight :: forall x xs. x -> VEither xs x
+pattern VRight x <- ((popVariantHead . veitherToVariant) -> Right x)
+   where
+      VRight x = VEither (toVariantHead x)
+
+{-# COMPLETE VLeft,VRight #-}
+
+----------------------
+-- Show instance
+----------------------
+
+instance
+   ( Show a
+   , Show (V es)
+   ) => Show (VEither es a) where
+   showsPrec d v = showParen (d /= 0) $ case v of
+      VLeft xs -> showString "VLeft "
+                  . showsPrec 10 xs
+      VRight x -> showString "VRight "
+                  . showsPrec 10 x
+
+
+-- | Convert a Variant into a VEither
+--
+-- >>> let x = V "Test" :: V '[Int,String,Double]
+-- >>> veitherFromVariant x
+-- VLeft "Test"
+--
+veitherFromVariant :: V (a ': es) -> VEither es a
+{-# INLINABLE veitherFromVariant #-}
+veitherFromVariant = VEither
+
+-- | Convert a VEither into a Variant
+--
+-- >>> let x = VRight True :: VEither '[Int,Float] Bool
+-- >>> veitherToVariant x
+-- True
+--
+veitherToVariant :: VEither es a -> V (a ': es)
+{-# INLINABLE veitherToVariant #-}
+veitherToVariant (VEither x) = x
+
+-- | Convert a VEither into an Either
+--
+-- >>> let x = VRight True :: VEither '[Int,Float] Bool
+-- >>> veitherToEither x
+-- Right True
+--
+veitherToEither :: VEither es a -> Either (V es) a
+{-# INLINABLE veitherToEither #-}
+veitherToEither = \case
+   VLeft xs -> Left xs
+   VRight x -> Right x
+
+-- | Extract from a VEither without left types
+--
+-- >>> let x = VRight True :: VEither '[] Bool
+-- >>> veitherToValue x
+-- True
+veitherToValue :: forall a. VEither '[] a -> a
+{-# INLINABLE veitherToValue #-}
+veitherToValue = coerce (variantToValue @a)
+
+-- | Bimap for VEither
+--
+-- >>> let x = VRight True :: VEither '[Int,Float] Bool
+-- >>> veitherBimap id not x
+-- VRight False
+--
+veitherBimap :: (V es -> V fs) -> (a -> b) ->  VEither es a -> VEither fs b
+{-# INLINABLE veitherBimap #-}
+veitherBimap f g v = case v of
+   VLeft xs -> VLeft (f xs)
+   VRight x -> VRight (g x)
+
+
+type VEitherLift es es' =
+   ( LiftVariant es es'
+   )
+
+-- | Lift a VEither into another
+veitherLift :: forall es' es a.
+   ( VEitherLift es es'
+   ) => VEither es a -> VEither es' a
+{-# INLINABLE veitherLift #-}
+veitherLift = veitherBimap liftVariant id
+
+-- | Prepend errors to VEither
+veitherPrepend :: forall ns es a.
+   ( KnownNat (Length ns)
+   ) => VEither es a -> VEither (Concat ns es) a
+{-# INLINABLE veitherPrepend #-}
+veitherPrepend = veitherBimap (prependVariant @ns) id
+
+-- | Append errors to VEither
+veitherAppend :: forall ns es a.
+   VEither es a -> VEither (Concat es ns) a
+{-# INLINABLE veitherAppend #-}
+veitherAppend = veitherBimap (appendVariant @ns) id
+
+-- | VEither continuations
+veitherCont :: (V es -> u) -> (a -> u) -> VEither es a -> u
+{-# INLINABLE veitherCont #-}
+veitherCont f g v = case v of
+   VLeft xs -> f xs
+   VRight x -> g x
+
+-- | Product of two VEither
+veitherProduct :: KnownNat (Length (b:e2)) => VEither e1 a -> VEither e2 b -> VEither (Tail (Product (a:e1) (b:e2))) (a,b)
+veitherProduct (VEither x) (VEither y) = VEither (productVariant x y)
+
+-- | Functor instance for VEither
+--
+-- >>> let x = VRight True :: VEither '[Int,Float] Bool
+-- >>> fmap (\b -> if b then "Success" else "Failure") x
+-- VRight "Success"
+--
+instance Functor (VEither es) where
+   {-# INLINABLE fmap #-}
+   fmap f (VEither v) = VEither (mapVariantAt @0 f v)
+
+-- | Applicative instance for VEither
+--
+-- >>> let x = VRight True  :: VEither '[Int,Float] Bool
+-- >>> let y = VRight False :: VEither '[Int,Float] Bool
+-- >>> (&&) <$> x <*> y
+-- VRight False
+-- >>> (||) <$> x <*> y
+-- VRight True
+--
+instance Applicative (VEither es) where
+   pure = VRight
+
+   VRight f <*> VRight a = VRight (f a)
+   VLeft v  <*> _        = VLeft v
+   _        <*> VLeft v  = VLeft v
+
+-- | Monad instance for VEither
+--
+-- >>> let x   = VRight True    :: VEither '[Int,Float] Bool
+-- >>> let f v = VRight (not v) :: VEither '[Int,Float] Bool
+-- >>> x >>= f
+-- VRight False
+--
+instance Monad (VEither es) where
+   VRight a >>= f = f a
+   VLeft v  >>= _ = VLeft v
+
+-- | Foldable instance for VEither
+--
+-- >>> let x   = VRight True    :: VEither '[Int,Float] Bool
+-- >>> let y   = VLeft (V "failed" :: V '[String,Int]) :: VEither '[String,Int] Bool
+-- >>> forM_ x print
+-- True
+-- >>> forM_ y print
+--
+instance Foldable (VEither es) where
+   foldMap f (VRight a) = f a
+   foldMap _ (VLeft _)  = mempty
+
+instance Traversable (VEither es) where
+   traverse f (VRight a) = VRight <$> f a
+   traverse _ (VLeft xs) = pure (VLeft xs)
diff --git a/src/lib/Haskus/Utils/VariantF.hs b/src/lib/Haskus/Utils/VariantF.hs
--- a/src/lib/Haskus/Utils/VariantF.hs
+++ b/src/lib/Haskus/Utils/VariantF.hs
@@ -23,6 +23,7 @@
    , ApplyAll
    , pattern FV
    , appendVariantF
+   , prependVariantF
    , toVariantFHead
    , toVariantFTail
    , popVariantFHead
@@ -33,16 +34,19 @@
    , popVariantF
    , LiftVariantF
    , liftVariantF
-   , AlterVariantF
-   , alterVariantF
-   , AlgVariantF
-   , algVariantF
    , SplitVariantF
    , splitVariantF
    , variantFToCont
    , variantFToContM
    , contToVariantF
    , contToVariantFM
+   -- * Algebras
+   , BottomUpF
+   , BottomUp (..)
+   , BottomUpOrig (..)
+   , BottomUpOrigF
+   , TopDownStop (..)
+   , TopDownStopF
    -- * Reexport
    , NoConstraint
    , module Haskus.Utils.Functor
@@ -54,12 +58,10 @@
 import Haskus.Utils.Types.List
 import Haskus.Utils.Types.Constraint
 import Haskus.Utils.ContFlow
+import Haskus.Utils.Types
 
-import Unsafe.Coerce
 import Data.Bifunctor
-import GHC.Exts (Any)
 import Control.DeepSeq
-import Data.Functor.Classes
 
 -- $setup
 -- >>> :set -XDataKinds
@@ -73,6 +75,7 @@
 -- >>>
 -- >>> data ConsF a e = ConsF a e deriving (Functor)
 -- >>> data NilF    e = NilF      deriving (Functor)
+-- >>> type ListF   a = VariantF '[NilF,ConsF a]
 -- >>>
 -- >>> instance Eq a => Eq1 (ConsF a) where liftEq cmp (ConsF a e1) (ConsF b e2) = a == b && cmp e1 e2
 -- >>> instance Eq1 NilF where liftEq _ _ _ = True
@@ -93,17 +96,19 @@
 -- False
 
 -- | Recursive Functor-like Variant
-newtype VariantF (xs :: [* -> *]) e
+newtype VariantF (xs :: [t -> *]) (e :: t)
    = VariantF (V (ApplyAll e xs))
 
 -- | Apply its first argument to every element of the 2nd arg list
 --
 -- > ApplyAll e '[f,g,h] ==> '[f e, g e, h e]
 --
-type family ApplyAll e (xs :: [* -> k]) :: [k] where
+type family ApplyAll (e :: t) (xs :: [t -> k]) :: [k] where
    ApplyAll e '[]       = '[]
    ApplyAll e (f ': fs) = f e ': ApplyAll e fs
 
+type instance Base (VariantF xs a) = VariantF xs
+
 -- | Eq instance for VariantF
 --
 -- >>> let a = FV (ConsF 'a' "Test") :: VariantF '[ConsF Char,NilF] String
@@ -215,7 +220,12 @@
       Right x -> toVariantFHead (fmap f x)
       Left xs -> toVariantFTail (fmap f (VariantF xs))
 
+
+
 -- | Pattern-match in a VariantF
+--
+-- >>> FV (NilF :: NilF String) :: VariantF '[ConsF Char,NilF] String
+-- NilF
 pattern FV :: forall c cs e. c :< (ApplyAll e cs) => c -> VariantF cs e
 pattern FV x = VariantF (V x)
 
@@ -228,19 +238,26 @@
    ) => VariantF xs e -> VariantF (Concat xs ys) e
 appendVariantF (VariantF v) = VariantF (appendVariant @(ApplyAll e ys) v)
 
+prependVariantF :: forall (xs :: [* -> *]) (ys :: [* -> *]) e.
+   ( ApplyAll e (Concat xs ys) ~ Concat (ApplyAll e xs) (ApplyAll e ys)
+   , KnownNat (Length (ApplyAll e xs))
+   ) => VariantF ys e -> VariantF (Concat xs ys) e
+prependVariantF (VariantF v) = VariantF (prependVariant @(ApplyAll e xs) v)
+
+
 -- | Set the first value
 toVariantFHead :: forall x xs e. x e -> VariantF (x ': xs) e
-{-# INLINE toVariantFHead #-}
+{-# INLINABLE toVariantFHead #-}
 toVariantFHead v = VariantF (toVariantHead @(x e) @(ApplyAll e xs) v)
 
 -- | Set the tail
 toVariantFTail :: forall x xs e. VariantF xs e -> VariantF (x ': xs) e
-{-# INLINE toVariantFTail #-}
+{-# INLINABLE toVariantFTail #-}
 toVariantFTail (VariantF v) = VariantF (toVariantTail @(x e) @(ApplyAll e xs) v)
 
 -- | Pop VariantF head
 popVariantFHead :: forall x xs e. VariantF (x ': xs) e -> Either (VariantF xs e) (x e)
-{-# INLINE popVariantFHead #-}
+{-# INLINABLE popVariantFHead #-}
 popVariantFHead (VariantF v) = case popVariantHead v of
    Right x -> Right x
    Left xs -> Left (VariantF xs)
@@ -254,7 +271,7 @@
 popVariantF :: forall x xs e.
    ( PopVariantF x xs e
    ) => VariantF xs e -> Either (VariantF (Remove x xs) e) (x e)
-{-# INLINE popVariantF #-}
+{-# INLINABLE popVariantF #-}
 popVariantF (VariantF v) = case popVariant v of
    Right x -> Right x
    Left xs -> Left (VariantF xs)
@@ -282,77 +299,6 @@
    ) => VariantF as e -> VariantF bs e
 liftVariantF (VariantF v) = VariantF (liftVariant' v)
 
-class AlterVariantF (c :: (* -> *) -> Constraint) e (xs :: [* -> *]) where
-   alterVariantF' :: (forall (f :: * -> *). c f => f e -> f e) -> Word -> Any -> Any
-
-instance AlterVariantF c e '[] where
-   {-# INLINE alterVariantF' #-}
-   alterVariantF' _ = undefined
-
-instance
-   ( AlterVariantF c e xs
-   , c x
-   ) => AlterVariantF c e (x ': xs)
-   where
-      {-# INLINE alterVariantF' #-}
-      alterVariantF' f t v =
-         case t of
-            0 -> unsafeCoerce (f (unsafeCoerce v :: x e))
-            n -> alterVariantF' @c @e @xs f (n-1) v
-
--- | Alter a variant. You need to specify the constraints required by the
--- modifying function.
---
--- Usage:
---
--- >   alterVariantF @NoConstraint id         v
--- >   alterVariantF @Resizable    (resize 4) v
--- >
--- >   -- Multiple constraints:
--- >   class (Ord a, Num a) => OrdNum a
--- >   instance (Ord a, Num a) => OrdNum a
--- >   alterVariantF @OrdNum foo v
---
-alterVariantF :: forall c e (xs :: [* -> *]).
-   ( AlterVariantF c e xs
-   ) => (forall (f :: * -> *). c f => f e -> f e) -> VariantF xs e -> VariantF xs e
-{-# INLINABLE alterVariantF #-}
-alterVariantF f (VariantF (Variant t a)) =
-   VariantF (Variant t (alterVariantF' @c @e @xs f t a))
-
-
-class AlgVariantF (c :: (* -> *) -> Constraint) e r (xs :: [* -> *]) where
-   algVariantF' :: (forall (f :: * -> *). c f => f e -> r) -> Word -> Any -> r
-
-instance AlgVariantF c e r '[] where
-   {-# INLINE algVariantF' #-}
-   algVariantF' _ = undefined
-
-instance
-   ( AlgVariantF c e r xs
-   , c x
-   ) => AlgVariantF c e r (x ': xs)
-   where
-      {-# INLINE algVariantF' #-}
-      algVariantF' f t v =
-         case t of
-            0 -> f (unsafeCoerce v :: x e)
-            n -> algVariantF' @c @e @r @xs f (n-1) v
-
--- | Apply an algebra to a VariantF. You need to specify the constraints
--- required by the modifying function.
---
--- Usage:
---
--- >  algVariantF @NoConstraint id         v
--- >  algVariantF @Resizable    (resize 4) v
---
-algVariantF :: forall c e r (xs :: [* -> *]).
-   ( AlgVariantF c e r xs
-   ) => (forall (f :: * -> *). c f => f e -> r) -> VariantF xs e -> r
-{-# INLINABLE algVariantF #-}
-algVariantF f (VariantF (Variant t a)) = algVariantF' @c @e @r @xs f t a
-
 type SplitVariantF as xs e =
    ( Complement (ApplyAll e xs) (ApplyAll e as) ~ ApplyAll e (Complement xs as)
    , SplitVariant (ApplyAll e as) (ApplyAll e (Complement xs as)) (ApplyAll e xs)
@@ -398,3 +344,74 @@
    toContM = variantFToContM
 
 deriving newtype instance (NFData (V (ApplyAll e xs))) => NFData (VariantF xs e)
+
+----------------------------------------
+-- BottomUp
+----------------------------------------
+
+type family BottomUpF c fs :: Constraint where
+   BottomUpF c fs = (Functor (VariantF fs), BottomUp c fs)
+
+class BottomUp c fs where
+   toBottomUp :: (forall f. c f => f a -> b) -> (VariantF fs a -> b)
+
+instance BottomUp c '[] where
+   {-# INLINABLE toBottomUp #-}
+   toBottomUp _f = undefined
+
+instance forall c fs f.
+   ( BottomUp c fs
+   , c f
+   ) => BottomUp c (f ':fs) where
+   {-# INLINABLE toBottomUp #-}
+   toBottomUp f v = case popVariantFHead v of
+      Right x -> f x
+      Left xs -> toBottomUp @c f xs
+
+----------------------------------------
+-- BottomUpOrig
+----------------------------------------
+
+type family BottomUpOrigF c fs :: Constraint where
+   BottomUpOrigF c fs = (Functor (VariantF fs), BottomUpOrig c fs)
+
+class BottomUpOrig c fs where
+   toBottomUpOrig :: (forall f. c f => f (t,a) -> b) -> (VariantF fs (t,a) -> b)
+
+instance BottomUpOrig c '[] where
+   {-# INLINABLE toBottomUpOrig #-}
+   toBottomUpOrig _f = undefined
+
+instance forall c fs f.
+   ( BottomUpOrig c fs
+   , c f
+   ) => BottomUpOrig c (f ': fs) where
+   {-# INLINABLE toBottomUpOrig #-}
+   toBottomUpOrig f v = case popVariantFHead v of
+      Right x -> f x
+      Left xs -> toBottomUpOrig @c f xs
+
+
+----------------------------------------
+-- TopDownStop
+----------------------------------------
+
+type family TopDownStopF c fs :: Constraint where
+   TopDownStopF c fs = (Functor (VariantF fs), TopDownStop c fs)
+
+class TopDownStop c fs where
+   toTopDownStop :: (forall f. c f => TopDownStopT a f) -> TopDownStopT a (VariantF fs)
+
+instance TopDownStop c '[] where
+   {-# INLINABLE toTopDownStop #-}
+   toTopDownStop _f = undefined
+
+instance forall c fs f.
+   ( TopDownStop c fs
+   , Functor f
+   , c f
+   ) => TopDownStop c (f ':fs) where
+   {-# INLINABLE toTopDownStop #-}
+   toTopDownStop f v = case popVariantFHead v of
+      Right x -> first toVariantFHead (f x)
+      Left xs -> first (prependVariantF @'[f]) (toTopDownStop @c f xs)
diff --git a/src/tests/EADT.hs b/src/tests/EADT.hs
--- a/src/tests/EADT.hs
+++ b/src/tests/EADT.hs
@@ -18,9 +18,15 @@
 import Test.Tasty
 import Test.Tasty.QuickCheck as QC
 
+import Haskus.Utils.Functor
 import Haskus.Utils.EADT
 import Haskus.Utils.EADT.TH
+import Haskus.Utils.Types
 
+-------------------------------
+-- List EADT
+-------------------------------
+
 data ConsF a l = ConsF a l deriving (Functor)
 data NilF    l = NilF      deriving (Functor)
 
@@ -28,18 +34,88 @@
 eadtPattern 'NilF  "Nil"
 eadtInfixPattern 'ConsF ":->"
 
-type List a = EADT '[ConsF a, NilF]
+type ListF a = VariantF '[NilF, ConsF a]
+type List  a = EADT     '[NilF, ConsF a]
 
+instance Eq a => Eq1 (ConsF a) where
+   liftEq cmp (ConsF a e1) (ConsF b e2) = a == b && cmp e1 e2
+
+instance Eq1 NilF where
+   liftEq _ _ _ = True
+
+instance Ord a => Ord1 (ConsF a) where
+   liftCompare cmp (ConsF a e1) (ConsF b e2) = compare a b <> cmp e1 e2
+
+instance Ord1 NilF where
+   liftCompare _ _ _ = EQ
+
+instance Show a => Show1 (ConsF a) where
+   liftShowsPrec shw _ p (ConsF a e) =
+      showParen (p >= 10) (showString "ConsF " . showsPrec 10 a . showString " " . shw 10 e)
+
+instance Show1 NilF where
+   liftShowsPrec _ _ _ _ = showString "NilF"
+
+-- example values:
 list0 :: List String
 list0 = Cons "Hello" $ Cons "World" Nil
 
+-------------------------------
+-- Show AlgebraC
+-------------------------------
+
+class MyShow (f :: Type -> Type) where
+   myShow :: f String -> String
+
+instance MyShow NilF where
+   myShow _ = "[]"
+
+instance Show a => MyShow (ConsF a) where
+   myShow (ConsF a b) = show a ++ " : " ++ b
+
+showBottomUp :: Show a => BottomUpT String (ListF a)
+showBottomUp = toBottomUp @MyShow myShow
+
+-------------------------------
+-- numbersTo anamorphism
+-------------------------------
+
+numbersTo :: CoAlgebra (ListF String) Int
+numbersTo 0 = FV (NilF :: NilF Int)
+numbersTo n = FV (ConsF (show n) (n-1))
+
+-------------------------------
+-- numbersToMin5 apomorphism
+-------------------------------
+
+numbersToMin5 :: RCoAlgebra (ListF String) (List String) Int
+numbersToMin5 0 = FV (NilF :: NilF (Either (List String) Int))
+numbersToMin5 n
+   | n > 5     = FV (ConsF (show n) (Right (n-1) :: Either (List String) Int))
+   | otherwise = FV (ConsF "min" (Left (Nil :: List String) :: Either (List String) Int))
+
+-------------------------------
+-- Tests
+-------------------------------
+
 testsEADT :: TestTree
 testsEADT = testGroup "EADT" $
-   [ testProperty "eadtPattern: match"              $ case list0 of
-                                                         Cons (x :: String) _ -> x == "Hello"
-                                                         _                    -> False
-   , testProperty "eadtInfixPattern: match"         $ case list0 of
-                                                         (x :: String) :-> _ -> x == "Hello"
-                                                         _                   -> False
+   [ testProperty "eadtPattern: match" $
+      case list0 of
+         Cons (x :: String) _ -> x == "Hello"
+         _                    -> False
 
+   , testProperty "eadtInfixPattern: match" $
+      case list0 of
+         (x :: String) :-> _ -> x == "Hello"
+         _                   -> False
+
+   , testProperty "catamorphism: constraint" $
+      cata showBottomUp list0 == "\"Hello\" : \"World\" : []"
+
+   , testProperty "anamorphism: numbersTo" $
+      ana numbersTo 5 == Cons "5" (Cons "4" (Cons "3" (Cons "2" (Cons "1" Nil))))
+
+   , testProperty "apomorphism: numbersToMin5" $
+      apo numbersToMin5 8 == Cons "8" (Cons "7" (Cons "6" (Cons "min" Nil)))
    ]