haskus-utils-variant-2.4: Variant and EADT

Safe HaskellNone
LanguageHaskell2010

Haskus.Utils.Variant.OldFlow

Contents

Description

Variant based control-flow (deprecated)

Synopsis

Documentation

type Flow m (l :: [*]) = m (V l) Source #

Control-flow

type IOV l = Flow IO l Source #

Flow utils

flowRes :: Functor m => Flow m '[x] -> m x Source #

Extract single flow result

flowSingle :: Monad m => x -> Flow m '[x] Source #

Return a single element

flowSetN :: forall (n :: Nat) xs m. (Monad m, KnownNat n) => Index n xs -> Flow m xs Source #

Return in the first element

flowSet :: (x :< xs, Monad m) => x -> Flow m xs Source #

Return in the first well-typed element

flowLift :: (LiftVariant xs ys, Monad m) => Flow m xs -> Flow m ys Source #

Lift a flow into another

flowToCont :: (ContVariant xs, Monad m) => Flow m xs -> ContFlow xs (m r) Source #

Lift a flow into a ContFlow

flowTraverse :: forall m a b xs. Monad m => (a -> Flow m (b ': xs)) -> [a] -> Flow m ([b] ': xs) Source #

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) Source #

Traverse a list and stop on first error

flowTraverseFilter :: forall m a b xs. Monad m => (a -> Flow m (b ': xs)) -> [a] -> m [b] Source #

Traverse a list and return only valid values

flowForFilter :: forall m a b xs. Monad m => [a] -> (a -> Flow m (b ': xs)) -> m [b] Source #

Traverse a list and return only valid values

type LiftVariant xs ys = (LiftVariant' xs ys, xs :<< ys) Source #

xs is liftable in ys

type (:<) x xs = (CheckMember x xs, Member x xs, x :<? xs) Source #

A value of type "x" can be extracted from (V xs)

type (:<?) x xs = PopVariant x xs Source #

A value of type "x" **might** be extracted from (V xs). We don't check that "x" is in "xs".

Functor, applicative equivalents

(<$<) :: forall m l a b. Monad m => (a -> b) -> Flow m (a ': l) -> Flow m (b ': l) infixl 4 Source #

Functor $ equivalent

(<*<) :: forall m l a b. Monad m => Flow m ((a -> b) ': l) -> Flow m (a ': l) -> Flow m (b ': l) infixl 4 Source #

Applicative * equivalent

(<|<) :: forall m xs ys zs y z. (Monad m, LiftVariant xs zs, LiftVariant ys zs, zs ~ Union xs ys) => Flow m ((y -> z) ': xs) -> Flow m (y ': ys) -> Flow m (z ': zs) infixl 4 Source #

Applicative * equivalent, with error union

Named operators

flowMap :: Monad m => Flow m (x ': xs) -> (x -> y) -> Flow m (y ': xs) Source #

Map a pure function onto the correct value in the flow

flowBind :: forall xs ys zs m x. (LiftVariant xs zs, LiftVariant ys zs, zs ~ Union xs ys, Monad m) => Flow m (x ': ys) -> (x -> Flow m xs) -> Flow m zs Source #

Bind two flows in a monadish way (error types union)

flowBind' :: Monad m => Flow m (x ': xs) -> (x -> Flow m (y ': xs)) -> Flow m (y ': xs) Source #

Bind two flows in a monadic way (constant error types)

flowMatch :: forall x xs zs m. (Monad m, x :< xs, LiftVariant (Remove x xs) zs) => Flow m xs -> (x -> Flow m zs) -> Flow m zs Source #

Match a value in a flow

flowMatchFail :: forall x xs m. (Monad m, x :< xs) => Flow m xs -> (x -> m ()) -> Flow m (Remove x xs) Source #

Match a value in a flow and use a non-returning failure in this case

Operation on first element

(.~.>) :: forall m l x a. Monad m => V (a ': l) -> (a -> m x) -> Flow m (x ': l) infixl 0 Source #

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) infixl 0 Source #

Extract the first value, set the first value

(.~+>) :: forall (k :: Nat) m l l2 a. (KnownNat k, k ~ Length l2, Monad m) => V (a ': l) -> (a -> Flow m l2) -> Flow m (Concat l2 l) infixl 0 Source #

Extract the first value, concat the result

(>.~+>) :: 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) infixl 0 Source #

Extract the first value, concat the results

(.~^^>) :: forall m a xs ys zs. (Monad m, LiftVariant xs zs, LiftVariant ys zs) => V (a ': ys) -> (a -> Flow m xs) -> Flow m zs infixl 0 Source #

Extract the first value, lift both

(>.~^^>) :: forall m a xs ys zs. (Monad m, LiftVariant xs zs, LiftVariant ys zs) => Flow m (a ': ys) -> (a -> Flow m xs) -> Flow m zs infixl 0 Source #

Extract the first value, lift both

(.~^>) :: forall m a ys zs. (Monad m, LiftVariant ys zs) => V (a ': ys) -> (a -> Flow m zs) -> Flow m zs infixl 0 Source #

Extract the first value, lift unselected

(>.~^>) :: forall m a ys zs. (Monad m, LiftVariant ys zs) => Flow m (a ': ys) -> (a -> Flow m zs) -> Flow m zs infixl 0 Source #

Extract the first value, lift unselected

(.~$>) :: forall m x xs a. Monad m => V (a ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs) infixl 0 Source #

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) infixl 0 Source #

Extract the first value, use the same tail

(.~|>) :: (LiftVariant xs zs, LiftVariant ys zs, zs ~ Union xs ys, Monad m) => V (a ': ys) -> (a -> Flow m xs) -> Flow m zs infixl 0 Source #

Take the first output, union the result

(>.~|>) :: (LiftVariant xs zs, LiftVariant ys zs, zs ~ Union xs ys, Monad m) => Flow m (a ': ys) -> (a -> Flow m xs) -> Flow m zs infixl 0 Source #

Take the first output, fusion the result

(.~=>) :: Monad m => V (a ': l) -> (a -> m ()) -> Flow m (a ': l) infixl 0 Source #

Extract the first value and perform effect. Passthrough the input value

(>.~=>) :: Monad m => Flow m (a ': l) -> (a -> m ()) -> Flow m (a ': l) infixl 0 Source #

Extract the first value and perform effect. Passthrough the input value

(.~!>) :: Monad m => V (a ': l) -> (a -> m ()) -> m () infixl 0 Source #

Extract the first value and perform effect.

(>.~!>) :: Monad m => Flow m (a ': l) -> (a -> m ()) -> m () infixl 0 Source #

Extract the first value and perform effect.

(.~!!>) :: Monad m => V (a ': l) -> (a -> m ()) -> m (V l) infixl 0 Source #

Extract the first value and perform effect.

(>.~!!>) :: Monad m => Flow m (a ': l) -> (a -> m ()) -> m (V l) infixl 0 Source #

Extract the first value and perform effect.

Pure

(.-.>) :: forall m l x a. Monad m => V (a ': l) -> (a -> x) -> Flow m (x ': l) infixl 0 Source #

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) infixl 0 Source #

Extract the first value, set the first value

(<.-.) :: forall m l x a. Monad m => (a -> x) -> V (a ': l) -> Flow m (x ': l) infixr 0 Source #

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) infixr 0 Source #

Extract the first value, set the first value

Const

(.~~.>) :: forall m l x a. Monad m => V (a ': l) -> m x -> Flow m (x ': l) infixl 0 Source #

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) infixl 0 Source #

Extract the first value, set the first value

(.~~+>) :: forall (k :: Nat) m l l2 a. (KnownNat k, k ~ Length l2, Monad m) => V (a ': l) -> Flow m l2 -> Flow m (Concat l2 l) infixl 0 Source #

Extract the first value, concat the result

(>.~~+>) :: 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) infixl 0 Source #

Extract the first value, concat the results

(.~~^^>) :: forall m a xs ys zs. (Monad m, LiftVariant xs zs, LiftVariant ys zs) => V (a ': ys) -> Flow m xs -> Flow m zs infixl 0 Source #

Extract the first value, lift the result

(>.~~^^>) :: forall m a xs ys zs. (Monad m, LiftVariant xs zs, LiftVariant ys zs) => Flow m (a ': ys) -> Flow m xs -> Flow m zs infixl 0 Source #

Extract the first value, lift the result

(.~~^>) :: forall m a ys zs. (Monad m, LiftVariant ys zs) => V (a ': ys) -> Flow m zs -> Flow m zs infixl 0 Source #

Extract the first value, connect to the expected output

(>.~~^>) :: forall m a ys zs. (Monad m, LiftVariant ys zs) => Flow m (a ': ys) -> Flow m zs -> Flow m zs infixl 0 Source #

Extract the first value, connect to the expected output

(.~~$>) :: forall m x xs a. Monad m => V (a ': xs) -> Flow m (x ': xs) -> Flow m (x ': xs) infixl 0 Source #

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) infixl 0 Source #

Extract the first value, use the same output type

(.~~|>) :: (LiftVariant xs zs, LiftVariant ys zs, zs ~ Union xs ys, Monad m) => V (a ': ys) -> Flow m xs -> Flow m zs infixl 0 Source #

Take the first output, fusion the result

(>.~~|>) :: (LiftVariant xs zs, LiftVariant ys zs, zs ~ Union xs ys, Monad m) => Flow m (a ': ys) -> Flow m xs -> Flow m zs infixl 0 Source #

Take the first output, fusion the result

(.~~=>) :: Monad m => V (a ': l) -> m () -> Flow m (a ': l) infixl 0 Source #

Extract the first value and perform effect. Passthrough the input value

(>.~~=>) :: Monad m => Flow m (a ': l) -> m () -> Flow m (a ': l) infixl 0 Source #

Extract the first value and perform effect. Passthrough the input value

(.~~!>) :: Monad m => V (a ': l) -> m () -> m () infixl 0 Source #

Extract the first value and perform effect.

(>.~~!>) :: Monad m => Flow m (a ': l) -> m () -> m () infixl 0 Source #

Extract the first value and perform effect.

Operation on tail

(..~.>) :: Monad m => V (a ': l) -> (V l -> m a) -> m a infixl 0 Source #

Extract the tail, set the first value

(>..~.>) :: Monad m => Flow m (a ': l) -> (V l -> m a) -> m a infixl 0 Source #

Extract the tail, set the first value

(..-.>) :: Monad m => V (a ': l) -> (V l -> a) -> m a infixl 0 Source #

Extract the tail, set the first value (pure function)

(>..-.>) :: Monad m => Flow m (a ': l) -> (V l -> a) -> m a infixl 0 Source #

Extract the tail, set the first value (pure function)

(..-..>) :: forall a l xs m. Monad m => V (a ': l) -> (V l -> V xs) -> Flow m (a ': xs) infixl 0 Source #

Extract the tail, set the tail

(>..-..>) :: Monad m => Flow m (a ': l) -> (V l -> V xs) -> Flow m (a ': xs) infixl 0 Source #

Extract the tail, set the tail

(..~..>) :: forall a l xs m. Monad m => V (a ': l) -> (V l -> Flow m xs) -> Flow m (a ': xs) infixl 0 Source #

Extract the tail, set the tail

(>..~..>) :: Monad m => Flow m (a ': l) -> (V l -> Flow m xs) -> Flow m (a ': xs) infixl 0 Source #

Extract the tail, set the tail

(..~^^>) :: (Monad m, LiftVariant xs (a ': zs)) => V (a ': l) -> (V l -> Flow m xs) -> Flow m (a ': zs) infixl 0 Source #

Extract the tail, lift the result

(>..~^^>) :: (Monad m, LiftVariant xs (a ': zs)) => Flow m (a ': l) -> (V l -> Flow m xs) -> Flow m (a ': zs) infixl 0 Source #

Extract the tail, lift the result

(..~^>) :: (Monad m, a :< zs) => V (a ': l) -> (V l -> Flow m zs) -> Flow m zs infixl 0 Source #

Extract the tail, connect the result

(>..~^>) :: (Monad m, a :< zs) => Flow m (a ': l) -> (V l -> Flow m zs) -> Flow m zs infixl 0 Source #

Extract the tail, connect the result

(..~=>) :: Monad m => V (x ': xs) -> (V xs -> m ()) -> Flow m (x ': xs) infixl 0 Source #

Extract the tail and perform an effect. Passthrough the input value

(>..~=>) :: Monad m => Flow m (x ': xs) -> (V xs -> m ()) -> Flow m (x ': xs) infixl 0 Source #

Extract the tail and perform an effect. Passthrough the input value

(..~!>) :: Monad m => V (x ': xs) -> (V xs -> m ()) -> m () infixl 0 Source #

Extract the tail and perform an effect

(>..~!>) :: Monad m => Flow m (x ': xs) -> (V xs -> m ()) -> m () infixl 0 Source #

Extract the tail and perform an effect

(..~!!>) :: Monad m => V (x ': xs) -> (V xs -> m ()) -> m x infixl 0 Source #

Extract the tail and perform an effect

(>..~!!>) :: Monad m => Flow m (x ': xs) -> (V xs -> m ()) -> m x infixl 0 Source #

Extract the tail and perform an effect

Operation on caught element in tail

(..%~^>) :: (Monad m, a :< xs, LiftVariant (Remove a xs) ys) => V (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys) infixl 0 Source #

Match in the tail, connect to the expected result

(>..%~^>) :: (Monad m, a :< xs, LiftVariant (Remove a xs) ys) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys) infixl 0 Source #

Match in the tail, connect to the expected result

(..%~^^>) :: (Monad m, a :< xs, LiftVariant (Remove a xs) zs, LiftVariant ys zs) => V (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs) infixl 0 Source #

Match in the tail, lift to the expected result

(>..%~^^>) :: (Monad m, a :< xs, LiftVariant (Remove a xs) zs, LiftVariant ys zs) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs) infixl 0 Source #

Match in the tail, lift to the expected result

(..%~$>) :: (Monad m, a :< xs, LiftVariant (Remove a xs) (x ': xs)) => V (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs) infixl 0 Source #

Match in the tail, keep the same types

(>..%~$>) :: (Monad m, a :< xs, LiftVariant (Remove a xs) (x ': xs)) => Flow m (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs) infixl 0 Source #

Match in the tail, keep the same types

(..%~!!>) :: (Monad m, y :< xs) => V (x ': xs) -> (y -> m ()) -> Flow m (x ': Remove y xs) infixl 0 Source #

Match in the tail and perform an effect

(>..%~!!>) :: (Monad m, y :< xs) => Flow m (x ': xs) -> (y -> m ()) -> Flow m (x ': Remove y xs) infixl 0 Source #

Match in the tail and perform an effect

(..%~!>) :: (Monad m, y :< xs) => V (x ': xs) -> (y -> m ()) -> m () infixl 0 Source #

Match in the tail and perform an effect

(>..%~!>) :: (Monad m, y :< xs) => Flow m (x ': xs) -> (y -> m ()) -> m () infixl 0 Source #

Match in the tail and perform an effect

(..?~^>) :: (Monad m, a :<? xs, LiftVariant (Remove a xs) ys) => V (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys) infixl 0 Source #

Match in the tail, connect to the expected result

(>..?~^>) :: (Monad m, a :<? xs, LiftVariant (Remove a xs) ys) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': ys) infixl 0 Source #

Match in the tail, connect to the expected result

(..?~^^>) :: (Monad m, a :<? xs, LiftVariant (Remove a xs) zs, LiftVariant ys zs) => V (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs) infixl 0 Source #

Match in the tail, lift to the expected result

(>..?~^^>) :: (Monad m, a :<? xs, LiftVariant (Remove a xs) zs, LiftVariant ys zs) => Flow m (x ': xs) -> (a -> Flow m ys) -> Flow m (x ': zs) infixl 0 Source #

Match in the tail, lift to the expected result

(..?~$>) :: (Monad m, a :<? xs, LiftVariant (Remove a xs) (x ': xs)) => V (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs) infixl 0 Source #

Match in the tail, keep the same types

(>..?~$>) :: (Monad m, a :<? xs, LiftVariant (Remove a xs) (x ': xs)) => Flow m (x ': xs) -> (a -> Flow m (x ': xs)) -> Flow m (x ': xs) infixl 0 Source #

Match in the tail, keep the same types

(..?~!!>) :: (Monad m, y :<? xs) => V (x ': xs) -> (y -> m ()) -> Flow m (x ': Remove y xs) infixl 0 Source #

Match in the tail and perform an effect

(>..?~!!>) :: (Monad m, y :<? xs) => Flow m (x ': xs) -> (y -> m ()) -> Flow m (x ': Remove y xs) infixl 0 Source #

Match in the tail and perform an effect

(..?~!>) :: (Monad m, y :<? xs) => V (x ': xs) -> (y -> m ()) -> m () infixl 0 Source #

Match in the tail and perform an effect

(>..?~!>) :: (Monad m, y :<? xs) => Flow m (x ': xs) -> (y -> m ()) -> m () infixl 0 Source #

Match in the tail and perform an effect

Operation on caught element

(%~.>) :: forall x xs y ys m. (ys ~ Remove x xs, Monad m, x :< xs) => V xs -> (x -> m y) -> Flow m (y ': ys) infixl 0 Source #

Pop element, set the first value

(>%~.>) :: (ys ~ Remove x xs, Monad m, x :< xs) => Flow m xs -> (x -> m y) -> Flow m (y ': ys) infixl 0 Source #

Pop element, set the first value

(%~+>) :: forall x xs ys m. (Monad m, x :< xs, KnownNat (Length ys)) => V xs -> (x -> Flow m ys) -> Flow m (Concat ys (Remove x xs)) infixl 0 Source #

Pop element, concat the result

(>%~+>) :: forall x xs ys m. (Monad m, x :< xs, KnownNat (Length ys)) => Flow m xs -> (x -> Flow m ys) -> Flow m (Concat ys (Remove x xs)) infixl 0 Source #

Pop element, concat the result

(%~^^>) :: forall x xs ys zs m. (Monad m, x :< xs, LiftVariant (Remove x xs) zs, LiftVariant ys zs) => V xs -> (x -> Flow m ys) -> Flow m zs infixl 0 Source #

Pop element, lift the result

(>%~^^>) :: forall x xs ys zs m. (Monad m, x :< xs, LiftVariant (Remove x xs) zs, LiftVariant ys zs) => Flow m xs -> (x -> Flow m ys) -> Flow m zs infixl 0 Source #

Pop element, lift the result

(%~^>) :: forall x xs zs m. (Monad m, x :< xs, LiftVariant (Remove x xs) zs) => V xs -> (x -> Flow m zs) -> Flow m zs infixl 0 Source #

Pop element, connect to the expected output

(>%~^>) :: forall x xs zs m. (Monad m, x :< xs, LiftVariant (Remove x xs) zs) => Flow m xs -> (x -> Flow m zs) -> Flow m zs infixl 0 Source #

Pop element, connect to the expected output

(%~$>) :: forall x xs m. (Monad m, x :< xs) => V xs -> (x -> Flow m xs) -> Flow m xs infixl 0 Source #

Pop element, use the same output type

(>%~$>) :: forall x xs m. (Monad m, x :< xs) => Flow m xs -> (x -> Flow m xs) -> Flow m xs infixl 0 Source #

Pop element, use the same output type

(%~|>) :: forall x xs ys zs m. (Monad m, x :< xs, LiftVariant (Remove x xs) zs, LiftVariant ys zs, zs ~ Union (Remove x xs) ys) => V xs -> (x -> Flow m ys) -> Flow m zs infixl 0 Source #

Pop element, fusion the result

(>%~|>) :: forall x xs ys zs m. (Monad m, x :< xs, LiftVariant (Remove x xs) zs, LiftVariant ys zs, zs ~ Union (Remove x xs) ys) => Flow m xs -> (x -> Flow m ys) -> Flow m zs infixl 0 Source #

Pop element, fusion the result

(%~=>) :: forall x xs m. (Monad m, x :< xs) => V xs -> (x -> m ()) -> Flow m xs infixl 0 Source #

Pop element and perform effect. Passthrough the input value.

(>%~=>) :: forall x xs m. (Monad m, x :< xs) => Flow m xs -> (x -> m ()) -> Flow m xs infixl 0 Source #

Pop element and perform effect. Passthrough the input value.

(%~!>) :: forall x xs m. (Monad m, x :< xs) => V xs -> (x -> m ()) -> m () infixl 0 Source #

Pop element and perform effect.

(>%~!>) :: forall x xs m. (Monad m, x :< xs) => Flow m xs -> (x -> m ()) -> m () infixl 0 Source #

Pop element and perform effect.

(%~!!>) :: forall x xs m. (Monad m, x :< xs) => V xs -> (x -> m ()) -> Flow m (Remove x xs) infixl 0 Source #

Pop element and perform effect.

(>%~!!>) :: forall x xs m. (Monad m, x :< xs) => Flow m xs -> (x -> m ()) -> Flow m (Remove x xs) infixl 0 Source #

Pop element and perform effect.

(?~.>) :: forall x xs y ys m. (ys ~ Remove x xs, Monad m, x :<? xs) => V xs -> (x -> m y) -> Flow m (y ': ys) infixl 0 Source #

Pop element, set the first value

(>?~.>) :: (ys ~ Remove x xs, Monad m, x :<? xs) => Flow m xs -> (x -> m y) -> Flow m (y ': ys) infixl 0 Source #

Pop element, set the first value

(?~+>) :: forall x xs ys m. (Monad m, x :<? xs, KnownNat (Length ys)) => V xs -> (x -> Flow m ys) -> Flow m (Concat ys (Remove x xs)) infixl 0 Source #

Pop element, concat the result

(>?~+>) :: forall x xs ys m. (Monad m, x :< xs, KnownNat (Length ys)) => Flow m xs -> (x -> Flow m ys) -> Flow m (Concat ys (Remove x xs)) infixl 0 Source #

Pop element, concat the result

(?~^^>) :: forall x xs ys zs m. (Monad m, x :<? xs, LiftVariant (Remove x xs) zs, LiftVariant ys zs) => V xs -> (x -> Flow m ys) -> Flow m zs infixl 0 Source #

Pop element, lift the result

(>?~^^>) :: forall x xs ys zs m. (Monad m, x :<? xs, LiftVariant (Remove x xs) zs, LiftVariant ys zs) => Flow m xs -> (x -> Flow m ys) -> Flow m zs infixl 0 Source #

Pop element, lift the result

(?~^>) :: forall x xs zs m. (Monad m, x :<? xs, LiftVariant (Remove x xs) zs) => V xs -> (x -> Flow m zs) -> Flow m zs infixl 0 Source #

Pop element, connect to the expected output

(>?~^>) :: forall x xs zs m. (Monad m, x :<? xs, LiftVariant (Remove x xs) zs) => Flow m xs -> (x -> Flow m zs) -> Flow m zs infixl 0 Source #

Pop element, connect to the expected output

(?~$>) :: forall x xs m. (Monad m, x :<? xs) => V xs -> (x -> Flow m xs) -> Flow m xs infixl 0 Source #

Pop element, use the same output type

(>?~$>) :: forall x xs m. (Monad m, x :<? xs) => Flow m xs -> (x -> Flow m xs) -> Flow m xs infixl 0 Source #

Pop element, use the same output type

(?~|>) :: forall x xs ys zs m. (Monad m, x :<? xs, LiftVariant (Remove x xs) zs, LiftVariant ys zs, zs ~ Union (Remove x xs) ys) => V xs -> (x -> Flow m ys) -> Flow m zs infixl 0 Source #

Pop element, fusion the result

(>?~|>) :: forall x xs ys zs m. (Monad m, x :<? xs, LiftVariant (Remove x xs) zs, LiftVariant ys zs, zs ~ Union (Remove x xs) ys) => Flow m xs -> (x -> Flow m ys) -> Flow m zs infixl 0 Source #

Pop element, fusion the result

(?~=>) :: forall x xs m. (Monad m, x :<? xs) => V xs -> (x -> m ()) -> Flow m xs infixl 0 Source #

Pop element and perform effect. Passthrough the input value.

(>?~=>) :: forall x xs m. (Monad m, x :<? xs) => Flow m xs -> (x -> m ()) -> Flow m xs infixl 0 Source #

Pop element and perform effect. Passthrough the input value.

(?~!>) :: forall x xs m. (Monad m, x :<? xs) => V xs -> (x -> m ()) -> m () infixl 0 Source #

Pop element and perform effect.

(>?~!>) :: forall x xs m. (Monad m, x :<? xs) => Flow m xs -> (x -> m ()) -> m () infixl 0 Source #

Pop element and perform effect.

(?~!!>) :: forall x xs m. (Monad m, x :<? xs) => V xs -> (x -> m ()) -> Flow m (Remove x xs) infixl 0 Source #

Pop element and perform effect.

(>?~!!>) :: forall x xs m. (Monad m, x :<? xs) => Flow m xs -> (x -> m ()) -> Flow m (Remove x xs) infixl 0 Source #

Pop element and perform effect.

Operation on every element

(-||) :: forall fs xs zs. (LiftCont fs, zs ~ ExtractRHS (TupleToList fs), LiftContTuple fs ~ ContListToTuple xs (V zs), ContVariant xs) => V xs -> fs -> V zs Source #

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 m fs xs zs ks. (LiftCont fs, zs ~ ExtractRHS (TupleToList fs), LiftContTuple fs ~ ContListToTuple xs (V zs), ContVariant xs, ks ~ ExtractM m zs, Applicative m, JoinVariant m zs) => V xs -> fs -> Flow m ks Source #

Applicative pure multi-map

(>-||>) :: forall m fs xs zs ks. (LiftCont fs, zs ~ ExtractRHS (TupleToList fs), LiftContTuple fs ~ ContListToTuple xs (V zs), ContVariant xs, ks ~ ExtractM m zs, Monad m, JoinVariant m zs) => Flow m xs -> fs -> Flow m ks Source #

Monadic pure multi-map

(~||) :: forall fs xs zs ys rs. (LiftCont fs, zs ~ ExtractRHS (TupleToList fs), LiftContTuple fs ~ ContListToTuple xs (V zs), ContVariant xs, ys ~ FlattenVariant zs, Flattenable (V zs) (V ys), LiftVariant ys (Nub ys), rs ~ Nub ys) => V xs -> fs -> V rs Source #

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 m fs xs zs ks ys rs. (ContVariant xs, LiftCont fs, zs ~ ExtractRHS (TupleToList fs), LiftContTuple fs ~ ContListToTuple xs (V zs), ks ~ ExtractM m zs, ys ~ FlattenVariant ks, Flattenable (V ks) (V ys), rs ~ Nub ys, LiftVariant ys rs, Applicative m, JoinVariant m zs) => V xs -> fs -> Flow m rs Source #

Applicative variant multi-map

   mapInt64 :: Int64 -> IO (V '[Int16,Int32,Int64])
   mapInt64 x
      | x <= 0xffff     = do
         putStrLn "Found Int16!"
         return (toVariantAt 0 (fromIntegral x))
      | x <= 0xffffffff = do
         putStrLn "Found Int32!"
         return (toVariantAt 1 (fromIntegral x))
      | otherwise       = do
         putStrLn "Found Int64!"
         return (toVariantAt 2 x)

   mapInt32 :: Int32 -> IO (V '[Int16,Int32])
   mapInt32 x
      | x <= 0xffff     = do
         putStrLn "Found Int16!"
         return (toVariantAt 0 (fromIntegral x))
      | otherwise       = do
         putStrLn "Found Int32!"
         return (toVariantAt 1 x)

   v = V Int64 @'[Int64,Int32] 10

   > x v -|| (mapInt64,mapInt32)
   Found Int16!

   > :t x
   x :: V '[V '[Int16, Int32, Int64], V '[Int16, Int32]]

   > x v ~|| (mapInt64,mapInt32)
   Found Int16!

   > :t x
   x :: V '[Int16, Int32, Int64]

(>~||>) :: forall m fs xs zs ks ys rs. (ContVariant xs, LiftCont fs, zs ~ ExtractRHS (TupleToList fs), LiftContTuple fs ~ ContListToTuple xs (V zs), ks ~ ExtractM m zs, ys ~ FlattenVariant ks, Flattenable (V ks) (V ys), rs ~ Nub ys, LiftVariant ys rs, Monad m, JoinVariant m zs) => Flow m xs -> fs -> Flow m rs Source #

Monadic variant multi-map

class LiftCont x where Source #

Methods

liftCont :: x -> LiftContTuple x Source #

Lift a tuple of functions (a -> r1, b -> r2, ...) into a tuple of functions (a -> V '[r1,r2,...], b -> V '[r1,r2,...], ...)

Instances
LiftCont (Single (a -> b)) Source # 
Instance details

Defined in Haskus.Utils.Variant.OldFlow

Methods

liftCont :: Single (a -> b) -> LiftContTuple (Single (a -> b)) Source #

LiftCont (a -> b, c -> d) Source # 
Instance details

Defined in Haskus.Utils.Variant.OldFlow

Methods

liftCont :: (a -> b, c -> d) -> LiftContTuple (a -> b, c -> d) Source #

LiftCont (a -> b, c -> d, e -> f) Source # 
Instance details

Defined in Haskus.Utils.Variant.OldFlow

Methods

liftCont :: (a -> b, c -> d, e -> f) -> LiftContTuple (a -> b, c -> d, e -> f) Source #

LiftCont (a -> b, c -> d, e -> f, g -> h) Source # 
Instance details

Defined in Haskus.Utils.Variant.OldFlow

Methods

liftCont :: (a -> b, c -> d, e -> f, g -> h) -> LiftContTuple (a -> b, c -> d, e -> f, g -> h) Source #

LiftCont (a -> b, c -> d, e -> f, g -> h, i -> j) Source # 
Instance details

Defined in Haskus.Utils.Variant.OldFlow

Methods

liftCont :: (a -> b, c -> d, e -> f, g -> h, i -> j) -> LiftContTuple (a -> b, c -> d, e -> f, g -> h, i -> j) Source #

LiftCont (a -> b, c -> d, e -> f, g -> h, i -> j, k -> l) Source # 
Instance details

Defined in Haskus.Utils.Variant.OldFlow

Methods

liftCont :: (a -> b, c -> d, e -> f, g -> h, i -> j, k -> l) -> LiftContTuple (a -> b, c -> d, e -> f, g -> h, i -> j, k -> l) Source #

LiftCont (a -> b, c -> d, e -> f, g -> h, i -> j, k -> l, m -> n) Source # 
Instance details

Defined in Haskus.Utils.Variant.OldFlow

Methods

liftCont :: (a -> b, c -> d, e -> f, g -> h, i -> j, k -> l, m -> n) -> LiftContTuple (a -> b, c -> d, e -> f, g -> h, i -> j, k -> l, m -> n) Source #

LiftCont (a -> b, c -> d, e -> f, g -> h, i -> j, k -> l, m -> n, o -> p) Source # 
Instance details

Defined in Haskus.Utils.Variant.OldFlow

Methods

liftCont :: (a -> b, c -> d, e -> f, g -> h, i -> j, k -> l, m -> n, o -> p) -> LiftContTuple (a -> b, c -> d, e -> f, g -> h, i -> j, k -> l, m -> n, o -> p) Source #

LiftCont (a -> b, c -> d, e -> f, g -> h, i -> j, k -> l, m -> n, o -> p, q -> r) Source # 
Instance details

Defined in Haskus.Utils.Variant.OldFlow

Methods

liftCont :: (a -> b, c -> d, e -> f, g -> h, i -> j, k -> l, m -> n, o -> p, q -> r) -> LiftContTuple (a -> b, c -> d, e -> f, g -> h, i -> j, k -> l, m -> n, o -> p, q -> r) Source #

type family ExtractRHS f where ... Source #

Extract the RHS of every function type in the list

Equations

ExtractRHS '[] = '[] 
ExtractRHS ((_ -> x) ': xs) = x ': ExtractRHS xs 

type family ReplaceRHS f v where ... Source #

Replace the RHS of every function type in the list with v

Equations

ReplaceRHS '[] _ = '[] 
ReplaceRHS ((x -> _) ': xs) v = (x -> v) ': ReplaceRHS xs v 

class ContVariant xs where Source #

Methods

variantToCont :: V xs -> ContFlow xs r Source #

Convert a variant into a multi-continuation

variantToContM :: Monad m => m (V xs) -> ContFlow xs (m r) Source #

Convert a variant into a multi-continuation

contToVariant :: ContFlow xs (V xs) -> V xs Source #

Convert a multi-continuation into a Variant

contToVariantM :: Monad m => ContFlow xs (m (V xs)) -> m (V xs) Source #

Convert a multi-continuation into a Variant

Instances
ContVariant (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': (l ': ([] :: [Type]))))))))))))) Source # 
Instance details

Defined in Haskus.Utils.Variant

Methods

variantToCont :: V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': (l ': [])))))))))))) -> ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': (l ': [])))))))))))) r Source #

variantToContM :: Monad m => m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': (l ': []))))))))))))) -> ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': (l ': [])))))))))))) (m r) Source #

