packages feed

haskus-utils-variant (empty) → 1.0

raw patch · 7 files changed

+3665/−0 lines, 7 filesdep +basedep +haskus-utils-datadep +haskus-utils-types

Dependencies added: base, haskus-utils-data, haskus-utils-types

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2013-2017, Haskus organization+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above copyright+      notice, this list of conditions and the following disclaimer in the+      documentation and/or other materials provided with the distribution.++    * Neither the name of Sylvain Henry nor the names of other contributors +      may be used to endorse or promote products derived from this software +      without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER BE LIABLE FOR ANY DIRECT,+INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ haskus-utils-variant.cabal view
@@ -0,0 +1,35 @@+name: haskus-utils-variant+version: 1.0+cabal-version: >=1.20+build-type: Simple+license: BSD3+license-file: LICENSE+copyright: Sylvain Henry 2018+maintainer: sylvain@haskus.fr+homepage: http://www.haskus.org+synopsis: Haskus utility modules+description:+    Variant (extensible sum type) and EADT (extensible recursive sum type)+    datatypes.+category: System+author: Sylvain Henry++source-repository head+    type: git+    location: git://github.com/haskus/haskus-utils.git++library+    exposed-modules:+        Haskus.Utils.ContFlow+        Haskus.Utils.Variant+        Haskus.Utils.Variant.Flow+        Haskus.Utils.Variant.Cont+        Haskus.Utils.EADT+    build-depends:+        base >=4.9 && <4.12,+        haskus-utils-types ==1.0.*,+        haskus-utils-data ==1.0.*+    default-language: Haskell2010+    hs-source-dirs: src/lib+    ghc-options: -Wall+
+ src/lib/Haskus/Utils/ContFlow.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE BangPatterns #-}++-- | Continuation based control-flow+module Haskus.Utils.ContFlow+   ( ContFlow (..)+   , (>::>)+   , (>:-:>)+   , (>:%:>)+   , ContListToTuple+   , ContTupleToList+   , StripR+   , AddR+   )+where++import Haskus.Utils.Tuple+import Haskus.Utils.Types++-- | A continuation based control-flow+newtype ContFlow (xs :: [*]) r = ContFlow (ContListToTuple 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)++-- | 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 AddR f r where+   AddR '[] r       = '[]+   AddR (x ': xs) r = (x -> r) ': AddR xs r++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 "'")++-- | Bind a flow to a tuple of continuations+(>::>) :: ContFlow xs r -> ContListToTuple xs r -> r+{-# INLINE (>::>) #-}+(>::>) (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)++infixl 0 >:-:>++-- | Bind a flow to a tuple of continuations and+-- reorder fields if necessary+(>:%:>) :: forall ts xs r.+   ( ReorderTuple ts (ContListToTuple xs r)+   ) => ContFlow xs r -> ts -> r+{-# INLINE (>:%:>) #-}+(>:%:>) (ContFlow f) !cs = f (tupleReorder cs)++infixl 0 >:%:>++
+ src/lib/Haskus/Utils/EADT.hs view
@@ -0,0 +1,178 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ConstraintKinds #-}++-- | Extensible ADT+module Haskus.Utils.EADT+   ( VariantF (..)+   , ApplyAll+   , pattern FV+   , appendVariantF+   , toVariantFHead+   , toVariantFTail+   , popVariantFHead+   , popVariantF+   , mapVariantF+   , variantFToValue+   , LiftableF+   , liftVariantF+   -- * Extensible ADT+   , EADT+   , (:<:)+   , pattern VF+   , appendEADT+   , liftEADT+   , popEADT+   -- * Reexport+   , module Haskus.Utils.Functor+   )+where++import Haskus.Utils.Variant+import Haskus.Utils.Functor+import Haskus.Utils.Types.List+import Haskus.Utils.Types++-- | Recursive Functor-like Variant+newtype VariantF (xs :: [* -> *]) e+   = VariantF (V (ApplyAll e xs))++-- | `ApplyAll e '[f,g,h] ==> '[f e, g e, h e]`+type family ApplyAll e (xs :: [* -> *]) :: [*] where+   ApplyAll e '[]       = '[]+   ApplyAll e (f ': fs) = f e ': ApplyAll e fs++instance (Show (V (ApplyAll e xs))) => Show (VariantF xs e) where+   show (VariantF x) = show x+deriving instance (Eq (V (ApplyAll e xs))) => Eq (VariantF xs e)+deriving instance (Ord (V (ApplyAll e xs))) => Ord (VariantF xs e)++instance Functor (VariantF '[]) where+   fmap _ = undefined++instance (Functor (VariantF fs), Functor f) => Functor (VariantF (f ': fs)) where+   fmap f (VariantF v) = case popVariantHead v of+      Right x -> toVariantFHead (fmap f x)+      Left xs -> toVariantFTail (fmap f (VariantF xs))++-- | Pattern-match in a VariantF+pattern FV :: forall c cs e. Popable c (ApplyAll e cs) => c -> VariantF cs e+pattern FV x = VariantF (V x)++-- | Retrieve a single value+variantFToValue :: VariantF '[f] e -> f e+variantFToValue (VariantF v) = variantToValue v++appendVariantF :: forall (ys :: [* -> *]) (xs :: [* -> *]) e.+   ( ApplyAll e (Concat xs ys) ~ Concat (ApplyAll e xs) (ApplyAll e ys)+   ) => VariantF xs e -> VariantF (Concat xs ys) e+appendVariantF (VariantF v) = VariantF (appendVariant @(ApplyAll e ys) v)++-- | Set the first value+toVariantFHead :: forall x xs e. x e -> VariantF (x ': xs) e+{-# INLINE 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 #-}+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 #-}+popVariantFHead (VariantF v) = case popVariantHead v of+   Right x -> Right x+   Left xs -> Left (VariantF xs)++-- | Pop VariantF+popVariantF :: forall x xs ys e.+   ( Popable (x e) (ApplyAll e xs)+   , Filter (x e) (ApplyAll e xs) ~ ApplyAll e ys+   ) => VariantF xs e -> Either (VariantF ys e) (x e)+{-# INLINE popVariantF #-}+popVariantF (VariantF v) = case popVariant v of+   Right x -> Right x+   Left xs -> Left (VariantF xs)++-- | Map the matching types of a variant+mapVariantF :: forall a b cs e ds as.+   ( MappableVariant (a e) (b e) as+   , ds ~ ReplaceNS (IndexesOf a cs) b cs+   , as ~ ApplyAll e cs+   , ApplyAll e ds ~ ReplaceNS (IndexesOf (a e) as) (b e) as+   ) => (a e -> b e) -> VariantF cs e -> VariantF ds e+mapVariantF f (VariantF v) = VariantF (mapVariant @(a e) @(b e) @as f v)++-- | xs is liftable in ys+type LiftableF e xs ys =+   ( IsSubset xs ys ~ 'True+   , LiftVariant (ApplyAll e xs) (ApplyAll e ys)+   )++-- | Lift a VariantF into another+liftVariantF :: forall e as bs.+   ( LiftableF e as bs+   ) => VariantF as e -> VariantF bs e+liftVariantF (VariantF v) = VariantF (liftVariant' v)++--------------------------------------------+-- Extensible ADT+--------------------------------------------++-- | An extensible ADT+type EADT xs = Fix (VariantF xs)++type family f :<: xs where+   f :<: xs = EADTF' f (EADT xs) xs++type EADTF' f e cs =+   ( Member' f cs+   , Index (IndexOf (f e) (ApplyAll e cs)) (ApplyAll e cs) ~ f e+   , PopVariant (f e) (ApplyAll e cs)+   , KnownNat (IndexOf (f e) (ApplyAll e cs))+   )++-- | Pattern-match in an extensible ADT+pattern VF :: forall e f cs.+   ( 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 (V' x))   -- `V'` match a variant value (without+                                       -- checking the membership: we already+                                       -- do it with :<:)++-- | Append new "constructors" to the EADT+appendEADT :: forall ys xs zs.+   ( zs ~ Concat xs ys+   , 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))++-- | Lift an EADT into another+liftEADT :: forall e as bs.+   ( e ~ Fix (VariantF bs)+   , LiftableF e as bs+   , Functor (VariantF as)+   ) => EADT as -> EADT bs+liftEADT = cata (Fix . liftVariantF)++-- | Pop an EADT value+popEADT :: forall xs f e.+   ( f :<: xs+   , e ~ EADT xs+   , Popable (f e) (ApplyAll e xs)+   , Filter (f e) (ApplyAll e xs) ~ ApplyAll e (Filter f xs)+   ) => EADT xs -> Either (VariantF (Filter f xs) (EADT xs)) (f (EADT xs))+popEADT (Fix v) = popVariantF v
+ src/lib/Haskus/Utils/Variant.hs view
@@ -0,0 +1,1269 @@+{-# 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 #-}++-- | Open sum type+module Haskus.Utils.Variant+   ( Variant+   , V+   , variantIndex+   -- * Patterns+   , pattern V+   , pattern VMaybe+   , (:<)+   , (:<?)+   -- * Operations by index+   , toVariantAt+   , toVariantHead+   , toVariantTail+   , fromVariantAt+   , popVariantAt+   , popVariantHead+   , updateVariantAt+   , foldMapVariantAt+   , foldMapVariantAtM+   -- * Operations by type+   , toVariant+   , Member+   , Filter+   , Popable+   , MaybePopable+   , popVariant+   , popVariantMaybe+   , fromVariant+   , fromVariantMaybe+   , fromVariantFirst+   , updateVariantFirst+   , updateVariantFirstM+   , MappableVariant+   , mapVariant+   , foldMapVariantFirst+   , foldMapVariantFirstM+   , foldMapVariant+   -- * Generic operations with type classes+   , AlterVariant+   , TraverseVariant+   , NoConstraint+   , alterVariant+   , traverseVariant+   , traverseVariant_+   -- * Conversions between variants+   , appendVariant+   , prependVariant+   , Liftable+   , liftVariant+   , nubVariant+   , productVariant+   , Flattenable+   , FlattenVariant+   , flattenVariant+   , ExtractMonad+   , joinVariant+   -- * Conversions to/from other data types+   , variantToValue+   , variantFromValue+   , variantToEither+   , variantFromEither+   , variantToHList+   , variantToTuple+   -- ** Continuations+   , ContVariant (..)+   -- ** Internals+   , pattern V'+   , liftVariant'+   , fromVariant'+   , popVariant'+   , toVariant'+   , LiftVariant+   , PopVariant+   )+where++import Unsafe.Coerce+import GHC.Exts (Any,Constraint)++import Haskus.Utils.Monad+import Haskus.Utils.Types+import Haskus.Utils.Tuple+import Haskus.Utils.HList+import Haskus.Utils.ContFlow+import Haskus.Utils.Types.List++-- | A variant contains a value whose type is at the given position in the type+-- list+data Variant (l :: [*]) = Variant {-# UNPACK #-} !Word Any++type V = Variant++-- Make GHC consider `l` as a representational parameter to make coercions+-- between Variant values unsafe+type role Variant representational++-- | Pattern synonym for Variant+--+-- Usage: case v of+--          V (x :: Int)    -> ...+--          V (x :: String) -> ...+pattern V :: forall c cs. Popable c cs => c -> Variant cs+pattern V x <- (fromVariant -> Just x)+   where+      V x = toVariant x++-- | Silent pattern synonym for Variant+--+-- Usage: case v of+--          V (x :: Int)    -> ...+--          V (x :: String) -> ...+pattern V' :: forall c cs.+   ( Member' c cs+   , PopVariant c cs+   ) => c -> Variant cs+pattern V' x <- (fromVariant' -> Just x)+   where+      V' x = toVariant' x++-- | Statically unchecked matching on a Variant+pattern VMaybe :: forall c cs. (MaybePopable c cs) => c -> Variant cs+pattern VMaybe x <- (fromVariantMaybe -> Just x)++instance Eq (Variant '[]) where+   (==) = error "Empty variant"++instance+   ( Eq (Variant xs)+   , Eq x+   ) => Eq (Variant (x ': xs))+   where+      {-# INLINE (==) #-}+      (==) v1@(Variant t1 _) v2@(Variant t2 _)+         | t1 /= t2  = False+         | otherwise = case (popVariantHead v1, popVariantHead v2) of+            (Right a, Right b) -> a == b+            (Left as, Left bs) -> as == bs+            _                  -> False++instance Ord (Variant '[]) where+   compare = error "Empty variant"++instance+   ( Ord (Variant xs)+   , Ord x+   ) => Ord (Variant (x ': xs))+   where+      compare v1 v2 = case (popVariantHead v1, popVariantHead v2) of+         (Right a, Right b) -> compare a b+         (Left as, Left bs) -> compare as bs+         (Right _, Left _)  -> LT+         (Left _, Right _)  -> GT++instance Show (Variant '[]) where+   show = error "Empty variant"++instance+   ( Show (Variant xs)+   , Show x+   ) => Show (Variant (x ': xs))+   where+      show v = case popVariantHead v of+         Right x -> show x+         Left xs -> show xs++-----------------------------------------------------------+-- Operations by index+-----------------------------------------------------------++-- | Get Variant index+variantIndex :: Variant a -> Word+variantIndex (Variant n _) = n++-- | Set the value with the given indexed type+toVariantAt :: forall (n :: Nat) (l :: [*]).+   ( KnownNat n+   ) => Index n l -> Variant l+{-# INLINE toVariantAt #-}+toVariantAt a = Variant (natValue' @n) (unsafeCoerce a)++-- | Set the first value+toVariantHead :: forall x xs. x -> Variant (x ': xs)+{-# INLINE toVariantHead #-}+toVariantHead a = Variant 0 (unsafeCoerce a)++-- | Set the tail+toVariantTail :: forall x xs. Variant xs -> Variant (x ': xs)+{-# INLINE toVariantTail #-}+toVariantTail (Variant t a) = Variant (t+1) a++-- | Get the value if it has the indexed type+fromVariantAt :: forall (n :: Nat) (l :: [*]).+   ( KnownNat n+   ) => Variant l -> Maybe (Index n l)+{-# INLINE fromVariantAt #-}+fromVariantAt (Variant t a) = do+   guard (t == natValue' @n)+   return (unsafeCoerce a) -- we know it is the effective type++-- | Pop a variant value by index, return either the value or the remaining+-- variant+popVariantAt :: forall (n :: Nat) l. +   ( KnownNat n+   ) => Variant l -> Either (Variant (RemoveAt n l)) (Index n l)+{-# INLINE popVariantAt #-}+popVariantAt v@(Variant t a) = case fromVariantAt @n v of+   Just x  -> Right x+   Nothing -> Left $ if t > natValue' @n+      then Variant (t-1) a+      else Variant t a++-- | Pop the head of a variant value+popVariantHead :: forall x xs. Variant (x ': xs) -> Either (Variant xs) x+{-# INLINE popVariantHead #-}+popVariantHead v@(Variant t a) = case fromVariantAt @0 v of+   Just x  -> Right x+   Nothing -> Left $ Variant (t-1) a++-- | Update a variant value+updateVariantAt :: forall (n :: Nat) a b l.+   ( KnownNat n+   , a ~ Index n l+   ) => (a -> b) -> Variant l -> Variant (ReplaceN n b l)+{-# INLINE updateVariantAt #-}+updateVariantAt f v@(Variant t a) =+   case fromVariantAt @n v of+      Nothing -> Variant t a+      Just x  -> Variant t (unsafeCoerce (f x))++-----------------------------------------------------------+-- Operations by type+-----------------------------------------------------------++-- | Put a value into a Variant+--+-- Use the first matching type index.+toVariant :: forall a l.+   ( Member a l+   ) => a -> Variant l+{-# INLINE toVariant #-}+toVariant = toVariantAt @(IndexOf a l)++-- | Put a value into a Variant (silent)+--+-- Use the first matching type index.+toVariant' :: forall a l.+   ( Member' a l+   ) => a -> Variant l+{-# INLINE toVariant' #-}+toVariant' = toVariantAt @(IndexOf a l)++class PopVariant a xs where+   -- | Remove a type from a variant+   popVariant' :: Variant xs -> Either (Variant (Filter a xs)) a++instance PopVariant a '[] where+   popVariant' _ = undefined++instance forall a xs n xs' y ys.+      ( PopVariant a xs'+      , n ~ MaybeIndexOf a xs+      , xs' ~ RemoveAt1 n xs+      , Filter a xs' ~ Filter a xs+      , KnownNat n+      , xs ~ (y ': ys)+      ) => PopVariant a (y ': ys)+   where+      {-# INLINE popVariant' #-}+      popVariant' (Variant t a)+         = case natValue' @n of+            0             -> Left (Variant t a) -- no 'a' left in xs+            n | n-1 == t  -> Right (unsafeCoerce a)+              | n-1 < t   -> popVariant' @a @xs' (Variant (t-1) a)+              | otherwise -> Left (Variant t a)++-- | a is popable in xs+type Popable a xs =+   ( Member a xs+   , PopVariant a xs+   )++-- | a may be popable in xs+type MaybePopable a xs =+   ( PopVariant a xs+   )++type (:<) a xs  = Popable a xs+type (:<?) a xs = MaybePopable a xs+++-- | Extract a type from a variant. Return either the value of this type or the+-- remaining variant+popVariant :: forall a xs.+   ( Popable a xs+   ) => Variant xs -> Either (Variant (Filter a xs)) a+popVariant v = popVariant' @a v++-- | Extract a type from a variant. Return either the value of this type or the+-- remaining variant+popVariantMaybe :: forall a xs.+   ( MaybePopable a xs+   ) => Variant xs -> Either (Variant (Filter a xs)) a+popVariantMaybe v = popVariant' @a v++-- | Pick the first matching type of a Variant+--+-- fromVariantFirst @A (Variant 2 undefined :: Variant '[A,B,A]) == Nothing+fromVariantFirst :: forall a l.+   ( Member a l+   ) => Variant l -> Maybe a+{-# INLINE fromVariantFirst #-}+fromVariantFirst = fromVariantAt @(IndexOf a l)++-- | Try to a get a value of a given type from a Variant+fromVariant :: forall a xs.+   ( Popable a xs+   ) => Variant xs -> Maybe a+{-# INLINE fromVariant #-}+fromVariant v = case popVariant v of+   Right a -> Just a+   Left _  -> Nothing++-- | Try to a get a value of a given type from a Variant (silent)+fromVariant' :: forall a xs.+   ( PopVariant a xs+   ) => Variant xs -> Maybe a+{-# INLINE fromVariant' #-}+fromVariant' v = case popVariant' v of+   Right a -> Just a+   Left _  -> Nothing++-- | Try to a get a value of a given type from a Variant that may not even+-- support the given type.+fromVariantMaybe :: forall a xs.+   ( MaybePopable a xs+   ) => Variant xs -> Maybe a+{-# INLINE fromVariantMaybe #-}+fromVariantMaybe v = case popVariantMaybe v of+   Right a -> Just a+   Left _  -> Nothing++-- | Update a variant value+updateVariantFirst :: forall a b n l.+   ( Member a l+   , n ~ IndexOf a l+   ) => (a -> b) -> Variant l -> Variant (ReplaceN n b l)+{-# INLINE updateVariantFirst #-}+updateVariantFirst f v = updateVariantAt @n f v++-- | Monadic update of the first matching variant value+updateVariantFirstM :: forall (n :: Nat) l l2 m .+   (KnownNat n, Monad m)+   => (Index n l -> m (Index n l2)) -> Variant l -> m (Variant l2)+{-# INLINE updateVariantFirstM #-}+updateVariantFirstM f v@(Variant t a) =+   case fromVariantAt @n v of+      Nothing -> return (Variant t a)+      Just x  -> Variant t <$> unsafeCoerce (f x)++class MapVariant a b cs (is :: [Nat]) where+   mapVariant' :: (a -> b) -> Variant cs -> Variant (ReplaceNS is b cs)++instance MapVariant a b '[] is where+   {-# INLINE mapVariant' #-}+   mapVariant' = undefined++instance MapVariant a b cs '[] where+   {-# INLINE mapVariant' #-}+   mapVariant' _ v = v++instance forall a b cs is i.+   ( MapVariant a b (ReplaceN i b cs) is+   , a ~ Index i cs+   , KnownNat i+   ) => MapVariant a b cs (i ': is) where+   {-# INLINE mapVariant' #-}+   mapVariant' f v = mapVariant' @a @b @(ReplaceN i b cs) @is f (updateVariantAt @i f v)++type MappableVariant a b cs =+   ( MapVariant a b cs (IndexesOf a cs)+   )++-- | Map the matching types of a variant+mapVariant :: forall a b cs.+   ( MappableVariant a b cs+   ) => (a -> b) -> Variant cs -> Variant (ReplaceNS (IndexesOf a cs) b cs)+mapVariant = mapVariant' @a @b @cs @(IndexesOf a cs)+++-- | Update a variant value with a variant and fold the result+foldMapVariantAt :: forall (n :: Nat) l l2 .+   ( KnownNat n+   , KnownNat (Length l2)+   ) => (Index n l -> Variant l2) -> Variant l -> Variant (ReplaceAt n l l2)+foldMapVariantAt f v@(Variant t a) =+   case fromVariantAt @n v of+      Nothing ->+         -- we need to adapt the tag if new valid tags (from l2) are added before+         if t < n+            then Variant t a+            else Variant (t+nl2-1) a++      Just x  -> case f x of+         Variant t2 a2 -> Variant (t2+n) a2+   where+      n   = natValue' @n+      nl2 = natValue' @(Length l2)++-- | Update a variant value with a variant and fold the result+foldMapVariantAtM :: forall (n :: Nat) m l l2.+   ( KnownNat n+   , KnownNat (Length l2)+   , Monad m+   ) => (Index n l -> m (Variant l2)) -> Variant l -> m (Variant (ReplaceAt n l l2))+foldMapVariantAtM f v@(Variant t a) =+   case fromVariantAt @n v of+      Nothing ->+         -- we need to adapt the tag if new valid tags (from l2) are added before+         return $ if t < n+            then Variant t a+            else Variant (t+nl2-1) a++      Just x  -> do+         y <- f x+         case y of+            Variant t2 a2 -> return (Variant (t2+n) a2)+   where+      n   = natValue' @n+      nl2 = natValue' @(Length l2)++-- | Update a variant value with a variant and fold the result+foldMapVariantFirst :: forall a (n :: Nat) l l2 .+   ( KnownNat n+   , KnownNat (Length l2)+   , n ~ IndexOf a l+   , a ~ Index n l+   ) => (a -> Variant l2) -> Variant l -> Variant (ReplaceAt n l l2)+foldMapVariantFirst f v = foldMapVariantAt @n f v++-- | Update a variant value with a variant and fold the result+foldMapVariantFirstM :: forall a (n :: Nat) l l2 m.+   ( KnownNat n+   , KnownNat (Length l2)+   , n ~ IndexOf a l+   , a ~ Index n l+   , Monad m+   ) => (a -> m (V l2)) -> V l -> m (V (ReplaceAt n l l2))+foldMapVariantFirstM f v = foldMapVariantAtM @n f v++++-- | Update a variant value with a variant and fold the result+foldMapVariant :: forall a cs ds i.+   ( i ~ IndexOf a cs+   , Popable a cs+   ) => (a -> V ds) -> V cs -> V (InsertAt i (Filter a cs) ds)+foldMapVariant f v = case popVariant v of+   Right a -> case f a of+      Variant t x -> Variant (i + t) x+   Left (Variant t x)+      | t < i     -> Variant t x+      | otherwise -> Variant (i+t) x+   where+      i = natValue' @i+++++-----------------------------------------------------------+-- Generic operations with type classes+-----------------------------------------------------------++class AlterVariant c (b :: [*]) where+   alterVariant' :: Alter c -> Word -> Any -> Any++instance AlterVariant c '[] where+   {-# INLINE alterVariant' #-}+   alterVariant' = undefined++instance+   ( AlterVariant c xs+   , c x+   ) => AlterVariant c (x ': xs)+   where+      {-# INLINE alterVariant' #-}+      alterVariant' m@(Alter f) t v =+         case t of+            0 -> unsafeCoerce (f (unsafeCoerce v :: x))+            n -> alterVariant' @c @xs m (n-1) v++-- | Wrap a function and its constraints+data Alter (c :: * -> Constraint) = Alter (forall a. c a => a -> a)++-- | Wrap a function and its constraints+data AlterM (c :: * -> Constraint) m = AlterM (forall a. (Monad m, c a) => a -> m a)++-- | Useful to specify a "* -> Constraint" function returning no constraint+class NoConstraint a+instance NoConstraint a++class TraverseVariant c (b :: [*]) m where+   traverseVariant' :: AlterM c m -> Word -> Any -> m Any++instance TraverseVariant c '[] m where+   {-# INLINE traverseVariant' #-}+   traverseVariant' = undefined++instance+   ( TraverseVariant c xs m+   , c x+   , Monad m+   ) => TraverseVariant c (x ': xs) m+   where+      {-# INLINE traverseVariant' #-}+      traverseVariant' m@(AlterM f) t v =+         case t of+            0 -> unsafeCoerce <$> f (unsafeCoerce v :: x)+            n -> traverseVariant' @c @xs m (n-1) v+++-- | Alter a variant. You need to specify the constraints required by the+-- modifying function.+--+-- Usage:+--    alterVariant @NoConstraint id         v+--    alterVariant @Resizable    (resize 4) v+--+--    class (Ord a, Num a) => OrdNum a+--    instance (Ord a, Num a) => OrdNum a+--+{-# INLINE alterVariant #-}+alterVariant :: forall c (a :: [*]).+   ( AlterVariant c a+   ) => (forall x. c x => x -> x) -> Variant a  -> Variant a+alterVariant f (Variant t a) = +   Variant t (alterVariant' @c @a (Alter @c f) t a)++-- | Traverse a variant. You need to specify the constraints required by the+-- modifying function.+{-# INLINE traverseVariant #-}+traverseVariant :: forall c (a :: [*]) m.+   ( TraverseVariant c a m+   , Monad m+   ) => (forall x. c x => x -> m x) -> Variant a  -> m (Variant a)+traverseVariant f (Variant t a) = +   Variant t <$> traverseVariant' @c @a (AlterM @c @m f) t a++-- | Traverse a variant. You need to specify the constraints required by the+-- modifying function.+traverseVariant_ :: forall c (a :: [*]) m.+   ( TraverseVariant c a m+   , Monad m+   ) => (forall x. c x => x -> m ()) -> Variant a  -> m ()+traverseVariant_ f v = void (traverseVariant @c @a f' v)+   where+      f' :: forall x. c x => x -> m x+      f' x = f x >> return x++-----------------------------------------------------------+-- Conversions between variants+-----------------------------------------------------------++-- | Extend a variant by appending other possible values+appendVariant :: forall (ys :: [*]) (xs :: [*]). Variant xs -> Variant (Concat xs ys)+{-# INLINE appendVariant #-}+appendVariant (Variant t a) = Variant t a++-- | Extend a variant by prepending other possible values+prependVariant :: forall (ys :: [*]) (xs :: [*]).+   ( KnownNat (Length ys)+   ) => Variant xs -> Variant (Concat ys xs)+{-# INLINE prependVariant #-}+prependVariant (Variant t a) = Variant (n+t) a+   where+      n = natValue' @(Length ys)++-- | xs is liftable in ys+type Liftable xs ys =+   ( IsSubset xs ys ~ 'True+   , LiftVariant xs ys+   )++class LiftVariant xs ys where+   liftVariant' :: Variant xs -> Variant ys++instance LiftVariant '[] ys where+   liftVariant' = error "Lifting empty variant"++instance forall xs ys x.+      ( LiftVariant xs ys+      , KnownNat (IndexOf x ys)+      ) => LiftVariant (x ': xs) ys+   where+      {-# INLINE liftVariant' #-}+      liftVariant' (Variant t a)+         | t == 0    = Variant (natValue' @(IndexOf x ys)) a+         | otherwise = liftVariant' @xs (Variant (t-1) a)+++-- | Lift a variant into another+--+-- Set values to the first matching type+liftVariant :: forall xs ys.+   ( Liftable xs ys+   ) => Variant xs -> Variant ys+{-# INLINE liftVariant #-}+liftVariant = liftVariant'++-- | Nub the type list+nubVariant :: (Liftable xs (Nub xs)) => V xs -> V (Nub xs)+nubVariant = liftVariant++-- | Product of two variants+productVariant :: forall xs ys.+   ( KnownNat (Length ys)+   ) => Variant xs -> Variant ys -> Variant (Product xs ys)+productVariant (Variant n1 a1) (Variant n2 a2)+   = Variant (n1 * natValue @(Length ys) + n2) (unsafeCoerce (a1,a2))++type family FlattenVariant (xs :: [*]) :: [*] where+   FlattenVariant '[]             = '[]+   FlattenVariant (Variant xs:ys) = Concat xs (FlattenVariant ys)+   FlattenVariant (y:ys)          = y ': FlattenVariant ys++class Flattenable a rs where+   toFlattenVariant :: Word -> a -> rs++instance Flattenable (Variant '[]) rs where+   {-# INLINE toFlattenVariant #-}+   toFlattenVariant _ _ = undefined++instance forall xs ys rs.+   ( Flattenable (Variant ys) (Variant rs)+   , KnownNat (Length xs)+   ) => Flattenable (Variant (Variant xs ': ys)) (Variant rs)+   where+   {-# INLINE toFlattenVariant #-}+   toFlattenVariant i v = case popVariantHead v of+      Right (Variant n a) -> Variant (i+n) a+      Left vys            -> toFlattenVariant (i+natValue @(Length xs)) vys++-- | Flatten variants in a variant+flattenVariant :: forall xs.+   ( Flattenable (Variant xs) (Variant (FlattenVariant xs))+   ) => Variant xs -> Variant (FlattenVariant xs)+flattenVariant v = toFlattenVariant 0 v++type family ExtractMonad m f where+   ExtractMonad m '[m x]      = '[x]+   ExtractMonad m (m x ': xs) = x ': ExtractMonad m xs++-- | Join on a variant+--+-- Transform a variant of applicatives as follow:+--    V'[m a, m b, m c] ===> m (V'[a,b,c])+--+joinVariant :: forall m xs ys.+   ( Applicative m+   , ys ~ ExtractMonad m xs+   ) => Variant xs -> m (Variant ys)+joinVariant (Variant t act) = Variant t <$> (unsafeCoerce act :: m Any)++-----------------------------------------------------------+-- Conversions to other data types+-----------------------------------------------------------++-- | Retrieve a single value+variantToValue :: Variant '[a] -> a+{-# INLINE variantToValue #-}+variantToValue (Variant _ a) = unsafeCoerce a++-- | Create a variant from a single value+variantFromValue :: a -> Variant '[a]+{-# INLINE variantFromValue #-}+variantFromValue a = Variant 0 (unsafeCoerce a)+++-- | Convert a variant of two values in a Either+variantToEither :: forall a b. Variant '[a,b] -> Either b a+variantToEither (Variant 0 a) = Right (unsafeCoerce a)+variantToEither (Variant _ a) = Left (unsafeCoerce a)++class VariantToHList xs where+   -- | Convert a variant into a HList of Maybes+   variantToHList :: Variant xs -> HList (Map Maybe xs)++instance VariantToHList '[] where+   variantToHList _ = HNil++instance+   ( VariantToHList xs+   ) => VariantToHList (x ': xs)+   where+      variantToHList v@(Variant t a) =+            fromVariantAt @0 v `HCons` variantToHList v'+         where+            v' :: Variant xs+            v' = Variant (t-1) a++-- | Get variant possible values in a tuple of Maybe types+variantToTuple :: forall l t.+   ( VariantToHList l+   , HTuple' (Map Maybe l) t+   ) => Variant l -> t+variantToTuple = hToTuple' . variantToHList+++-- | Lift an Either into a Variant (reversed order by convention)+variantFromEither :: Either a b -> Variant '[b,a]+{-# INLINE variantFromEither #-}+variantFromEither (Left a)  = toVariantAt @1 a+variantFromEither (Right b) = toVariantAt @0 b+++class ContVariant xs where+   -- | Convert a variant into a multi-continuation+   variantToCont :: Variant xs -> ContFlow xs r++   -- | Convert a variant into a multi-continuation+   variantToContM :: Monad m => m (Variant xs) -> ContFlow xs (m r)++   -- | Convert a multi-continuation into a Variant+   contToVariant :: ContFlow xs (Variant xs) -> Variant xs++   -- | Convert a multi-continuation into a Variant+   contToVariantM :: Monad m => ContFlow xs (m (Variant xs)) -> m (Variant xs)++instance ContVariant '[a] where+   {-# INLINE variantToCont #-}+   variantToCont (Variant _ a) = ContFlow $ \(Single f) ->+      f (unsafeCoerce a)++   {-# INLINE variantToContM #-}+   variantToContM act = ContFlow $ \(Single f) -> do+      Variant _ a <- act+      f (unsafeCoerce a)++   {-# INLINE contToVariant #-}+   contToVariant c = c >::>+      Single (toVariantAt @0)++   {-# INLINE contToVariantM #-}+   contToVariantM c = c >::>+      Single (return . toVariantAt @0)++instance ContVariant '[a,b] where+   {-# INLINE variantToCont #-}+   variantToCont (Variant t a) = ContFlow $ \(f1,f2) ->+      case t of+         0 -> f1 (unsafeCoerce a)+         _ -> f2 (unsafeCoerce a)++   {-# INLINE variantToContM #-}+   variantToContM act = ContFlow $ \(f1,f2) -> do+      Variant t a <- act+      case t of+         0 -> f1 (unsafeCoerce a)+         _ -> f2 (unsafeCoerce a)++   {-# INLINE contToVariant #-}+   contToVariant c = c >::>+      ( toVariantAt @0+      , toVariantAt @1+      )++   {-# INLINE contToVariantM #-}+   contToVariantM c = c >::>+      ( return . toVariantAt @0+      , return . toVariantAt @1+      )++instance ContVariant '[a,b,c] where+   {-# INLINE 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 #-}+   variantToContM act = ContFlow $ \(f1,f2,f3) -> do+      Variant t a <- act+      case t of+         0 -> f1 (unsafeCoerce a)+         1 -> f2 (unsafeCoerce a)+         _ -> f3 (unsafeCoerce a)++   {-# INLINE contToVariant #-}+   contToVariant c = c >::>+      ( toVariantAt @0+      , toVariantAt @1+      , toVariantAt @2+      )++   {-# INLINE contToVariantM #-}+   contToVariantM c = c >::>+      ( return . toVariantAt @0+      , return . toVariantAt @1+      , return . toVariantAt @2+      )++instance ContVariant '[a,b,c,d] where+   {-# INLINE variantToCont #-}+   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4) ->+      case t of+         0 -> f1 (unsafeCoerce a)+         1 -> f2 (unsafeCoerce a)+         2 -> f3 (unsafeCoerce a)+         _ -> f4 (unsafeCoerce a)++   {-# INLINE variantToContM #-}+   variantToContM act = ContFlow $ \(f1,f2,f3,f4) -> do+      Variant t a <- act+      case t of+         0 -> f1 (unsafeCoerce a)+         1 -> f2 (unsafeCoerce a)+         2 -> f3 (unsafeCoerce a)+         _ -> f4 (unsafeCoerce a)++   {-# INLINE contToVariant #-}+   contToVariant c = c >::>+      ( toVariantAt @0+      , toVariantAt @1+      , toVariantAt @2+      , toVariantAt @3+      )++   {-# INLINE contToVariantM #-}+   contToVariantM c = c >::>+      ( return . toVariantAt @0+      , return . toVariantAt @1+      , return . toVariantAt @2+      , return . toVariantAt @3+      )++instance ContVariant '[a,b,c,d,e] where+   {-# INLINE variantToCont #-}+   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5) ->+      case t of+         0 -> f1 (unsafeCoerce a)+         1 -> f2 (unsafeCoerce a)+         2 -> f3 (unsafeCoerce a)+         3 -> f4 (unsafeCoerce a)+         _ -> f5 (unsafeCoerce a)++   {-# INLINE variantToContM #-}+   variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5) -> do+      Variant t a <- act+      case t of+         0 -> f1 (unsafeCoerce a)+         1 -> f2 (unsafeCoerce a)+         2 -> f3 (unsafeCoerce a)+         3 -> f4 (unsafeCoerce a)+         _ -> f5 (unsafeCoerce a)++   {-# INLINE contToVariant #-}+   contToVariant c = c >::>+      ( toVariantAt @0+      , toVariantAt @1+      , toVariantAt @2+      , toVariantAt @3+      , toVariantAt @4+      )++   {-# INLINE contToVariantM #-}+   contToVariantM c = c >::>+      ( return . toVariantAt @0+      , return . toVariantAt @1+      , return . toVariantAt @2+      , return . toVariantAt @3+      , return . toVariantAt @4+      )++instance ContVariant '[a,b,c,d,e,f] where+   {-# INLINE variantToCont #-}+   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6) ->+      case t of+         0 -> f1 (unsafeCoerce a)+         1 -> f2 (unsafeCoerce a)+         2 -> f3 (unsafeCoerce a)+         3 -> f4 (unsafeCoerce a)+         4 -> f5 (unsafeCoerce a)+         _ -> f6 (unsafeCoerce a)++   {-# INLINE variantToContM #-}+   variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6) -> do+      Variant t a <- act+      case t of+         0 -> f1 (unsafeCoerce a)+         1 -> f2 (unsafeCoerce a)+         2 -> f3 (unsafeCoerce a)+         3 -> f4 (unsafeCoerce a)+         4 -> f5 (unsafeCoerce a)+         _ -> f6 (unsafeCoerce a)++   {-# INLINE contToVariant #-}+   contToVariant c = c >::>+      ( toVariantAt @0+      , toVariantAt @1+      , toVariantAt @2+      , toVariantAt @3+      , toVariantAt @4+      , toVariantAt @5+      )++   {-# INLINE contToVariantM #-}+   contToVariantM c = c >::>+      ( return . toVariantAt @0+      , return . toVariantAt @1+      , return . toVariantAt @2+      , return . toVariantAt @3+      , return . toVariantAt @4+      , return . toVariantAt @5+      )++instance ContVariant '[a,b,c,d,e,f,g] where+   {-# INLINE variantToCont #-}+   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7) ->+      case t of+         0 -> f1 (unsafeCoerce a)+         1 -> f2 (unsafeCoerce a)+         2 -> f3 (unsafeCoerce a)+         3 -> f4 (unsafeCoerce a)+         4 -> f5 (unsafeCoerce a)+         5 -> f6 (unsafeCoerce a)+         _ -> f7 (unsafeCoerce a)++   {-# INLINE variantToContM #-}+   variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7) -> do+      Variant t a <- act+      case t of+         0 -> f1 (unsafeCoerce a)+         1 -> f2 (unsafeCoerce a)+         2 -> f3 (unsafeCoerce a)+         3 -> f4 (unsafeCoerce a)+         4 -> f5 (unsafeCoerce a)+         5 -> f6 (unsafeCoerce a)+         _ -> f7 (unsafeCoerce a)++   {-# INLINE contToVariant #-}+   contToVariant c = c >::>+      ( toVariantAt @0+      , toVariantAt @1+      , toVariantAt @2+      , toVariantAt @3+      , toVariantAt @4+      , toVariantAt @5+      , toVariantAt @6+      )++   {-# INLINE contToVariantM #-}+   contToVariantM c = c >::>+      ( return . toVariantAt @0+      , return . toVariantAt @1+      , return . toVariantAt @2+      , return . toVariantAt @3+      , return . toVariantAt @4+      , return . toVariantAt @5+      , return . toVariantAt @6+      )++instance ContVariant '[a,b,c,d,e,f,g,h] where+   {-# INLINE variantToCont #-}+   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8) ->+      case t of+         0 -> f1 (unsafeCoerce a)+         1 -> f2 (unsafeCoerce a)+         2 -> f3 (unsafeCoerce a)+         3 -> f4 (unsafeCoerce a)+         4 -> f5 (unsafeCoerce a)+         5 -> f6 (unsafeCoerce a)+         6 -> f7 (unsafeCoerce a)+         _ -> f8 (unsafeCoerce a)++   {-# INLINE variantToContM #-}+   variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8) -> do+      Variant t a <- act+      case t of+         0 -> f1 (unsafeCoerce a)+         1 -> f2 (unsafeCoerce a)+         2 -> f3 (unsafeCoerce a)+         3 -> f4 (unsafeCoerce a)+         4 -> f5 (unsafeCoerce a)+         5 -> f6 (unsafeCoerce a)+         6 -> f7 (unsafeCoerce a)+         _ -> f8 (unsafeCoerce a)++   {-# INLINE contToVariant #-}+   contToVariant c = c >::>+      ( toVariantAt @0+      , toVariantAt @1+      , toVariantAt @2+      , toVariantAt @3+      , toVariantAt @4+      , toVariantAt @5+      , toVariantAt @6+      , toVariantAt @7+      )++   {-# INLINE contToVariantM #-}+   contToVariantM c = c >::>+      ( return . toVariantAt @0+      , return . toVariantAt @1+      , return . toVariantAt @2+      , return . toVariantAt @3+      , return . toVariantAt @4+      , return . toVariantAt @5+      , return . toVariantAt @6+      , return . toVariantAt @7+      )++instance ContVariant '[a,b,c,d,e,f,g,h,i] where+   {-# INLINE variantToCont #-}+   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9) ->+      case t of+         0 -> f1 (unsafeCoerce a)+         1 -> f2 (unsafeCoerce a)+         2 -> f3 (unsafeCoerce a)+         3 -> f4 (unsafeCoerce a)+         4 -> f5 (unsafeCoerce a)+         5 -> f6 (unsafeCoerce a)+         6 -> f7 (unsafeCoerce a)+         7 -> f8 (unsafeCoerce a)+         _ -> f9 (unsafeCoerce a)++   {-# INLINE variantToContM #-}+   variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9) -> do+      Variant t a <- act+      case t of+         0 -> f1 (unsafeCoerce a)+         1 -> f2 (unsafeCoerce a)+         2 -> f3 (unsafeCoerce a)+         3 -> f4 (unsafeCoerce a)+         4 -> f5 (unsafeCoerce a)+         5 -> f6 (unsafeCoerce a)+         6 -> f7 (unsafeCoerce a)+         7 -> f8 (unsafeCoerce a)+         _ -> f9 (unsafeCoerce a)++   {-# INLINE contToVariant #-}+   contToVariant c = c >::>+      ( toVariantAt @0+      , toVariantAt @1+      , toVariantAt @2+      , toVariantAt @3+      , toVariantAt @4+      , toVariantAt @5+      , toVariantAt @6+      , toVariantAt @7+      , toVariantAt @8+      )++   {-# INLINE contToVariantM #-}+   contToVariantM c = c >::>+      ( return . toVariantAt @0+      , return . toVariantAt @1+      , return . toVariantAt @2+      , return . toVariantAt @3+      , return . toVariantAt @4+      , return . toVariantAt @5+      , return . toVariantAt @6+      , return . toVariantAt @7+      , return . toVariantAt @8+      )++instance ContVariant '[a,b,c,d,e,f,g,h,i,j] where+   {-# INLINE variantToCont #-}+   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10) ->+      case t of+         0 -> f1  (unsafeCoerce a)+         1 -> f2  (unsafeCoerce a)+         2 -> f3  (unsafeCoerce a)+         3 -> f4  (unsafeCoerce a)+         4 -> f5  (unsafeCoerce a)+         5 -> f6  (unsafeCoerce a)+         6 -> f7  (unsafeCoerce a)+         7 -> f8  (unsafeCoerce a)+         8 -> f9  (unsafeCoerce a)+         _ -> f10 (unsafeCoerce a)++   {-# INLINE variantToContM #-}+   variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10) -> do+      Variant t a <- act+      case t of+         0 -> f1  (unsafeCoerce a)+         1 -> f2  (unsafeCoerce a)+         2 -> f3  (unsafeCoerce a)+         3 -> f4  (unsafeCoerce a)+         4 -> f5  (unsafeCoerce a)+         5 -> f6  (unsafeCoerce a)+         6 -> f7  (unsafeCoerce a)+         7 -> f8  (unsafeCoerce a)+         8 -> f9  (unsafeCoerce a)+         _ -> f10 (unsafeCoerce a)++   {-# INLINE contToVariant #-}+   contToVariant c = c >::>+      ( toVariantAt @0+      , toVariantAt @1+      , toVariantAt @2+      , toVariantAt @3+      , toVariantAt @4+      , toVariantAt @5+      , toVariantAt @6+      , toVariantAt @7+      , toVariantAt @8+      , toVariantAt @9+      )++   {-# INLINE contToVariantM #-}+   contToVariantM c = c >::>+      ( return . toVariantAt @0+      , return . toVariantAt @1+      , return . toVariantAt @2+      , return . toVariantAt @3+      , return . toVariantAt @4+      , return . toVariantAt @5+      , return . toVariantAt @6+      , return . toVariantAt @7+      , return . toVariantAt @8+      , return . toVariantAt @9+      )++instance ContVariant '[a,b,c,d,e,f,g,h,i,j,k] where+   {-# INLINE variantToCont #-}+   variantToCont (Variant t a) = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f11) ->+      case t of+         0 -> f1  (unsafeCoerce a)+         1 -> f2  (unsafeCoerce a)+         2 -> f3  (unsafeCoerce a)+         3 -> f4  (unsafeCoerce a)+         4 -> f5  (unsafeCoerce a)+         5 -> f6  (unsafeCoerce a)+         6 -> f7  (unsafeCoerce a)+         7 -> f8  (unsafeCoerce a)+         8 -> f9  (unsafeCoerce a)+         9 -> f10 (unsafeCoerce a)+         _ -> f11 (unsafeCoerce a)++   {-# INLINE variantToContM #-}+   variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f11) -> do+      Variant t a <- act+      case t of+         0 -> f1  (unsafeCoerce a)+         1 -> f2  (unsafeCoerce a)+         2 -> f3  (unsafeCoerce a)+         3 -> f4  (unsafeCoerce a)+         4 -> f5  (unsafeCoerce a)+         5 -> f6  (unsafeCoerce a)+         6 -> f7  (unsafeCoerce a)+         7 -> f8  (unsafeCoerce a)+         8 -> f9  (unsafeCoerce a)+         9 -> f10 (unsafeCoerce a)+         _ -> f11 (unsafeCoerce a)++   {-# INLINE contToVariant #-}+   contToVariant c = c >::>+      ( toVariantAt @0+      , toVariantAt @1+      , toVariantAt @2+      , toVariantAt @3+      , toVariantAt @4+      , toVariantAt @5+      , toVariantAt @6+      , toVariantAt @7+      , toVariantAt @8+      , toVariantAt @9+      , toVariantAt @10+      )++   {-# INLINE contToVariantM #-}+   contToVariantM c = c >::>+      ( return . toVariantAt @0+      , return . toVariantAt @1+      , return . toVariantAt @2+      , return . toVariantAt @3+      , return . toVariantAt @4+      , return . toVariantAt @5+      , return . toVariantAt @6+      , return . toVariantAt @7+      , return . toVariantAt @8+      , return . toVariantAt @9+      , return . toVariantAt @10+      )++instance ContVariant '[a,b,c,d,e,f,g,h,i,j,k,l] where+   {-# INLINE 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)+         1  -> f2  (unsafeCoerce a)+         2  -> f3  (unsafeCoerce a)+         3  -> f4  (unsafeCoerce a)+         4  -> f5  (unsafeCoerce a)+         5  -> f6  (unsafeCoerce a)+         6  -> f7  (unsafeCoerce a)+         7  -> f8  (unsafeCoerce a)+         8  -> f9  (unsafeCoerce a)+         9  -> f10 (unsafeCoerce a)+         10 -> f11 (unsafeCoerce a)+         _  -> f12 (unsafeCoerce a)++   {-# INLINE variantToContM #-}+   variantToContM act = ContFlow $ \(f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f11,f12) -> do+      Variant t a <- act+      case t of+         0  -> f1  (unsafeCoerce a)+         1  -> f2  (unsafeCoerce a)+         2  -> f3  (unsafeCoerce a)+         3  -> f4  (unsafeCoerce a)+         4  -> f5  (unsafeCoerce a)+         5  -> f6  (unsafeCoerce a)+         6  -> f7  (unsafeCoerce a)+         7  -> f8  (unsafeCoerce a)+         8  -> f9  (unsafeCoerce a)+         9  -> f10 (unsafeCoerce a)+         10 -> f11 (unsafeCoerce a)+         _  -> f12 (unsafeCoerce a)++   {-# INLINE contToVariant #-}+   contToVariant c = c >::>+      ( toVariantAt @0+      , toVariantAt @1+      , toVariantAt @2+      , toVariantAt @3+      , toVariantAt @4+      , toVariantAt @5+      , toVariantAt @6+      , toVariantAt @7+      , toVariantAt @8+      , toVariantAt @9+      , toVariantAt @10+      , toVariantAt @11+      )++   {-# INLINE contToVariantM #-}+   contToVariantM c = c >::>+      ( return . toVariantAt @0+      , return . toVariantAt @1+      , return . toVariantAt @2+      , return . toVariantAt @3+      , return . toVariantAt @4+      , return . toVariantAt @5+      , return . toVariantAt @6+      , return . toVariantAt @7+      , return . toVariantAt @8+      , return . toVariantAt @9+      , return . toVariantAt @10+      , return . toVariantAt @11+      )
+ src/lib/Haskus/Utils/Variant/Cont.hs view
@@ -0,0 +1,100 @@+{-# 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.Types.List+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+   , Member 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+   , Member 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
+ src/lib/Haskus/Utils/Variant/Flow.hs view
@@ -0,0 +1,1981 @@+{-# 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+module Haskus.Utils.Variant.Flow+   ( Flow+   , IOV+   -- * Flow utils+   , flowRes+   , flowSingle+   , flowSetN+   , flowSet+   , flowLift+   , flowToCont+   , flowTraverse+   , flowFor+   , flowTraverseFilter+   , flowForFilter+   , Liftable+   , Popable+   , MaybePopable+   -- * 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.Types.List+import Haskus.Utils.ContFlow+import Haskus.Utils.Tuple++-- | Control-flow+type Flow m (l :: [*]) = m (Variant 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+{-# INLINE flowSetN #-}+flowSetN = return . toVariantAt @n++-- | Return in the first well-typed element+flowSet :: (Member x xs, Monad m) => x -> Flow m xs+{-# INLINE flowSet #-}+flowSet = return . toVariant++-- | Return a single element+flowSingle :: Monad m => x -> Flow m '[x]+{-# INLINE flowSingle #-}+flowSingle = flowSetN @0++-- | Lift a flow into another+flowLift :: (Liftable xs ys , Monad m) => Flow m xs -> Flow m ys+{-# INLINE 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+{-# INLINE flowRes #-}+flowRes = fmap variantToValue+++-- | Lift an operation on a Variant into an operation on a flow+liftm :: Monad m => (Variant x -> a -> m b) -> Flow m x -> a -> m b+{-# INLINE 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)+{-# INLINE flowMap #-}+flowMap = (>.-.>)++-- | Bind two flows in a monadish way (error types union)+flowBind :: forall xs ys zs m x.+   ( Liftable xs zs+   , Liftable ys zs+   , zs ~ Union xs ys+   , Monad m+   ) => Flow m (x ': ys) -> (x -> Flow m xs) -> Flow m zs+{-# INLINE 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)+{-# INLINE flowBind' #-}+flowBind' = (>.~$>)++-- | Match a value in a flow+flowMatch :: forall x xs zs m.+   ( Monad m+   , Popable x xs+   , Liftable (Filter x xs) zs+   ) => Flow m xs -> (x -> Flow m zs) -> Flow m zs+{-# INLINE flowMatch #-}+flowMatch = (>%~^>)++-- | Match a value in a flow and use a non-returning failure in this case+flowMatchFail :: forall x xs m.+   ( Monad m+   , Popable x xs+   ) => Flow m xs -> (x -> m ()) -> Flow m (Filter x xs)+{-# INLINE flowMatchFail #-}+flowMatchFail = (>%~!!>)++----------------------------------------------------------+-- First element operations+----------------------------------------------------------++-- | Extract the first value, set the first value+(.~.>) :: forall m l x a.+   ( Monad m )+   => Variant (a ': l) -> (a -> m x) -> Flow m (x ': l)+{-# INLINE (.~.>) #-}+(.~.>) 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)+{-# INLINE (>.~.>) #-}+(>.~.>) = liftm (.~.>)++infixl 0 >.~.>++-- | Extract the first value, concat the result+(.~+>) :: forall (k :: Nat) m l l2 a.+   ( KnownNat k+   , k ~ Length l2+   , Monad m )+   => Variant (a ': l) -> (a -> Flow m l2) -> Flow m (Concat l2 l)+{-# INLINE (.~+>) #-}+(.~+>) 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)+{-# INLINE (>.~+>) #-}+(>.~+>) = liftm (.~+>)++infixl 0 >.~+>++-- | Extract the first value, lift both+(.~^^>) :: forall m a xs ys zs.+   ( Monad m+   , Liftable xs zs+   , Liftable ys zs+   ) => Variant (a ': ys) -> (a -> Flow m xs) -> Flow m zs+{-# INLINE (.~^^>) #-}+(.~^^>) v f = makeFlowOp selectFirst (applyF f) combineLiftBoth v++infixl 0 .~^^>+++-- | Extract the first value, lift both+(>.~^^>) :: forall m a xs ys zs.+   ( Monad m+   , Liftable xs zs+   , Liftable ys zs+   ) => Flow m (a ': ys) -> (a -> Flow m xs) -> Flow m zs+{-# INLINE (>.~^^>) #-}+(>.~^^>) = liftm (.~^^>)++infixl 0 >.~^^>++-- | Extract the first value, lift unselected+(.~^>) :: forall m a ys zs.+   ( Monad m+   , Liftable ys zs+   ) => Variant (a ': ys) -> (a -> Flow m zs) -> Flow m zs+{-# INLINE (.~^>) #-}+(.~^>) v f = makeFlowOp selectFirst (applyF f) combineLiftUnselected v++infixl 0 .~^>++-- | Extract the first value, lift unselected+(>.~^>) :: forall m a ys zs.+   ( Monad m+   , Liftable ys zs+   ) => Flow m (a ': ys) -> (a -> Flow m zs) -> Flow m zs+{-# INLINE (>.~^>) #-}+(>.~^>) = liftm (.~^>)++infixl 0 >.~^>++-- | Extract the first value, use the same tail+(.~$>) :: forall m x xs a.+   ( Monad m+   ) => Variant (a ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs)+{-# INLINE (.~$>) #-}+(.~$>) 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)+{-# INLINE (>.~$>) #-}+(>.~$>) = liftm (.~$>)++infixl 0 >.~$>++-- | Take the first output, union the result+(.~|>) ::+   ( Liftable xs zs+   , Liftable ys zs+   , zs ~ Union xs ys+   , Monad m+   ) => Variant (a ': ys) -> (a -> Flow m xs) -> Flow m zs+{-# INLINE (.~|>) #-}+(.~|>) v f = makeFlowOp selectFirst (applyF f) combineUnion v++infixl 0 .~|>++-- | Take the first output, fusion the result+(>.~|>) ::+   ( Liftable xs zs+   , Liftable ys zs+   , zs ~ Union xs ys+   , Monad m+   ) => Flow m (a ': ys) -> (a -> Flow m xs) -> Flow m zs+{-# INLINE (>.~|>) #-}+(>.~|>) = liftm (.~|>)++infixl 0 >.~|>++-- | Extract the first value and perform effect. Passthrough the input value+(.~=>) ::+   ( Monad m+   ) => Variant (a ': l) -> (a -> m ()) -> Flow m (a ': l)+{-# INLINE (.~=>) #-}+(.~=>) 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)+{-# INLINE (>.~=>) #-}+(>.~=>) = liftm (.~=>)++infixl 0 >.~=>++-- | Extract the first value and perform effect.+(.~!>) ::+   ( Monad m+   ) => Variant (a ': l) -> (a -> m ()) -> m ()+{-# INLINE (.~!>) #-}+(.~!>) 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 ()+{-# INLINE (>.~!>) #-}+(>.~!>) = liftm (.~!>)++infixl 0 >.~!>++-- | Extract the first value and perform effect.+(.~!!>) ::+   ( Monad m+   ) => Variant (a ': l) -> (a -> m ()) -> m (Variant l)+{-# INLINE (.~!!>) #-}+(.~!!>) 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 (Variant l)+{-# INLINE (>.~!!>) #-}+(>.~!!>) = liftm (.~!!>)++infixl 0 >.~!!>++----------------------------------------------------------+-- First element, pure variant+----------------------------------------------------------++-- | Extract the first value, set the first value+(.-.>) :: forall m l x a.+   ( Monad m )+   => Variant (a ': l) -> (a -> x) -> Flow m (x ': l)+{-# INLINE (.-.>) #-}+(.-.>) 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)+{-# INLINE (>.-.>) #-}+(>.-.>) = liftm (.-.>)++infixl 0 >.-.>++-- | Extract the first value, set the first value+(<.-.) :: forall m l x a.+   ( Monad m )+   => (a -> x) -> Variant (a ': l) -> Flow m (x ': l)+{-# INLINE (<.-.) #-}+(<.-.) = 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)+{-# INLINE (<.-.<) #-}+(<.-.<) = flip (>.-.>)++infixr 0 <.-.<++----------------------------------------------------------+-- Functor, applicative+----------------------------------------------------------++-- | Functor <$> equivalent+(<$<) :: forall m l a b.+   ( Monad m )+   => (a -> b) -> Flow m (a ': l) -> Flow m (b ': l)+{-# INLINE (<$<) #-}+(<$<) = (<.-.<)++infixl 4 <$<++-- | Applicative <*> equivalent+(<*<) :: forall m l a b.+   ( Monad m )+   => Flow m ((a -> b) ': l) -> Flow m (a ': l) -> Flow m (b ': l)+{-# INLINE (<*<) #-}+(<*<) mf mg = mf >.~$> (mg >.-.>)++infixl 4 <*<++-- | Applicative <*> equivalent, with error union+(<|<) :: forall m xs ys zs y z.+   ( Monad m+   , Liftable xs zs+   , Liftable ys zs+   , zs ~ Union xs ys+   ) => Flow m ((y -> z) ': xs) -> Flow m (y ': ys) -> Flow m (z ': zs)+{-# INLINE (<|<) #-}+(<|<) 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 )+   => Variant (a ': l) -> m x -> Flow m (x ': l)+{-# INLINE (.~~.>) #-}+(.~~.>) 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)+{-# INLINE (>.~~.>) #-}+(>.~~.>) = liftm (.~~.>)++infixl 0 >.~~.>++-- | Extract the first value, concat the result+(.~~+>) :: forall (k :: Nat) m l l2 a.+   ( KnownNat k+   , k ~ Length l2+   , Monad m )+   => Variant (a ': l) -> Flow m l2 -> Flow m (Concat l2 l)+{-# INLINE (.~~+>) #-}+(.~~+>) 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)+{-# INLINE (>.~~+>) #-}+(>.~~+>) = liftm (.~~+>)++infixl 0 >.~~+>++-- | Extract the first value, lift the result+(.~~^^>) :: forall m a xs ys zs.+   ( Monad m+   , Liftable xs zs+   , Liftable ys zs+   ) => Variant (a ': ys) -> Flow m xs -> Flow m zs+{-# INLINE (.~~^^>) #-}+(.~~^^>) v f = v .~^^> const f++infixl 0 .~~^^>+++-- | Extract the first value, lift the result+(>.~~^^>) :: forall m a xs ys zs.+   ( Monad m+   , Liftable xs zs+   , Liftable ys zs+   ) => Flow m (a ': ys) -> Flow m xs -> Flow m zs+{-# INLINE (>.~~^^>) #-}+(>.~~^^>) = liftm (.~~^^>)++infixl 0 >.~~^^>++-- | Extract the first value, connect to the expected output+(.~~^>) :: forall m a ys zs.+   ( Monad m+   , Liftable ys zs+   ) => Variant (a ': ys) -> Flow m zs -> Flow m zs+{-# INLINE (.~~^>) #-}+(.~~^>) v f = v .~^> const f++infixl 0 .~~^>++-- | Extract the first value, connect to the expected output+(>.~~^>) :: forall m a ys zs.+   ( Monad m+   , Liftable ys zs+   ) => Flow m (a ': ys) -> Flow m zs -> Flow m zs+{-# INLINE (>.~~^>) #-}+(>.~~^>) = liftm (.~~^>)++infixl 0 >.~~^>++-- | Extract the first value, use the same output type+(.~~$>) :: forall m x xs a.+   ( Monad m+   ) => Variant (a ': xs) -> Flow m (x ': xs) -> Flow m (x ': xs)+{-# INLINE (.~~$>) #-}+(.~~$>) 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)+{-# INLINE (>.~~$>) #-}+(>.~~$>) = liftm (.~~$>)++infixl 0 >.~~$>++-- | Take the first output, fusion the result+(.~~|>) ::+   ( Liftable xs zs+   , Liftable ys zs+   , zs ~ Union xs ys+   , Monad m+   ) => Variant (a ': ys) -> Flow m xs -> Flow m zs+{-# INLINE (.~~|>) #-}+(.~~|>) v f = v .~|> const f++infixl 0 .~~|>++-- | Take the first output, fusion the result+(>.~~|>) ::+   ( Liftable xs zs+   , Liftable ys zs+   , zs ~ Union xs ys+   , Monad m+   ) => Flow m (a ': ys) -> Flow m xs -> Flow m zs+{-# INLINE (>.~~|>) #-}+(>.~~|>) = liftm (.~~|>)++infixl 0 >.~~|>++-- | Extract the first value and perform effect. Passthrough the input value+(.~~=>) ::+   ( Monad m+   ) => Variant (a ': l) -> m () -> Flow m (a ': l)+{-# INLINE (.~~=>) #-}+(.~~=>) 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)+{-# INLINE (>.~~=>) #-}+(>.~~=>) = liftm (.~~=>)++infixl 0 >.~~=>++-- | Extract the first value and perform effect.+(.~~!>) ::+   ( Monad m+   ) => Variant (a ': l) -> m () -> m ()+{-# INLINE (.~~!>) #-}+(.~~!>) v f = v .~!> const f++infixl 0 .~~!>++-- | Extract the first value and perform effect.+(>.~~!>) ::+   ( Monad m+   ) => Flow m (a ': l) -> m () -> m ()+{-# INLINE (>.~~!>) #-}+(>.~~!>) = liftm (.~~!>)++infixl 0 >.~~!>+++----------------------------------------------------------+-- Tail operations+----------------------------------------------------------++-- | Extract the tail, set the first value+(..~.>) ::+   ( Monad m+   ) => Variant (a ': l) -> (Variant l -> m a) -> m a+{-# INLINE (..~.>) #-}+(..~.>) v f = makeFlowOp selectTail (applyVM f) combineSingle v++infixl 0 ..~.>++-- | Extract the tail, set the first value+(>..~.>) ::+   ( Monad m+   ) => Flow m (a ': l) -> (Variant l -> m a) -> m a+{-# INLINE (>..~.>) #-}+(>..~.>) = liftm (..~.>)++infixl 0 >..~.>++-- | Extract the tail, set the first value (pure function)+(..-.>) ::+   ( Monad m+   ) => Variant (a ': l) -> (Variant l -> a) -> m a+{-# INLINE (..-.>) #-}+(..-.>) 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) -> (Variant l -> a) -> m a+{-# INLINE (>..-.>) #-}+(>..-.>) = liftm (..-.>)++infixl 0 >..-.>++-- | Extract the tail, set the tail+(..-..>) :: forall a l xs m.+   ( Monad m+   ) => Variant (a ': l) -> (Variant l -> Variant xs) -> Flow m (a ': xs)+{-# INLINE (..-..>) #-}+(..-..>) 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) -> (Variant l -> Variant xs) -> Flow m (a ': xs)+{-# INLINE (>..-..>) #-}+(>..-..>) = liftm (..-..>)++infixl 0 >..-..>++-- | Extract the tail, set the tail+(..~..>) :: forall a l xs m.+   ( Monad m+   ) => Variant (a ': l) -> (Variant l -> Flow m xs) -> Flow m (a ': xs)+{-# INLINE (..~..>) #-}+(..~..>) 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) -> (Variant l -> Flow m xs) -> Flow m (a ': xs)+{-# INLINE (>..~..>) #-}+(>..~..>) = liftm (..~..>)++infixl 0 >..~..>++-- | Extract the tail, lift the result+(..~^^>) ::+   ( Monad m+   , Liftable xs (a ': zs)+   ) => Variant (a ': l) -> (Variant l -> Flow m xs) -> Flow m (a ': zs)+{-# INLINE (..~^^>) #-}+(..~^^>) 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+   , Liftable xs (a ': zs)+   ) => Flow m  (a ': l) -> (Variant l -> Flow m xs) -> Flow m (a ': zs)+{-# INLINE (>..~^^>) #-}+(>..~^^>) = liftm (..~^^>)++infixl 0 >..~^^>++-- | Extract the tail, connect the result+(..~^>) ::+   ( Monad m+   , Member a zs+   ) => Variant (a ': l) -> (Variant l -> Flow m zs) -> Flow m zs+{-# INLINE (..~^>) #-}+(..~^>) v f = case popVariantHead v of+   Right u -> flowSet u+   Left  l -> f l++infixl 0 ..~^>++-- | Extract the tail, connect the result+(>..~^>) ::+   ( Monad m+   , Member a zs+   ) => Flow m (a ': l) -> (Variant l -> Flow m zs) -> Flow m zs+{-# INLINE (>..~^>) #-}+(>..~^>) = liftm (..~^>)++infixl 0 >..~^>++-- | Match in the tail, connect to the expected result+(..?~^>) ::+   ( Monad m+   , MaybePopable a xs+   , Liftable (Filter a xs) ys+   ) => Variant (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys)+{-# INLINE (..?~^>) #-}+(..?~^>) v f = v ..~..> (\v' -> v' ?~^> f)++infixl 0 ..?~^>++-- | Match in the tail, connect to the expected result+(>..?~^>) ::+   ( Monad m+   , MaybePopable a xs+   , Liftable (Filter a xs) ys+   ) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys)+{-# INLINE (>..?~^>) #-}+(>..?~^>) = liftm (..?~^>)++infixl 0 >..?~^>++-- | Match in the tail, connect to the expected result+(..%~^>) ::+   ( Monad m+   , Popable a xs+   , Liftable (Filter a xs) ys+   ) => Variant (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys)+{-# INLINE (..%~^>) #-}+(..%~^>) v f = v ..~..> (\v' -> v' %~^> f)++infixl 0 ..%~^>++-- | Match in the tail, connect to the expected result+(>..%~^>) ::+   ( Monad m+   , Popable a xs+   , Liftable (Filter a xs) ys+   ) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys)+{-# INLINE (>..%~^>) #-}+(>..%~^>) = liftm (..%~^>)++infixl 0 >..%~^>++-- | Match in the tail, lift to the expected result+(..?~^^>) ::+   ( Monad m+   , MaybePopable a xs+   , Liftable (Filter a xs) zs+   , Liftable ys zs+   ) => Variant (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs)+{-# INLINE (..?~^^>) #-}+(..?~^^>) v f = v ..~..> (\v' -> v' ?~^^> f)++infixl 0 ..?~^^>++-- | Match in the tail, lift to the expected result+(>..?~^^>) ::+   ( Monad m+   , MaybePopable a xs+   , Liftable (Filter a xs) zs+   , Liftable ys zs+   ) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs)+{-# INLINE (>..?~^^>) #-}+(>..?~^^>) = liftm (..?~^^>)++infixl 0 >..?~^^>++-- | Match in the tail, lift to the expected result+(..%~^^>) ::+   ( Monad m+   , Popable a xs+   , Liftable (Filter a xs) zs+   , Liftable ys zs+   ) => Variant (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs)+{-# INLINE (..%~^^>) #-}+(..%~^^>) v f = v ..~..> (\v' -> v' %~^^> f)++infixl 0 ..%~^^>++-- | Match in the tail, lift to the expected result+(>..%~^^>) ::+   ( Monad m+   , Popable a xs+   , Liftable (Filter a xs) zs+   , Liftable ys zs+   ) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs)+{-# INLINE (>..%~^^>) #-}+(>..%~^^>) = liftm (..%~^^>)++infixl 0 >..%~^^>++-- | Match in the tail, keep the same types+(..?~$>) ::+   ( Monad m+   , MaybePopable a xs+   , Liftable (Filter a xs) (x ': xs)+   ) => Variant (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs)+{-# INLINE (..?~$>) #-}+(..?~$>) 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+   , MaybePopable a xs+   , Liftable (Filter a xs) (x ': xs)+   ) => Flow m (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs)+{-# INLINE (>..?~$>) #-}+(>..?~$>) = liftm (..?~$>)++infixl 0 >..?~$>++-- | Match in the tail, keep the same types+(..%~$>) ::+   ( Monad m+   , Popable a xs+   , Liftable (Filter a xs) (x ': xs)+   ) => Variant (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs)+{-# INLINE (..%~$>) #-}+(..%~$>) 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+   , Popable a xs+   , Liftable (Filter a xs) (x ': xs)+   ) => Flow m (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs)+{-# INLINE (>..%~$>) #-}+(>..%~$>) = liftm (..%~$>)++infixl 0 >..%~$>+++-- | Extract the tail and perform an effect. Passthrough the input value+(..~=>) ::+   ( Monad m+   ) => Variant (x ': xs) -> (Variant xs -> m ()) -> Flow m (x ': xs)+{-# INLINE (..~=>) #-}+(..~=>) 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) -> (Variant xs -> m ()) -> Flow m (x ': xs)+{-# INLINE (>..~=>) #-}+(>..~=>) = liftm (..~=>)++infixl 0 >..~=>++-- | Extract the tail and perform an effect+(..~!>) ::+   ( Monad m+   ) => Variant (x ': xs) -> (Variant xs -> m ()) -> m ()+{-# INLINE (..~!>) #-}+(..~!>) 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) -> (Variant xs -> m ()) -> m ()+{-# INLINE (>..~!>) #-}+(>..~!>) = liftm (..~!>)++infixl 0 >..~!>++-- | Extract the tail and perform an effect+(..~!!>) ::+   ( Monad m+   ) => Variant (x ': xs) -> (Variant xs -> m ()) -> m x+{-# INLINE (..~!!>) #-}+(..~!!>) 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) -> (Variant xs -> m ()) -> m x+{-# INLINE (>..~!!>) #-}+(>..~!!>) = liftm (..~!!>)++infixl 0 >..~!!>++-- | Match in the tail and perform an effect+(..?~!!>) ::+   ( Monad m+   , MaybePopable y xs+   ) => Variant (x ': xs) -> (y -> m ()) -> Flow m (x ': Filter y xs)+{-# INLINE (..?~!!>) #-}+(..?~!!>) v f = v ..~..> (\xs -> xs ?~!!> f)++infixl 0 ..?~!!>++-- | Match in the tail and perform an effect+(>..?~!!>) ::+   ( Monad m+   , MaybePopable y xs+   ) => Flow m (x ': xs) -> (y -> m ()) -> Flow m (x ': Filter y xs)+{-# INLINE (>..?~!!>) #-}+(>..?~!!>) = liftm (..?~!!>)++infixl 0 >..?~!!>++-- | Match in the tail and perform an effect+(..%~!!>) ::+   ( Monad m+   , Popable y xs+   ) => Variant (x ': xs) -> (y -> m ()) -> Flow m (x ': Filter y xs)+{-# INLINE (..%~!!>) #-}+(..%~!!>) v f = v ..~..> (\xs -> xs %~!!> f)++infixl 0 ..%~!!>++-- | Match in the tail and perform an effect+(>..%~!!>) ::+   ( Monad m+   , Popable y xs+   ) => Flow m (x ': xs) -> (y -> m ()) -> Flow m (x ': Filter y xs)+{-# INLINE (>..%~!!>) #-}+(>..%~!!>) = liftm (..%~!!>)++infixl 0 >..%~!!>++-- | Match in the tail and perform an effect+(..?~!>) ::+   ( Monad m+   , MaybePopable y xs+   ) => Variant (x ': xs) -> (y -> m ()) -> m ()+{-# INLINE (..?~!>) #-}+(..?~!>) v f = case popVariantHead v of+   Right _ -> return ()+   Left xs -> xs ?~!> f++infixl 0 ..?~!>++-- | Match in the tail and perform an effect+(>..?~!>) ::+   ( Monad m+   , MaybePopable y xs+   ) => Flow m (x ': xs) -> (y -> m ()) -> m ()+{-# INLINE (>..?~!>) #-}+(>..?~!>) = liftm (..?~!>)++infixl 0 >..?~!>++-- | Match in the tail and perform an effect+(..%~!>) ::+   ( Monad m+   , Popable y xs+   ) => Variant (x ': xs) -> (y -> m ()) -> m ()+{-# INLINE (..%~!>) #-}+(..%~!>) v f = case popVariantHead v of+   Right _ -> return ()+   Left xs -> xs %~!> f++infixl 0 ..%~!>++-- | Match in the tail and perform an effect+(>..%~!>) ::+   ( Monad m+   , Popable y xs+   ) => Flow m (x ': xs) -> (y -> m ()) -> m ()+{-# INLINE (>..%~!>) #-}+(>..%~!>) = liftm (..%~!>)++infixl 0 >..%~!>++----------------------------------------------------------+-- Caught element operations+----------------------------------------------------------++-- | Pop element, set the first value+(?~.>) :: forall x xs y ys m.+   ( ys ~ Filter x xs+   , Monad m+   , MaybePopable x xs+   ) => Variant xs -> (x -> m y) -> Flow m (y ': ys)+{-# INLINE (?~.>) #-}+(?~.>) 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 ~ Filter x xs+   , Monad m+   , MaybePopable x xs+   ) => Flow m xs -> (x -> m y) -> Flow m (y ': ys)+{-# INLINE (>?~.>) #-}+(>?~.>) = liftm (?~.>)++infixl 0 >?~.>++-- | Pop element, set the first value+(%~.>) :: forall x xs y ys m.+   ( ys ~ Filter x xs+   , Monad m+   , Popable x xs+   ) => Variant xs -> (x -> m y) -> Flow m (y ': ys)+{-# INLINE (%~.>) #-}+(%~.>) = (?~.>)++infixl 0 %~.>++-- | Pop element, set the first value+(>%~.>) ::+   ( ys ~ Filter x xs+   , Monad m+   , Popable x xs+   ) => Flow m xs -> (x -> m y) -> Flow m (y ': ys)+{-# INLINE (>%~.>) #-}+(>%~.>) = liftm (%~.>)++infixl 0 >%~.>++-- | Pop element, concat the result+(?~+>) :: forall x xs ys m.+   ( Monad m+   , MaybePopable x xs+   , KnownNat (Length ys)+   ) => Variant xs -> (x -> Flow m ys) -> Flow m (Concat ys (Filter x xs))+{-# INLINE (?~+>) #-}+(?~+>) v f = case popVariantMaybe v of+   Right x -> appendVariant  @(Filter x xs) <$> f x+   Left ys -> prependVariant @ys            <$> return ys++infixl 0 ?~+>++-- | Pop element, concat the result+(>?~+>) :: forall x xs ys m.+   ( Monad m+   , MaybePopable x xs+   , KnownNat (Length ys)+   ) => Flow m xs -> (x -> Flow m ys) -> Flow m (Concat ys (Filter x xs))+{-# INLINE (>?~+>) #-}+(>?~+>) = liftm (?~+>)++infixl 0 >?~+>++-- | Pop element, concat the result+(%~+>) :: forall x xs ys m.+   ( Monad m+   , Popable x xs+   , KnownNat (Length ys)+   ) => Variant xs -> (x -> Flow m ys) -> Flow m (Concat ys (Filter x xs))+{-# INLINE (%~+>) #-}+(%~+>) = (?~+>)++infixl 0 %~+>++-- | Pop element, concat the result+(>%~+>) :: forall x xs ys m.+   ( Monad m+   , Popable x xs+   , KnownNat (Length ys)+   ) => Flow m xs -> (x -> Flow m ys) -> Flow m (Concat ys (Filter x xs))+{-# INLINE (>%~+>) #-}+(>%~+>) = liftm (%~+>)++infixl 0 >%~+>++-- | Pop element, lift the result+(?~^^>) :: forall x xs ys zs m.+   ( Monad m+   , MaybePopable x xs+   , Liftable (Filter x xs) zs+   , Liftable ys zs+   ) => Variant xs -> (x -> Flow m ys) -> Flow m zs+{-# INLINE (?~^^>) #-}+(?~^^>) 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+   , MaybePopable x xs+   , Liftable (Filter x xs) zs+   , Liftable ys zs+   ) => Flow m xs -> (x -> Flow m ys) -> Flow m zs+{-# INLINE (>?~^^>) #-}+(>?~^^>) = liftm (?~^^>)++infixl 0 >?~^^>++-- | Pop element, lift the result+(%~^^>) :: forall x xs ys zs m.+   ( Monad m+   , Popable x xs+   , Liftable (Filter x xs) zs+   , Liftable ys zs+   ) => Variant xs -> (x -> Flow m ys) -> Flow m zs+{-# INLINE (%~^^>) #-}+(%~^^>) = (?~^^>)++infixl 0 %~^^>++-- | Pop element, lift the result+(>%~^^>) :: forall x xs ys zs m.+   ( Monad m+   , Popable x xs+   , Liftable (Filter x xs) zs+   , Liftable ys zs+   ) => Flow m xs -> (x -> Flow m ys) -> Flow m zs+{-# INLINE (>%~^^>) #-}+(>%~^^>) = liftm (%~^^>)++infixl 0 >%~^^>++-- | Pop element, connect to the expected output+(?~^>) :: forall x xs zs m.+   ( Monad m+   , MaybePopable x xs+   , Liftable (Filter x xs) zs+   ) => Variant xs -> (x -> Flow m zs) -> Flow m zs+{-# INLINE (?~^>) #-}+(?~^>) 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+   , MaybePopable x xs+   , Liftable (Filter x xs) zs+   ) => Flow m xs -> (x -> Flow m zs) -> Flow m zs+{-# INLINE (>?~^>) #-}+(>?~^>) = liftm (?~^>)++infixl 0 >?~^>++-- | Pop element, connect to the expected output+(%~^>) :: forall x xs zs m.+   ( Monad m+   , Popable x xs+   , Liftable (Filter x xs) zs+   ) => Variant xs -> (x -> Flow m zs) -> Flow m zs+{-# INLINE (%~^>) #-}+(%~^>) = (?~^>)++infixl 0 %~^>++-- | Pop element, connect to the expected output+(>%~^>) :: forall x xs zs m.+   ( Monad m+   , Popable x xs+   , Liftable (Filter x xs) zs+   ) => Flow m xs -> (x -> Flow m zs) -> Flow m zs+{-# INLINE (>%~^>) #-}+(>%~^>) = liftm (%~^>)++infixl 0 >%~^>++-- | Pop element, use the same output type+(?~$>) :: forall x xs m.+   ( Monad m+   , MaybePopable x xs+   ) => Variant xs -> (x -> Flow m xs) -> Flow m xs+{-# INLINE (?~$>) #-}+(?~$>) 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+   , MaybePopable x xs+   ) => Flow m xs -> (x -> Flow m xs) -> Flow m xs+{-# INLINE (>?~$>) #-}+(>?~$>) = liftm (?~$>)++infixl 0 >?~$>++-- | Pop element, use the same output type+(%~$>) :: forall x xs m.+   ( Monad m+   , Popable x xs+   ) => Variant xs -> (x -> Flow m xs) -> Flow m xs+{-# INLINE (%~$>) #-}+(%~$>) = (?~$>)++infixl 0 %~$>++-- | Pop element, use the same output type+(>%~$>) :: forall x xs m.+   ( Monad m+   , Popable x xs+   ) => Flow m xs -> (x -> Flow m xs) -> Flow m xs+{-# INLINE (>%~$>) #-}+(>%~$>) = liftm (%~$>)++infixl 0 >%~$>++-- | Pop element, fusion the result+(?~|>) :: forall x xs ys zs m.+   ( Monad m+   , MaybePopable x xs+   , Liftable (Filter x xs) zs+   , Liftable ys zs+   , zs ~ Union (Filter x xs) ys+   ) => Variant xs -> (x -> Flow m ys) -> Flow m zs+{-# INLINE (?~|>) #-}+(?~|>) 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+   , MaybePopable x xs+   , Liftable (Filter x xs) zs+   , Liftable ys zs+   , zs ~ Union (Filter x xs) ys+   ) => Flow m xs -> (x -> Flow m ys) -> Flow m zs+{-# INLINE (>?~|>) #-}+(>?~|>) = liftm (?~|>)++infixl 0 >?~|>++-- | Pop element, fusion the result+(%~|>) :: forall x xs ys zs m.+   ( Monad m+   , Popable x xs+   , Liftable (Filter x xs) zs+   , Liftable ys zs+   , zs ~ Union (Filter x xs) ys+   ) => Variant xs -> (x -> Flow m ys) -> Flow m zs+{-# INLINE (%~|>) #-}+(%~|>) = (?~|>)++infixl 0 %~|>++-- | Pop element, fusion the result+(>%~|>) :: forall x xs ys zs m.+   ( Monad m+   , Popable x xs+   , Liftable (Filter x xs) zs+   , Liftable ys zs+   , zs ~ Union (Filter x xs) ys+   ) => Flow m xs -> (x -> Flow m ys) -> Flow m zs+{-# INLINE (>%~|>) #-}+(>%~|>) = liftm (%~|>)++infixl 0 >%~|>++-- | Pop element and perform effect. Passthrough the input value.+(?~=>) :: forall x xs m.+   ( Monad m+   , MaybePopable x xs+   ) => Variant xs -> (x -> m ()) -> Flow m xs+{-# INLINE (?~=>) #-}+(?~=>) 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+   , MaybePopable x xs+   ) => Flow m xs -> (x -> m ()) -> Flow m xs+{-# INLINE (>?~=>) #-}+(>?~=>) = liftm (?~=>)++infixl 0 >?~=>++-- | Pop element and perform effect. Passthrough the input value.+(%~=>) :: forall x xs m.+   ( Monad m+   , Popable x xs+   ) => Variant xs -> (x -> m ()) -> Flow m xs+{-# INLINE (%~=>) #-}+(%~=>) = (?~=>)++infixl 0 %~=>++-- | Pop element and perform effect. Passthrough the input value.+(>%~=>) :: forall x xs m.+   ( Monad m+   , Popable x xs+   ) => Flow m xs -> (x -> m ()) -> Flow m xs+{-# INLINE (>%~=>) #-}+(>%~=>) = liftm (%~=>)++infixl 0 >%~=>++-- | Pop element and perform effect.+(?~!>) :: forall x xs m.+   ( Monad m+   , MaybePopable x xs+   ) => Variant xs -> (x -> m ()) -> m ()+{-# INLINE (?~!>) #-}+(?~!>) 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+   , MaybePopable x xs+   ) => Flow m xs -> (x -> m ()) -> m ()+{-# INLINE (>?~!>) #-}+(>?~!>) = liftm (?~!>)++infixl 0 >?~!>++-- | Pop element and perform effect.+(%~!>) :: forall x xs m.+   ( Monad m+   , Popable x xs+   ) => Variant xs -> (x -> m ()) -> m ()+{-# INLINE (%~!>) #-}+(%~!>) = (?~!>)++infixl 0 %~!>++-- | Pop element and perform effect.+(>%~!>) :: forall x xs m.+   ( Monad m+   , Popable x xs+   ) => Flow m xs -> (x -> m ()) -> m ()+{-# INLINE (>%~!>) #-}+(>%~!>) = liftm (%~!>)++infixl 0 >%~!>++-- | Pop element and perform effect.+(?~!!>) :: forall x xs m.+   ( Monad m+   , MaybePopable x xs+   ) => Variant xs -> (x -> m ()) -> Flow m (Filter x xs)+{-# INLINE (?~!!>) #-}+(?~!!>) 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+   , MaybePopable x xs+   ) => Flow m xs -> (x -> m ()) -> Flow m (Filter x xs)+{-# INLINE (>?~!!>) #-}+(>?~!!>) = liftm (?~!!>)++infixl 0 >?~!!>++-- | Pop element and perform effect.+(%~!!>) :: forall x xs m.+   ( Monad m+   , Popable x xs+   ) => Variant xs -> (x -> m ()) -> Flow m (Filter x xs)+{-# INLINE (%~!!>) #-}+(%~!!>) = (?~!!>)++infixl 0 %~!!>++-- | Pop element and perform effect.+(>%~!!>) :: forall x xs m.+   ( Monad m+   , Popable x xs+   ) => Flow m xs -> (x -> m ()) -> Flow m (Filter x xs)+{-# INLINE (>%~!!>) #-}+(>%~!!>) = liftm (%~!!>)++infixl 0 >%~!!>++--------------------------------------------------------------+-- Helpers+--------------------------------------------------------------+++-- | Make a flow operator+makeFlowOp :: Monad m =>+      (Variant as -> Either (Variant bs) (Variant cs))+      -> (Variant cs -> Flow m ds)+      -> (Either (Variant bs) (Variant ds) -> es)+      -> Variant as -> m es+{-# INLINE makeFlowOp #-}+makeFlowOp select apply combine v = combine <$> traverse apply (select v)++-- | Make a flow operator+makeFlowOpM :: Monad m =>+      (Variant as -> Either (Variant bs) (Variant cs))+      -> (Variant cs -> Flow m ds)+      -> (Either (Variant bs) (Variant ds) -> es)+      -> Flow m as -> m es+{-# INLINE makeFlowOpM #-}+makeFlowOpM select apply combine v = v >>= makeFlowOp select apply combine+++-- | Select the first value+selectFirst :: Variant (x ': xs) -> Either (Variant xs) (Variant '[x])+{-# INLINE selectFirst #-}+selectFirst = fmap (toVariantAt @0) . popVariantHead++-- | Select the tail+selectTail :: Variant (x ': xs) -> Either (Variant '[x]) (Variant xs)+{-# INLINE selectTail #-}+selectTail = flipEither . selectFirst+   where+      flipEither (Left x)  = Right x+      flipEither (Right x) = Left x++-- | Select by type+selectType ::+   ( Popable x xs+   ) => Variant xs -> Either (Variant (Filter x xs)) (Variant '[x])+{-# INLINE selectType #-}+selectType = fmap (toVariantAt @0) . popVariant++-- | Const application+applyConst :: Flow m ys -> (Variant xs -> Flow m ys)+{-# INLINE applyConst #-}+applyConst = const++-- | Pure application+applyPure :: Monad m => (Variant xs -> Variant ys) -> Variant xs -> Flow m ys+{-# INLINE applyPure #-}+applyPure f = return . f++-- | Lift a monadic function+applyM :: Monad m => (a -> m b) -> Variant '[a] -> Flow m '[b]+{-# INLINE applyM #-}+applyM = liftF++-- | Lift a monadic function+applyVM :: Monad m => (Variant a -> m b) -> Variant a -> Flow m '[b]+{-# INLINE applyVM #-}+applyVM f = fmap (toVariantAt @0) . f++-- | Lift a monadic function+applyF :: (a -> Flow m b) -> Variant '[a] -> Flow m b+{-# INLINE applyF #-}+applyF f = f . variantToValue++-- | Set the first value (the "correct" one)+combineFirst :: forall x xs. Either (Variant xs) (Variant '[x]) -> Variant (x ': xs)+{-# INLINE 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 (Variant xs) (Variant (x ': xs)) -> Variant (x ': xs)+{-# INLINE combineSameTail #-}+combineSameTail = \case+   Right x -> x+   Left xs -> prependVariant @'[x] xs++-- | Return the valid variant unmodified+combineEither :: Either (Variant xs) (Variant xs) -> Variant xs+{-# INLINE combineEither #-}+combineEither = \case+   Right x -> x+   Left x  -> x++-- | Concatenate unselected values+combineConcat :: forall xs ys.+   ( KnownNat (Length xs)+   ) => Either (Variant ys) (Variant xs) -> Variant (Concat xs ys)+{-# INLINE combineConcat #-}+combineConcat = \case+   Right xs -> appendVariant  @ys xs+   Left ys  -> prependVariant @xs ys++-- | Union+combineUnion ::+   ( Liftable xs (Union xs ys)+   , Liftable ys (Union xs ys)+   ) => Either (Variant ys) (Variant xs) -> Variant (Union xs ys)+{-# INLINE combineUnion #-}+combineUnion = \case+   Right xs -> liftVariant xs+   Left  ys -> liftVariant ys++-- | Lift unselected+combineLiftUnselected ::+   ( Liftable ys xs+   ) => Either (Variant ys) (Variant xs) -> Variant xs+{-# INLINE combineLiftUnselected #-}+combineLiftUnselected = \case+   Right xs -> xs+   Left ys  -> liftVariant ys++-- | Lift both+combineLiftBoth ::+   ( Liftable ys zs+   , Liftable xs zs+   ) => Either (Variant ys) (Variant xs) -> Variant zs+{-# INLINE combineLiftBoth #-}+combineLiftBoth = \case+   Right xs -> liftVariant xs+   Left ys  -> liftVariant ys++-- | Single value+combineSingle :: Either (Variant '[x]) (Variant '[x]) -> x+{-# INLINE combineSingle #-}+combineSingle = \case+   Right x -> variantToValue x+   Left  x -> variantToValue x+++-- | Lift a pure function into a Variant to Variant function+liftV :: (a -> b) -> Variant '[a] -> Variant '[b]+liftV = updateVariantAt @0++-- | Lift a function into a Flow+liftF :: Monad m => (a -> m b) -> Variant '[a] -> Flow m '[b]+liftF = updateVariantFirstM @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) (Variant (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 (Variant zs)+   , ContVariant xs+   ) => Variant xs -> fs -> Variant 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 (Variant zs)+   , ContVariant xs+   , ks ~ ExtractMonad m zs+   , Applicative m+   ) => Variant 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 (Variant zs)+   , ContVariant xs+   , ks ~ ExtractMonad m zs+   , Monad m+   ) => 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 (Variant zs)+   , ContVariant xs+   , ys ~ FlattenVariant zs+   , Flattenable (Variant zs) (Variant ys)+   , Liftable ys (Nub ys)+   , rs ~ Nub ys+   ) => Variant xs -> fs -> Variant 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 (Variant zs)+   , ks ~ ExtractMonad m zs+   , ys ~ FlattenVariant ks+   , Flattenable (Variant ks) (Variant ys)+   , rs ~ Nub ys+   , Liftable ys rs+   , Applicative m+   ) => Variant 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 (Variant zs)+   , ks ~ ExtractMonad m zs+   , ys ~ FlattenVariant ks+   , Flattenable (Variant ks) (Variant ys)+   , rs ~ Nub ys+   , Liftable ys rs+   , Monad m+   ) => Flow m xs -> fs -> Flow m rs+(>~||>) act fs = do+   r <- act+   r ~||> fs