packages feed

haskus-utils-variant 2.0.3 → 2.1

raw patch · 5 files changed

+387/−349 lines, 5 filesdep ~haskus-utils-types

Dependency ranges changed: haskus-utils-types

Files

haskus-utils-variant.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.20 name: haskus-utils-variant-version: 2.0.3+version: 2.1 license: BSD3 license-file: LICENSE copyright: Sylvain Henry 2018@@ -25,6 +25,7 @@         Haskus.Utils.Variant.Flow         Haskus.Utils.Variant.Cont         Haskus.Utils.Variant.Syntax+        Haskus.Utils.VariantF         Haskus.Utils.EADT         Haskus.Utils.EADT.TH     hs-source-dirs: src/lib@@ -33,7 +34,7 @@     build-depends:         base >=4.9 && <4.12,         template-haskell >=2.13.0.0 && <2.14,-        haskus-utils-types ==1.1.*,+        haskus-utils-types ==1.2.*,         haskus-utils-data ==1.1.*  test-suite tests
src/lib/Haskus/Utils/EADT.hs view
@@ -8,37 +8,13 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE MultiParamTypeClasses #-}  -- | Extensible ADT module Haskus.Utils.EADT-   ( VariantF (..)-   , ApplyAll-   , pattern FV-   , appendVariantF-   , toVariantFHead-   , toVariantFTail-   , popVariantFHead-   , popVariantF-   , mapVariantF-   , variantFToValue-   , LiftableF-   , liftVariantF-   , AlterVariantF-   , alterVariantF-   , AlgVariantF-   , algVariantF-   , splitVariantF-   , variantFToCont-   , variantFToContM-   , contToVariantF-   , contToVariantFM-   -- * Extensible ADT-   , EADT+   ( EADT    , (:<:)    , (:<<:)    , pattern VF@@ -54,222 +30,19 @@    , contToEADT    , contToEADTM    -- * Reexport-   , NoConstraint    , module Haskus.Utils.Functor+   , module Haskus.Utils.VariantF    ) where +import Haskus.Utils.VariantF import Haskus.Utils.Variant import Haskus.Utils.Functor import Haskus.Utils.Types.List import Haskus.Utils.Types import Haskus.Utils.ContFlow -import Unsafe.Coerce-import Data.Bifunctor-import GHC.Exts (Any,Constraint)---- | Recursive Functor-like Variant-newtype VariantF (xs :: [* -> *]) e-   = VariantF (V (ApplyAll e xs))---- | Apply its first argument to every element of the 2nd arg list------ > ApplyAll e '[f,g,h] ==> '[f e, g e, h e]----type family ApplyAll e (xs :: [* -> *]) :: [*] 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. 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.-   ( 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.-   ( MapVariant (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)--class AlterVariantF (c :: (* -> *) -> Constraint) e (xs :: [* -> *]) where-   alterVariantF' :: (forall (f :: * -> *). c f => f e -> f e) -> Word -> Any -> Any--instance AlterVariantF c e '[] where-   {-# INLINE alterVariantF' #-}-   alterVariantF' _ = undefined--instance-   ( AlterVariantF c e xs-   , c x-   ) => AlterVariantF c e (x ': xs)-   where-      {-# INLINE alterVariantF' #-}-      alterVariantF' f t v =-         case t of-            0 -> unsafeCoerce (f (unsafeCoerce v :: x e))-            n -> alterVariantF' @c @e @xs f (n-1) v---- | Alter a variant. You need to specify the constraints required by the--- modifying function.------ Usage:------ >   alterVariantF @NoConstraint id         v--- >   alterVariantF @Resizable    (resize 4) v--- >--- >   -- Multiple constraints:--- >   class (Ord a, Num a) => OrdNum a--- >   instance (Ord a, Num a) => OrdNum a--- >   alterVariantF @OrdNum foo v----alterVariantF :: forall c e (xs :: [* -> *]).-   ( AlterVariantF c e xs-   ) => (forall (f :: * -> *). c f => f e -> f e) -> VariantF xs e -> VariantF xs e-{-# INLINABLE alterVariantF #-}-alterVariantF f (VariantF (Variant t a)) =-   VariantF (Variant t (alterVariantF' @c @e @xs f t a))---class AlgVariantF (c :: (* -> *) -> Constraint) e (xs :: [* -> *]) where-   algVariantF' :: (forall (f :: * -> *). c f => f e -> e) -> Word -> Any -> e--instance AlgVariantF c e '[] where-   {-# INLINE algVariantF' #-}-   algVariantF' _ = undefined--instance-   ( AlgVariantF c e xs-   , c x-   ) => AlgVariantF c e (x ': xs)-   where-      {-# INLINE algVariantF' #-}-      algVariantF' f t v =-         case t of-            0 -> f (unsafeCoerce v :: x e)-            n -> algVariantF' @c @e @xs f (n-1) v---- | Apply an algebra to a VariantF. You need to specify the constraints--- required by the modifying function.------ Usage:------ >  algVariantF @NoConstraint id         v--- >  algVariantF @Resizable    (resize 4) v----algVariantF :: forall c e (xs :: [* -> *]).-   ( AlgVariantF c e xs-   ) => (forall (f :: * -> *). c f => f e -> e) -> VariantF xs e -> e-{-# INLINABLE algVariantF #-}-algVariantF f (VariantF (Variant t a)) = algVariantF' @c @e @xs f t a----- | Split a VariantF in two-splitVariantF :: forall as xs e.-   ( Complement (ApplyAll e xs) (ApplyAll e as) ~ ApplyAll e (Complement xs as)-   , SplitVariant (ApplyAll e as) (ApplyAll e xs) (ApplyAll e xs)-   ) => VariantF xs e-     -> Either (VariantF as e) (VariantF (Complement xs as) e)-splitVariantF (VariantF v) = bimap VariantF VariantF (splitVariant v)---- | Convert a VariantF into a multi-continuation-variantFToCont :: ContVariant (ApplyAll e xs)-   => VariantF xs e -> ContFlow (ApplyAll e xs) r-variantFToCont (VariantF v) = variantToCont v---- | Convert a VariantF into a multi-continuation-variantFToContM ::-   ( ContVariant (ApplyAll e xs)-   , Monad m-   ) => m (VariantF xs e) -> ContFlow (ApplyAll e xs) (m r)-variantFToContM f = variantToContM (unvariantF <$> f)-   where-      unvariantF (VariantF v) = v---- | Convert a multi-continuation into a VariantF-contToVariantF :: forall xs e.-   ( ContVariant (ApplyAll e xs)-   ) => ContFlow (ApplyAll e xs) (V (ApplyAll e xs)) -> VariantF xs e-contToVariantF c = VariantF (contToVariant c)---- | Convert a multi-continuation into a VariantF-contToVariantFM :: forall xs e m.-   ( ContVariant (ApplyAll e xs)-   , Monad m-   ) => ContFlow (ApplyAll e xs) (m (V (ApplyAll e xs))) -> m (VariantF xs e)-contToVariantFM f = VariantF <$> contToVariantM f--instance ContVariant (ApplyAll e xs) => MultiCont (VariantF xs e) where-   type MultiContTypes (VariantF xs e) = ApplyAll e xs-   toCont = variantFToCont-   toContM = variantFToContM------------------------------------------------- Extensible ADT---------------------------------------------+import GHC.Exts (Constraint)  -- | An extensible ADT type EADT xs = Fix (VariantF xs)@@ -288,6 +61,7 @@    , 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))+   , Remove (f e) (ApplyAll e cs) ~ ApplyAll e (Remove f cs)    )  -- | Pattern-match in an extensible ADT@@ -310,7 +84,7 @@ -- | Lift an EADT into another liftEADT :: forall e as bs.    ( e ~ Fix (VariantF bs)-   , LiftableF e as bs+   , LiftVariantF e as bs    , Functor (VariantF as)    ) => EADT as -> EADT bs liftEADT = cata (Fix . liftVariantF)@@ -320,8 +94,7 @@    ( f :<: xs    , e ~ EADT xs    , 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))+   ) => EADT xs -> Either (VariantF (Remove f xs) (EADT xs)) (f (EADT xs)) popEADT (Fix v) = popVariantF v  type AlterEADT c xs = AlterVariantF c (EADT xs) xs
src/lib/Haskus/Utils/Variant.hs view
@@ -42,7 +42,7 @@    -- * Operations by type    , toVariant    , Member-   , Filter+   , Remove    , popVariant    , popVariantMaybe    , fromVariant@@ -69,7 +69,7 @@    -- * Conversions between variants    , appendVariant    , prependVariant-   , Liftable+   , LiftVariant    , liftVariant    , nubVariant    , productVariant@@ -97,7 +97,7 @@    , fromVariant'    , popVariant'    , toVariant'-   , LiftVariant+   , LiftVariant'    , PopVariant    ) where@@ -312,7 +312,7 @@  class PopVariant a xs where    -- | Remove a type from a variant-   popVariant' :: V xs -> Either (V (Filter a xs)) a+   popVariant' :: V xs -> Either (V (Remove a xs)) a  instance PopVariant a '[] where    {-# INLINE popVariant' #-}@@ -322,7 +322,7 @@       ( PopVariant a xs'       , n ~ MaybeIndexOf a xs       , xs' ~ RemoveAt1 n xs-      , Filter a xs' ~ Filter a xs+      , Remove a xs' ~ Remove a xs       , KnownNat n       , xs ~ (y ': ys)       ) => PopVariant a (y ': ys)@@ -385,7 +385,7 @@ -- remaining variant popVariant :: forall a xs.    ( a :< xs-   ) => V xs -> Either (V (Filter a xs)) a+   ) => V xs -> Either (V (Remove a xs)) a {-# INLINABLE popVariant #-} popVariant v = popVariant' @a v @@ -393,7 +393,7 @@ -- remaining variant popVariantMaybe :: forall a xs.    ( a :<? xs-   ) => V xs -> Either (V (Filter a xs)) a+   ) => V xs -> Either (V (Remove a xs)) a {-# INLINABLE popVariantMaybe #-} popVariantMaybe v = popVariant' @a v @@ -489,7 +489,7 @@    ( MapVariant a b cs    , ds ~ ReplaceNS (IndexesOf a cs) b cs    , rs ~ Nub ds-   , Liftable ds rs+   , LiftVariant ds rs    ) => (a -> b) -> V cs -> V rs {-# INLINABLE mapNubVariant #-} mapNubVariant f = nubVariant . mapVariant f@@ -561,7 +561,7 @@ foldMapVariant :: forall a cs ds i.    ( i ~ IndexOf a cs    , a :< cs-   ) => (a -> V ds) -> V cs -> V (InsertAt i (Filter a cs) ds)+   ) => (a -> V ds) -> V cs -> V (InsertAt i (Remove a cs) ds) foldMapVariant f v = case popVariant v of    Right a -> case f a of       Variant t x -> Variant (i + t) x@@ -717,22 +717,22 @@       n = natValue' @(Length ys)  -- | xs is liftable in ys-type Liftable xs ys =+type LiftVariant xs ys =    ( IsSubset xs ys ~ 'True-   , LiftVariant xs ys+   , LiftVariant' xs ys    ) -class LiftVariant xs ys where+class LiftVariant' xs ys where    liftVariant' :: V xs -> V ys -instance LiftVariant '[] ys where+instance LiftVariant' '[] ys where    {-# INLINE liftVariant' #-}    liftVariant' _ = undefined  instance forall xs ys x.-      ( LiftVariant xs ys+      ( LiftVariant' xs ys       , KnownNat (IndexOf x ys)-      ) => LiftVariant (x ': xs) ys+      ) => LiftVariant' (x ': xs) ys    where       {-# INLINE liftVariant' #-}       liftVariant' (Variant t a)@@ -744,13 +744,13 @@ -- -- Set values to the first matching type liftVariant :: forall ys xs.-   ( Liftable xs ys+   ( LiftVariant xs ys    ) => V xs -> V ys {-# INLINABLE liftVariant #-} liftVariant = liftVariant'  -- | Nub the type list-nubVariant :: (Liftable xs (Nub xs)) => V xs -> V (Nub xs)+nubVariant :: (LiftVariant xs (Nub xs)) => V xs -> V (Nub xs) {-# INLINABLE nubVariant #-} nubVariant = liftVariant
src/lib/Haskus/Utils/Variant/Flow.hs view
@@ -25,7 +25,7 @@    , flowFor    , flowTraverseFilter    , flowForFilter-   , Liftable+   , LiftVariant    , (:<)    , (:<?)    -- * Functor, applicative equivalents@@ -225,7 +225,7 @@ flowSingle = flowSetN @0  -- | Lift a flow into another-flowLift :: (Liftable xs ys , Monad m) => Flow m xs -> Flow m ys+flowLift :: (LiftVariant xs ys , Monad m) => Flow m xs -> Flow m ys {-# INLINABLE flowLift #-} flowLift = fmap liftVariant @@ -296,8 +296,8 @@  -- | Bind two flows in a monadish way (error types union) flowBind :: forall xs ys zs m x.-   ( Liftable xs zs-   , Liftable ys zs+   ( LiftVariant xs zs+   , LiftVariant ys zs    , zs ~ Union xs ys    , Monad m    ) => Flow m (x ': ys) -> (x -> Flow m xs) -> Flow m zs@@ -313,7 +313,7 @@ flowMatch :: forall x xs zs m.    ( Monad m    , x :< xs-   , Liftable (Filter x xs) zs+   , LiftVariant (Remove x xs) zs    ) => Flow m xs -> (x -> Flow m zs) -> Flow m zs {-# INLINABLE flowMatch #-} flowMatch = (>%~^>)@@ -322,7 +322,7 @@ flowMatchFail :: forall x xs m.    ( Monad m    , x :< xs-   ) => Flow m xs -> (x -> m ()) -> Flow m (Filter x xs)+   ) => Flow m xs -> (x -> m ()) -> Flow m (Remove x xs) {-# INLINABLE flowMatchFail #-} flowMatchFail = (>%~!!>) @@ -373,8 +373,8 @@ -- | Extract the first value, lift both (.~^^>) :: forall m a xs ys zs.    ( Monad m-   , Liftable xs zs-   , Liftable ys zs+   , LiftVariant xs zs+   , LiftVariant ys zs    ) => V (a ': ys) -> (a -> Flow m xs) -> Flow m zs {-# INLINABLE (.~^^>) #-} (.~^^>) v f = makeFlowOp selectFirst (applyF f) combineLiftBoth v@@ -385,8 +385,8 @@ -- | Extract the first value, lift both (>.~^^>) :: forall m a xs ys zs.    ( Monad m-   , Liftable xs zs-   , Liftable ys zs+   , LiftVariant xs zs+   , LiftVariant ys zs    ) => Flow m (a ': ys) -> (a -> Flow m xs) -> Flow m zs {-# INLINABLE (>.~^^>) #-} (>.~^^>) = liftm (.~^^>)@@ -396,7 +396,7 @@ -- | Extract the first value, lift unselected (.~^>) :: forall m a ys zs.    ( Monad m-   , Liftable ys zs+   , LiftVariant ys zs    ) => V (a ': ys) -> (a -> Flow m zs) -> Flow m zs {-# INLINABLE (.~^>) #-} (.~^>) v f = makeFlowOp selectFirst (applyF f) combineLiftUnselected v@@ -406,7 +406,7 @@ -- | Extract the first value, lift unselected (>.~^>) :: forall m a ys zs.    ( Monad m-   , Liftable ys zs+   , LiftVariant ys zs    ) => Flow m (a ': ys) -> (a -> Flow m zs) -> Flow m zs {-# INLINABLE (>.~^>) #-} (>.~^>) = liftm (.~^>)@@ -433,8 +433,8 @@  -- | Take the first output, union the result (.~|>) ::-   ( Liftable xs zs-   , Liftable ys zs+   ( LiftVariant xs zs+   , LiftVariant ys zs    , zs ~ Union xs ys    , Monad m    ) => V (a ': ys) -> (a -> Flow m xs) -> Flow m zs@@ -445,8 +445,8 @@  -- | Take the first output, fusion the result (>.~|>) ::-   ( Liftable xs zs-   , Liftable ys zs+   ( LiftVariant xs zs+   , LiftVariant ys zs    , zs ~ Union xs ys    , Monad m    ) => Flow m (a ': ys) -> (a -> Flow m xs) -> Flow m zs@@ -580,8 +580,8 @@ -- | Applicative <*> equivalent, with error union (<|<) :: forall m xs ys zs y z.    ( Monad m-   , Liftable xs zs-   , Liftable ys zs+   , LiftVariant xs zs+   , LiftVariant ys zs    , zs ~ Union xs ys    ) => Flow m ((y -> z) ': xs) -> Flow m (y ': ys) -> Flow m (z ': zs) {-# INLINABLE (<|<) #-}@@ -640,8 +640,8 @@ -- | Extract the first value, lift the result (.~~^^>) :: forall m a xs ys zs.    ( Monad m-   , Liftable xs zs-   , Liftable ys zs+   , LiftVariant xs zs+   , LiftVariant ys zs    ) => V (a ': ys) -> Flow m xs -> Flow m zs {-# INLINABLE (.~~^^>) #-} (.~~^^>) v f = v .~^^> const f@@ -652,8 +652,8 @@ -- | Extract the first value, lift the result (>.~~^^>) :: forall m a xs ys zs.    ( Monad m-   , Liftable xs zs-   , Liftable ys zs+   , LiftVariant xs zs+   , LiftVariant ys zs    ) => Flow m (a ': ys) -> Flow m xs -> Flow m zs {-# INLINABLE (>.~~^^>) #-} (>.~~^^>) = liftm (.~~^^>)@@ -663,7 +663,7 @@ -- | Extract the first value, connect to the expected output (.~~^>) :: forall m a ys zs.    ( Monad m-   , Liftable ys zs+   , LiftVariant ys zs    ) => V (a ': ys) -> Flow m zs -> Flow m zs {-# INLINABLE (.~~^>) #-} (.~~^>) v f = v .~^> const f@@ -673,7 +673,7 @@ -- | Extract the first value, connect to the expected output (>.~~^>) :: forall m a ys zs.    ( Monad m-   , Liftable ys zs+   , LiftVariant ys zs    ) => Flow m (a ': ys) -> Flow m zs -> Flow m zs {-# INLINABLE (>.~~^>) #-} (>.~~^>) = liftm (.~~^>)@@ -700,8 +700,8 @@  -- | Take the first output, fusion the result (.~~|>) ::-   ( Liftable xs zs-   , Liftable ys zs+   ( LiftVariant xs zs+   , LiftVariant ys zs    , zs ~ Union xs ys    , Monad m    ) => V (a ': ys) -> Flow m xs -> Flow m zs@@ -712,8 +712,8 @@  -- | Take the first output, fusion the result (>.~~|>) ::-   ( Liftable xs zs-   , Liftable ys zs+   ( LiftVariant xs zs+   , LiftVariant ys zs    , zs ~ Union xs ys    , Monad m    ) => Flow m (a ': ys) -> Flow m xs -> Flow m zs@@ -844,7 +844,7 @@ -- | Extract the tail, lift the result (..~^^>) ::    ( Monad m-   , Liftable xs (a ': zs)+   , LiftVariant xs (a ': zs)    ) => V (a ': l) -> (V l -> Flow m xs) -> Flow m (a ': zs) {-# INLINABLE (..~^^>) #-} (..~^^>) v f = case popVariantHead v of@@ -856,7 +856,7 @@ -- | Extract the tail, lift the result (>..~^^>) ::    ( Monad m-   , Liftable xs (a ': zs)+   , LiftVariant xs (a ': zs)    ) => Flow m  (a ': l) -> (V l -> Flow m xs) -> Flow m (a ': zs) {-# INLINABLE (>..~^^>) #-} (>..~^^>) = liftm (..~^^>)@@ -889,7 +889,7 @@ (..?~^>) ::    ( Monad m    , a :<? xs-   , Liftable (Filter a xs) ys+   , LiftVariant (Remove a xs) ys    ) => V (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys) {-# INLINABLE (..?~^>) #-} (..?~^>) v f = v ..~..> (\v' -> v' ?~^> f)@@ -900,7 +900,7 @@ (>..?~^>) ::    ( Monad m    , a :<? xs-   , Liftable (Filter a xs) ys+   , LiftVariant (Remove a xs) ys    ) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys) {-# INLINABLE (>..?~^>) #-} (>..?~^>) = liftm (..?~^>)@@ -911,7 +911,7 @@ (..%~^>) ::    ( Monad m    , a :< xs-   , Liftable (Filter a xs) ys+   , LiftVariant (Remove a xs) ys    ) => V (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys) {-# INLINABLE (..%~^>) #-} (..%~^>) v f = v ..~..> (\v' -> v' %~^> f)@@ -922,7 +922,7 @@ (>..%~^>) ::    ( Monad m    , a :< xs-   , Liftable (Filter a xs) ys+   , LiftVariant (Remove a xs) ys    ) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys) {-# INLINABLE (>..%~^>) #-} (>..%~^>) = liftm (..%~^>)@@ -933,8 +933,8 @@ (..?~^^>) ::    ( Monad m    , a :<? xs-   , Liftable (Filter a xs) zs-   , Liftable ys zs+   , LiftVariant (Remove a xs) zs+   , LiftVariant ys zs    ) => V (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs) {-# INLINABLE (..?~^^>) #-} (..?~^^>) v f = v ..~..> (\v' -> v' ?~^^> f)@@ -945,8 +945,8 @@ (>..?~^^>) ::    ( Monad m    , a :<? xs-   , Liftable (Filter a xs) zs-   , Liftable ys zs+   , LiftVariant (Remove a xs) zs+   , LiftVariant ys zs    ) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs) {-# INLINABLE (>..?~^^>) #-} (>..?~^^>) = liftm (..?~^^>)@@ -957,8 +957,8 @@ (..%~^^>) ::    ( Monad m    , a :< xs-   , Liftable (Filter a xs) zs-   , Liftable ys zs+   , LiftVariant (Remove a xs) zs+   , LiftVariant ys zs    ) => V (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs) {-# INLINABLE (..%~^^>) #-} (..%~^^>) v f = v ..~..> (\v' -> v' %~^^> f)@@ -969,8 +969,8 @@ (>..%~^^>) ::    ( Monad m    , a :< xs-   , Liftable (Filter a xs) zs-   , Liftable ys zs+   , LiftVariant (Remove a xs) zs+   , LiftVariant ys zs    ) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs) {-# INLINABLE (>..%~^^>) #-} (>..%~^^>) = liftm (..%~^^>)@@ -981,7 +981,7 @@ (..?~$>) ::    ( Monad m    , a :<? xs-   , Liftable (Filter a xs) (x ': xs)+   , LiftVariant (Remove a xs) (x ': xs)    ) => V (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs) {-# INLINABLE (..?~$>) #-} (..?~$>) v f = case popVariantHead v of@@ -994,7 +994,7 @@ (>..?~$>) ::    ( Monad m    , a :<? xs-   , Liftable (Filter a xs) (x ': xs)+   , LiftVariant (Remove a xs) (x ': xs)    ) => Flow m (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs) {-# INLINABLE (>..?~$>) #-} (>..?~$>) = liftm (..?~$>)@@ -1005,7 +1005,7 @@ (..%~$>) ::    ( Monad m    , a :< xs-   , Liftable (Filter a xs) (x ': xs)+   , LiftVariant (Remove a xs) (x ': xs)    ) => V (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs) {-# INLINABLE (..%~$>) #-} (..%~$>) v f = case popVariantHead v of@@ -1018,7 +1018,7 @@ (>..%~$>) ::    ( Monad m    , a :< xs-   , Liftable (Filter a xs) (x ': xs)+   , LiftVariant (Remove a xs) (x ': xs)    ) => Flow m (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs) {-# INLINABLE (>..%~$>) #-} (>..%~$>) = liftm (..%~$>)@@ -1090,7 +1090,7 @@ (..?~!!>) ::    ( Monad m    , y :<? xs-   ) => V (x ': xs) -> (y -> m ()) -> Flow m (x ': Filter y xs)+   ) => V (x ': xs) -> (y -> m ()) -> Flow m (x ': Remove y xs) {-# INLINABLE (..?~!!>) #-} (..?~!!>) v f = v ..~..> (\xs -> xs ?~!!> f) @@ -1100,7 +1100,7 @@ (>..?~!!>) ::    ( Monad m    , y :<? xs-   ) => Flow m (x ': xs) -> (y -> m ()) -> Flow m (x ': Filter y xs)+   ) => Flow m (x ': xs) -> (y -> m ()) -> Flow m (x ': Remove y xs) {-# INLINABLE (>..?~!!>) #-} (>..?~!!>) = liftm (..?~!!>) @@ -1110,7 +1110,7 @@ (..%~!!>) ::    ( Monad m    , y :< xs-   ) => V (x ': xs) -> (y -> m ()) -> Flow m (x ': Filter y xs)+   ) => V (x ': xs) -> (y -> m ()) -> Flow m (x ': Remove y xs) {-# INLINABLE (..%~!!>) #-} (..%~!!>) v f = v ..~..> (\xs -> xs %~!!> f) @@ -1120,7 +1120,7 @@ (>..%~!!>) ::    ( Monad m    , y :< xs-   ) => Flow m (x ': xs) -> (y -> m ()) -> Flow m (x ': Filter y xs)+   ) => Flow m (x ': xs) -> (y -> m ()) -> Flow m (x ': Remove y xs) {-# INLINABLE (>..%~!!>) #-} (>..%~!!>) = liftm (..%~!!>) @@ -1176,7 +1176,7 @@  -- | Pop element, set the first value (?~.>) :: forall x xs y ys m.-   ( ys ~ Filter x xs+   ( ys ~ Remove x xs    , Monad m    , x :<? xs    ) => V xs -> (x -> m y) -> Flow m (y ': ys)@@ -1189,7 +1189,7 @@  -- | Pop element, set the first value (>?~.>) ::-   ( ys ~ Filter x xs+   ( ys ~ Remove x xs    , Monad m    , x :<? xs    ) => Flow m xs -> (x -> m y) -> Flow m (y ': ys)@@ -1200,7 +1200,7 @@  -- | Pop element, set the first value (%~.>) :: forall x xs y ys m.-   ( ys ~ Filter x xs+   ( ys ~ Remove x xs    , Monad m    , x :< xs    ) => V xs -> (x -> m y) -> Flow m (y ': ys)@@ -1211,7 +1211,7 @@  -- | Pop element, set the first value (>%~.>) ::-   ( ys ~ Filter x xs+   ( ys ~ Remove x xs    , Monad m    , x :< xs    ) => Flow m xs -> (x -> m y) -> Flow m (y ': ys)@@ -1225,10 +1225,10 @@    ( Monad m    , x :<? xs    , KnownNat (Length ys)-   ) => V xs -> (x -> Flow m ys) -> Flow m (Concat ys (Filter x xs))+   ) => V xs -> (x -> Flow m ys) -> Flow m (Concat ys (Remove x xs)) {-# INLINABLE (?~+>) #-} (?~+>) v f = case popVariantMaybe v of-   Right x -> appendVariant  @(Filter x xs) <$> f x+   Right x -> appendVariant  @(Remove x xs) <$> f x    Left ys -> prependVariant @ys            <$> return ys  infixl 0 ?~+>@@ -1238,7 +1238,7 @@    ( Monad m    , x :< xs    , KnownNat (Length ys)-   ) => Flow m xs -> (x -> Flow m ys) -> Flow m (Concat ys (Filter x xs))+   ) => Flow m xs -> (x -> Flow m ys) -> Flow m (Concat ys (Remove x xs)) {-# INLINABLE (>?~+>) #-} (>?~+>) = liftm (?~+>) @@ -1249,7 +1249,7 @@    ( Monad m    , x :< xs    , KnownNat (Length ys)-   ) => V xs -> (x -> Flow m ys) -> Flow m (Concat ys (Filter x xs))+   ) => V xs -> (x -> Flow m ys) -> Flow m (Concat ys (Remove x xs)) {-# INLINABLE (%~+>) #-} (%~+>) = (?~+>) @@ -1260,7 +1260,7 @@    ( Monad m    , x :< xs    , KnownNat (Length ys)-   ) => Flow m xs -> (x -> Flow m ys) -> Flow m (Concat ys (Filter x xs))+   ) => Flow m xs -> (x -> Flow m ys) -> Flow m (Concat ys (Remove x xs)) {-# INLINABLE (>%~+>) #-} (>%~+>) = liftm (%~+>) @@ -1270,8 +1270,8 @@ (?~^^>) :: forall x xs ys zs m.    ( Monad m    , x :<? xs-   , Liftable (Filter x xs) zs-   , Liftable ys zs+   , LiftVariant (Remove x xs) zs+   , LiftVariant ys zs    ) => V xs -> (x -> Flow m ys) -> Flow m zs {-# INLINABLE (?~^^>) #-} (?~^^>) v f = case popVariantMaybe v of@@ -1284,8 +1284,8 @@ (>?~^^>) :: forall x xs ys zs m.    ( Monad m    , x :<? xs-   , Liftable (Filter x xs) zs-   , Liftable ys zs+   , LiftVariant (Remove x xs) zs+   , LiftVariant ys zs    ) => Flow m xs -> (x -> Flow m ys) -> Flow m zs {-# INLINABLE (>?~^^>) #-} (>?~^^>) = liftm (?~^^>)@@ -1296,8 +1296,8 @@ (%~^^>) :: forall x xs ys zs m.    ( Monad m    , x :< xs-   , Liftable (Filter x xs) zs-   , Liftable ys zs+   , LiftVariant (Remove x xs) zs+   , LiftVariant ys zs    ) => V xs -> (x -> Flow m ys) -> Flow m zs {-# INLINABLE (%~^^>) #-} (%~^^>) = (?~^^>)@@ -1308,8 +1308,8 @@ (>%~^^>) :: forall x xs ys zs m.    ( Monad m    , x :< xs-   , Liftable (Filter x xs) zs-   , Liftable ys zs+   , LiftVariant (Remove x xs) zs+   , LiftVariant ys zs    ) => Flow m xs -> (x -> Flow m ys) -> Flow m zs {-# INLINABLE (>%~^^>) #-} (>%~^^>) = liftm (%~^^>)@@ -1320,7 +1320,7 @@ (?~^>) :: forall x xs zs m.    ( Monad m    , x :<? xs-   , Liftable (Filter x xs) zs+   , LiftVariant (Remove x xs) zs    ) => V xs -> (x -> Flow m zs) -> Flow m zs {-# INLINABLE (?~^>) #-} (?~^>) v f = case popVariantMaybe v of@@ -1333,7 +1333,7 @@ (>?~^>) :: forall x xs zs m.    ( Monad m    , x :<? xs-   , Liftable (Filter x xs) zs+   , LiftVariant (Remove x xs) zs    ) => Flow m xs -> (x -> Flow m zs) -> Flow m zs {-# INLINABLE (>?~^>) #-} (>?~^>) = liftm (?~^>)@@ -1344,7 +1344,7 @@ (%~^>) :: forall x xs zs m.    ( Monad m    , x :< xs-   , Liftable (Filter x xs) zs+   , LiftVariant (Remove x xs) zs    ) => V xs -> (x -> Flow m zs) -> Flow m zs {-# INLINABLE (%~^>) #-} (%~^>) = (?~^>)@@ -1355,7 +1355,7 @@ (>%~^>) :: forall x xs zs m.    ( Monad m    , x :< xs-   , Liftable (Filter x xs) zs+   , LiftVariant (Remove x xs) zs    ) => Flow m xs -> (x -> Flow m zs) -> Flow m zs {-# INLINABLE (>%~^>) #-} (>%~^>) = liftm (%~^>)@@ -1408,9 +1408,9 @@ (?~|>) :: forall x xs ys zs m.    ( Monad m    , x :<? xs-   , Liftable (Filter x xs) zs-   , Liftable ys zs-   , zs ~ Union (Filter x xs) ys+   , LiftVariant (Remove x xs) zs+   , LiftVariant ys zs+   , zs ~ Union (Remove x xs) ys    ) => V xs -> (x -> Flow m ys) -> Flow m zs {-# INLINABLE (?~|>) #-} (?~|>) v f = case popVariantMaybe v of@@ -1423,9 +1423,9 @@ (>?~|>) :: forall x xs ys zs m.    ( Monad m    , x :<? xs-   , Liftable (Filter x xs) zs-   , Liftable ys zs-   , zs ~ Union (Filter x xs) ys+   , LiftVariant (Remove x xs) zs+   , LiftVariant ys zs+   , zs ~ Union (Remove x xs) ys    ) => Flow m xs -> (x -> Flow m ys) -> Flow m zs {-# INLINABLE (>?~|>) #-} (>?~|>) = liftm (?~|>)@@ -1436,9 +1436,9 @@ (%~|>) :: forall x xs ys zs m.    ( Monad m    , x :< xs-   , Liftable (Filter x xs) zs-   , Liftable ys zs-   , zs ~ Union (Filter x xs) ys+   , LiftVariant (Remove x xs) zs+   , LiftVariant ys zs+   , zs ~ Union (Remove x xs) ys    ) => V xs -> (x -> Flow m ys) -> Flow m zs {-# INLINABLE (%~|>) #-} (%~|>) = (?~|>)@@ -1449,9 +1449,9 @@ (>%~|>) :: forall x xs ys zs m.    ( Monad m    , x :< xs-   , Liftable (Filter x xs) zs-   , Liftable ys zs-   , zs ~ Union (Filter x xs) ys+   , LiftVariant (Remove x xs) zs+   , LiftVariant ys zs+   , zs ~ Union (Remove x xs) ys    ) => Flow m xs -> (x -> Flow m ys) -> Flow m zs {-# INLINABLE (>%~|>) #-} (>%~|>) = liftm (%~|>)@@ -1546,7 +1546,7 @@ (?~!!>) :: forall x xs m.    ( Monad m    , x :<? xs-   ) => V xs -> (x -> m ()) -> Flow m (Filter x xs)+   ) => V xs -> (x -> m ()) -> Flow m (Remove x xs) {-# INLINABLE (?~!!>) #-} (?~!!>) v f = case popVariantMaybe v of    Right x -> f x >> error "?~!!> error"@@ -1558,7 +1558,7 @@ (>?~!!>) :: forall x xs m.    ( Monad m    , x :<? xs-   ) => Flow m xs -> (x -> m ()) -> Flow m (Filter x xs)+   ) => Flow m xs -> (x -> m ()) -> Flow m (Remove x xs) {-# INLINABLE (>?~!!>) #-} (>?~!!>) = liftm (?~!!>) @@ -1568,7 +1568,7 @@ (%~!!>) :: forall x xs m.    ( Monad m    , x :< xs-   ) => V xs -> (x -> m ()) -> Flow m (Filter x xs)+   ) => V xs -> (x -> m ()) -> Flow m (Remove x xs) {-# INLINABLE (%~!!>) #-} (%~!!>) = (?~!!>) @@ -1578,7 +1578,7 @@ (>%~!!>) :: forall x xs m.    ( Monad m    , x :< xs-   ) => Flow m xs -> (x -> m ()) -> Flow m (Filter x xs)+   ) => Flow m xs -> (x -> m ()) -> Flow m (Remove x xs) {-# INLINABLE (>%~!!>) #-} (>%~!!>) = liftm (%~!!>) @@ -1624,7 +1624,7 @@ -- | Select by type selectType ::    ( x :< xs-   ) => V xs -> Either (V (Filter x xs)) (V '[x])+   ) => V xs -> Either (V (Remove x xs)) (V '[x]) {-# INLINABLE selectType #-} selectType = fmap (toVariantAt @0) . popVariant @@ -1686,8 +1686,8 @@  -- | Union combineUnion ::-   ( Liftable xs (Union xs ys)-   , Liftable ys (Union xs ys)+   ( LiftVariant xs (Union xs ys)+   , LiftVariant ys (Union xs ys)    ) => Either (V ys) (V xs) -> V (Union xs ys) {-# INLINABLE combineUnion #-} combineUnion = \case@@ -1696,7 +1696,7 @@  -- | Lift unselected combineLiftUnselected ::-   ( Liftable ys xs+   ( LiftVariant ys xs    ) => Either (V ys) (V xs) -> V xs {-# INLINABLE combineLiftUnselected #-} combineLiftUnselected = \case@@ -1705,8 +1705,8 @@  -- | Lift both combineLiftBoth ::-   ( Liftable ys zs-   , Liftable xs zs+   ( LiftVariant ys zs+   , LiftVariant xs zs    ) => Either (V ys) (V xs) -> V zs {-# INLINABLE combineLiftBoth #-} combineLiftBoth = \case@@ -1907,7 +1907,7 @@    , ContVariant xs    , ys ~ FlattenVariant zs    , Flattenable (V zs) (V ys)-   , Liftable ys (Nub ys)+   , LiftVariant ys (Nub ys)    , rs ~ Nub ys    ) => V xs -> fs -> V rs (~||) v fs = nubVariant (flattenVariant (v -|| fs))@@ -1960,7 +1960,7 @@    , ys ~ FlattenVariant ks    , Flattenable (V ks) (V ys)    , rs ~ Nub ys-   , Liftable ys rs+   , LiftVariant ys rs    , Applicative m    , JoinVariant m zs    ) => V xs -> fs -> Flow m rs@@ -1976,7 +1976,7 @@    , ys ~ FlattenVariant ks    , Flattenable (V ks) (V ys)    , rs ~ Nub ys-   , Liftable ys rs+   , LiftVariant ys rs    , Monad m    , JoinVariant m zs    ) => Flow m xs -> fs -> Flow m rs
+ src/lib/Haskus/Utils/VariantF.hs view
@@ -0,0 +1,264 @@+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | VariantF functor+module Haskus.Utils.VariantF+   ( VariantF (..)+   , ApplyAll+   , pattern FV+   , appendVariantF+   , toVariantFHead+   , toVariantFTail+   , popVariantFHead+   , variantFToValue+   , MapVariantF+   , mapVariantF+   , PopVariantF+   , popVariantF+   , LiftVariantF+   , liftVariantF+   , AlterVariantF+   , alterVariantF+   , AlgVariantF+   , algVariantF+   , SplitVariantF+   , splitVariantF+   , variantFToCont+   , variantFToContM+   , contToVariantF+   , contToVariantFM+   -- * Reexport+   , NoConstraint+   , module Haskus.Utils.Functor+   )+where++import Haskus.Utils.Variant+import Haskus.Utils.Functor+import Haskus.Utils.Types.List+import Haskus.Utils.ContFlow++import Unsafe.Coerce+import Data.Bifunctor+import GHC.Exts (Any,Constraint)++-- | Recursive Functor-like Variant+newtype VariantF (xs :: [* -> *]) e+   = VariantF (V (ApplyAll e xs))++-- | Apply its first argument to every element of the 2nd arg list+--+-- > ApplyAll e '[f,g,h] ==> '[f e, g e, h e]+--+type family ApplyAll e (xs :: [* -> *]) :: [*] 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. 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)++type PopVariantF x xs e =+   ( x e :< ApplyAll e xs+   , Remove (x e) (ApplyAll e xs) ~ ApplyAll e (Remove x xs)+   )++-- | Pop VariantF+popVariantF :: forall x xs e.+   ( PopVariantF x xs e+   ) => VariantF xs e -> Either (VariantF (Remove x xs) e) (x e)+{-# INLINE popVariantF #-}+popVariantF (VariantF v) = case popVariant v of+   Right x -> Right x+   Left xs -> Left (VariantF xs)++type MapVariantF a b cs ds e =+   ( MapVariant (a e) (b e) (ApplyAll e cs)+   , ds ~ ReplaceNS (IndexesOf a cs) b cs+   , ApplyAll e ds ~ ReplaceNS (IndexesOf (a e) (ApplyAll e cs)) (b e) (ApplyAll e cs)+   )++-- | Map the matching types of a variant+mapVariantF :: forall a b cs ds e.+   ( MapVariantF a b cs ds e+   ) => (a e -> b e) -> VariantF cs e -> VariantF ds e+mapVariantF f (VariantF v) = VariantF (mapVariant @(a e) @(b e) @(ApplyAll e cs) f v)++-- | xs is liftable in ys+type LiftVariantF e xs ys =+   ( IsSubset xs ys ~ 'True+   , LiftVariant (ApplyAll e xs) (ApplyAll e ys)+   )++-- | Lift a VariantF into another+liftVariantF :: forall e as bs.+   ( LiftVariantF e as bs+   ) => VariantF as e -> VariantF bs e+liftVariantF (VariantF v) = VariantF (liftVariant' v)++class AlterVariantF (c :: (* -> *) -> Constraint) e (xs :: [* -> *]) where+   alterVariantF' :: (forall (f :: * -> *). c f => f e -> f e) -> Word -> Any -> Any++instance AlterVariantF c e '[] where+   {-# INLINE alterVariantF' #-}+   alterVariantF' _ = undefined++instance+   ( AlterVariantF c e xs+   , c x+   ) => AlterVariantF c e (x ': xs)+   where+      {-# INLINE alterVariantF' #-}+      alterVariantF' f t v =+         case t of+            0 -> unsafeCoerce (f (unsafeCoerce v :: x e))+            n -> alterVariantF' @c @e @xs f (n-1) v++-- | Alter a variant. You need to specify the constraints required by the+-- modifying function.+--+-- Usage:+--+-- >   alterVariantF @NoConstraint id         v+-- >   alterVariantF @Resizable    (resize 4) v+-- >+-- >   -- Multiple constraints:+-- >   class (Ord a, Num a) => OrdNum a+-- >   instance (Ord a, Num a) => OrdNum a+-- >   alterVariantF @OrdNum foo v+--+alterVariantF :: forall c e (xs :: [* -> *]).+   ( AlterVariantF c e xs+   ) => (forall (f :: * -> *). c f => f e -> f e) -> VariantF xs e -> VariantF xs e+{-# INLINABLE alterVariantF #-}+alterVariantF f (VariantF (Variant t a)) =+   VariantF (Variant t (alterVariantF' @c @e @xs f t a))+++class AlgVariantF (c :: (* -> *) -> Constraint) e (xs :: [* -> *]) where+   algVariantF' :: (forall (f :: * -> *). c f => f e -> e) -> Word -> Any -> e++instance AlgVariantF c e '[] where+   {-# INLINE algVariantF' #-}+   algVariantF' _ = undefined++instance+   ( AlgVariantF c e xs+   , c x+   ) => AlgVariantF c e (x ': xs)+   where+      {-# INLINE algVariantF' #-}+      algVariantF' f t v =+         case t of+            0 -> f (unsafeCoerce v :: x e)+            n -> algVariantF' @c @e @xs f (n-1) v++-- | Apply an algebra to a VariantF. You need to specify the constraints+-- required by the modifying function.+--+-- Usage:+--+-- >  algVariantF @NoConstraint id         v+-- >  algVariantF @Resizable    (resize 4) v+--+algVariantF :: forall c e (xs :: [* -> *]).+   ( AlgVariantF c e xs+   ) => (forall (f :: * -> *). c f => f e -> e) -> VariantF xs e -> e+{-# INLINABLE algVariantF #-}+algVariantF f (VariantF (Variant t a)) = algVariantF' @c @e @xs f t a++type SplitVariantF as xs e =+   ( Complement (ApplyAll e xs) (ApplyAll e as) ~ ApplyAll e (Complement xs as)+   , SplitVariant (ApplyAll e as) (ApplyAll e xs) (ApplyAll e xs)+   )++-- | Split a VariantF in two+splitVariantF :: forall as xs e.+   ( SplitVariantF as xs e+   ) => VariantF xs e+     -> Either (VariantF as e) (VariantF (Complement xs as) e)+splitVariantF (VariantF v) = bimap VariantF VariantF (splitVariant v)++-- | Convert a VariantF into a multi-continuation+variantFToCont :: ContVariant (ApplyAll e xs)+   => VariantF xs e -> ContFlow (ApplyAll e xs) r+variantFToCont (VariantF v) = variantToCont v++-- | Convert a VariantF into a multi-continuation+variantFToContM ::+   ( ContVariant (ApplyAll e xs)+   , Monad m+   ) => m (VariantF xs e) -> ContFlow (ApplyAll e xs) (m r)+variantFToContM f = variantToContM (unvariantF <$> f)+   where+      unvariantF (VariantF v) = v++-- | Convert a multi-continuation into a VariantF+contToVariantF :: forall xs e.+   ( ContVariant (ApplyAll e xs)+   ) => ContFlow (ApplyAll e xs) (V (ApplyAll e xs)) -> VariantF xs e+contToVariantF c = VariantF (contToVariant c)++-- | Convert a multi-continuation into a VariantF+contToVariantFM :: forall xs e m.+   ( ContVariant (ApplyAll e xs)+   , Monad m+   ) => ContFlow (ApplyAll e xs) (m (V (ApplyAll e xs))) -> m (VariantF xs e)+contToVariantFM f = VariantF <$> contToVariantM f++instance ContVariant (ApplyAll e xs) => MultiCont (VariantF xs e) where+   type MultiContTypes (VariantF xs e) = ApplyAll e xs+   toCont = variantFToCont+   toContM = variantFToContM