contToVariant :: ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': (l ': [])))))))))))) (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': (l ': []))))))))))))) -> V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': (l ': [])))))))))))) Source #

contToVariantM :: Monad m => ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': (l ': [])))))))))))) (m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': (l ': [])))))))))))))) -> m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': (l ': []))))))))))))) Source #

ContVariant (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': ([] :: [Type])))))))))))) Source # 
Instance details

Defined in Haskus.Utils.Variant

Methods

variantToCont :: V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': []))))))))))) -> ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': []))))))))))) r Source #

variantToContM :: Monad m => m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': [])))))))))))) -> ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': []))))))))))) (m r) Source #

contToVariant :: ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': []))))))))))) (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': [])))))))))))) -> V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': []))))))))))) Source #

contToVariantM :: Monad m => ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': []))))))))))) (m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': []))))))))))))) -> m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': (k ': [])))))))))))) Source #

ContVariant (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': ([] :: [Type]))))))))))) Source # 
Instance details

Defined in Haskus.Utils.Variant

Methods

variantToCont :: V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': [])))))))))) -> ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': [])))))))))) r Source #

variantToContM :: Monad m => m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': []))))))))))) -> ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': [])))))))))) (m r) Source #

contToVariant :: ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': [])))))))))) (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': []))))))))))) -> V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': [])))))))))) Source #

contToVariantM :: Monad m => ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': [])))))))))) (m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': [])))))))))))) -> m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': (j ': []))))))))))) Source #

ContVariant (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': ([] :: [Type])))))))))) Source # 
Instance details

Defined in Haskus.Utils.Variant

Methods

variantToCont :: V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': []))))))))) -> ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': []))))))))) r Source #

variantToContM :: Monad m => m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': [])))))))))) -> ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': []))))))))) (m r) Source #

contToVariant :: ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': []))))))))) (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': [])))))))))) -> V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': []))))))))) Source #

contToVariantM :: Monad m => ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': []))))))))) (m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': []))))))))))) -> m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': (i ': [])))))))))) Source #

ContVariant (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': ([] :: [Type]))))))))) Source # 
Instance details

Defined in Haskus.Utils.Variant

Methods

variantToCont :: V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': [])))))))) -> ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': [])))))))) r Source #

variantToContM :: Monad m => m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': []))))))))) -> ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': [])))))))) (m r) Source #

contToVariant :: ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': [])))))))) (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': []))))))))) -> V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': [])))))))) Source #

contToVariantM :: Monad m => ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': [])))))))) (m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': [])))))))))) -> m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': (h ': []))))))))) Source #

ContVariant (a ': (b ': (c ': (d ': (e ': (f ': (g ': ([] :: [Type])))))))) Source # 
Instance details

Defined in Haskus.Utils.Variant

Methods

variantToCont :: V (a ': (b ': (c ': (d ': (e ': (f ': (g ': []))))))) -> ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': []))))))) r Source #

variantToContM :: Monad m => m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': [])))))))) -> ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': []))))))) (m r) Source #

contToVariant :: ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': []))))))) (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': [])))))))) -> V (a ': (b ': (c ': (d ': (e ': (f ': (g ': []))))))) Source #

contToVariantM :: Monad m => ContFlow (a ': (b ': (c ': (d ': (e ': (f ': (g ': []))))))) (m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': []))))))))) -> m (V (a ': (b ': (c ': (d ': (e ': (f ': (g ': [])))))))) Source #

ContVariant (a ': (b ': (c ': (d ': (e ': (f ': ([] :: [Type]))))))) Source # 
Instance details

Defined in Haskus.Utils.Variant

Methods

variantToCont :: V (a ': (b ': (c ': (d ': (e ': (f ': [])))))) -> ContFlow (a ': (b ': (c ': (d ': (e ': (f ': [])))))) r Source #

variantToContM :: Monad m => m (V (a ': (b ': (c ': (d ': (e ': (f ': []))))))) -> ContFlow (a ': (b ': (c ': (d ': (e ': (f ': [])))))) (m r) Source #

contToVariant :: ContFlow (a ': (b ': (c ': (d ': (e ': (f ': [])))))) (V (a ': (b ': (c ': (d ': (e ': (f ': []))))))) -> V (a ': (b ': (c ': (d ': (e ': (f ': [])))))) Source #

contToVariantM :: Monad m => ContFlow (a ': (b ': (c ': (d ': (e ': (f ': [])))))) (m (V (a ': (b ': (c ': (d ': (e ': (f ': [])))))))) -> m (V (a ': (b ': (c ': (d ': (e ': (f ': []))))))) Source #

ContVariant (a ': (b ': (c ': (d ': (e ': ([] :: [Type])))))) Source # 
Instance details

Defined in Haskus.Utils.Variant

Methods

variantToCont :: V (a ': (b ': (c ': (d ': (e ': []))))) -> ContFlow (a ': (b ': (c ': (d ': (e ': []))))) r Source #

variantToContM :: Monad m => m (V (a ': (b ': (c ': (d ': (e ': [])))))) -> ContFlow (a ': (b ': (c ': (d ': (e ': []))))) (m r) Source #

contToVariant :: ContFlow (a ': (b ': (c ': (d ': (e ': []))))) (V (a ': (b ': (c ': (d ': (e ': [])))))) -> V (a ': (b ': (c ': (d ': (e ': []))))) Source #

contToVariantM :: Monad m => ContFlow (a ': (b ': (c ': (d ': (e ': []))))) (m (V (a ': (b ': (c ': (d ': (e ': []))))))) -> m (V (a ': (b ': (c ': (d ': (e ': [])))))) Source #

ContVariant (a ': (b ': (c ': (d ': ([] :: [Type]))))) Source # 
Instance details

Defined in Haskus.Utils.Variant

Methods

variantToCont :: V (a ': (b ': (c ': (d ': [])))) -> ContFlow (a ': (b ': (c ': (d ': [])))) r Source #

variantToContM :: Monad m => m (V (a ': (b ': (c ': (d ': []))))) -> ContFlow (a ': (b ': (c ': (d ': [])))) (m r) Source #

contToVariant :: ContFlow (a ': (b ': (c ': (d ': [])))) (V (a ': (b ': (c ': (d ': []))))) -> V (a ': (b ': (c ': (d ': [])))) Source #

contToVariantM :: Monad m => ContFlow (a ': (b ': (c ': (d ': [])))) (m (V (a ': (b ': (c ': (d ': [])))))) -> m (V (a ': (b ': (c ': (d ': []))))) Source #

ContVariant (a ': (b ': (c ': ([] :: [Type])))) Source # 
Instance details

Defined in Haskus.Utils.Variant

Methods

variantToCont :: V (a ': (b ': (c ': []))) -> ContFlow (a ': (b ': (c ': []))) r Source #

variantToContM :: Monad m => m (V (a ': (b ': (c ': [])))) -> ContFlow (a ': (b ': (c ': []))) (m r) Source #

contToVariant :: ContFlow (a ': (b ': (c ': []))) (V (a ': (b ': (c ': [])))) -> V (a ': (b ': (c ': []))) Source #

contToVariantM :: Monad m => ContFlow (a ': (b ': (c ': []))) (m (V (a ': (b ': (c ': []))))) -> m (V (a ': (b ': (c ': [])))) Source #

ContVariant (a ': (b ': ([] :: [Type]))) Source # 
Instance details

Defined in Haskus.Utils.Variant

Methods

variantToCont :: V (a ': (b ': [])) -> ContFlow (a ': (b ': [])) r Source #

variantToContM :: Monad m => m (V (a ': (b ': []))) -> ContFlow (a ': (b ': [])) (m r) Source #

contToVariant :: ContFlow (a ': (b ': [])) (V (a ': (b ': []))) -> V (a ': (b ': [])) Source #

contToVariantM :: Monad m => ContFlow (a ': (b ': [])) (m (V (a ': (b ': [])))) -> m (V (a ': (b ': []))) Source #

ContVariant (a ': ([] :: [Type])) Source # 
Instance details

Defined in Haskus.Utils.Variant

Methods

variantToCont :: V (a ': []) -> ContFlow (a ': []) r Source #

variantToContM :: Monad m => m (V (a ': [])) -> ContFlow (a ': []) (m r) Source #

contToVariant :: ContFlow (a ': []) (V (a ': [])) -> V (a ': []) Source #

contToVariantM :: Monad m => ContFlow (a ': []) (m (V (a ': []))) -> m (V (a ': [])) Source #

Helpers

makeFlowOp :: Monad m => (V as -> Either (V bs) (V cs)) -> (V cs -> Flow m ds) -> (Either (V bs) (V ds) -> es) -> V as -> m es Source #

Make a flow operator

makeFlowOpM :: Monad m => (V as -> Either (V bs) (V cs)) -> (V cs -> Flow m ds) -> (Either (V bs) (V ds) -> es) -> Flow m as -> m es Source #

Make a flow operator

selectTail :: V (x ': xs) -> Either (V '[x]) (V xs) Source #

Select the tail

selectFirst :: V (x ': xs) -> Either (V xs) (V '[x]) Source #

Select the first value

selectType :: x :< xs => V xs -> Either (V (Remove x xs)) (V '[x]) Source #

Select by type

applyConst :: Flow m ys -> V xs -> Flow m ys Source #

Const application

applyPure :: Monad m => (V xs -> V ys) -> V xs -> Flow m ys Source #

Pure application

applyM :: Monad m => (a -> m b) -> V '[a] -> Flow m '[b] Source #

Lift a monadic function

applyF :: (a -> Flow m b) -> V '[a] -> Flow m b Source #

Lift a monadic function

combineFirst :: forall x xs. Either (V xs) (V '[x]) -> V (x ': xs) Source #

Set the first value (the "correct" one)

combineSameTail :: forall x xs. Either (V xs) (V (x ': xs)) -> V (x ': xs) Source #

Set the first value, keep the same tail type

combineEither :: Either (V xs) (V xs) -> V xs Source #

Return the valid variant unmodified

combineConcat :: forall xs ys. KnownNat (Length xs) => Either (V ys) (V xs) -> V (Concat xs ys) Source #

Concatenate unselected values

combineUnion :: (LiftVariant xs (Union xs ys), LiftVariant ys (Union xs ys)) => Either (V ys) (V xs) -> V (Union xs ys) Source #

Union

combineLiftUnselected :: LiftVariant ys xs => Either (V ys) (V xs) -> V xs Source #

Lift unselected

combineLiftBoth :: (LiftVariant ys zs, LiftVariant xs zs) => Either (V ys) (V xs) -> V zs Source #

Lift both

combineSingle :: Either (V '[x]) (V '[x]) -> x Source #

Single value

liftV :: (a -> b) -> V '[a] -> V '[b] Source #

Lift a pure function into a Variant to Variant function

liftF :: Monad m => (a -> m b) -> V '[a] -> Flow m '[b] Source #

Lift a function into a Flow