Karya, built on 2023-08-29T07:47:28 (patch 7a412d5d6ba4968ca4155ef276a062ccdeb9109a)
Safe HaskellSafe-Inferred

Util.Control

Description

Control flow and monadic utilities.

Synopsis

Documentation

whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m () Source #

whenJustM :: Monad.Monad m => m (Maybe a) -> (a -> m ()) -> m () Source #

whenM :: Monad.Monad m => m Bool -> m () -> m () Source #

unlessM :: Monad.Monad m => m Bool -> m () -> m () Source #

ifM :: Monad.Monad m => m Bool -> m a -> m a -> m a Source #

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

uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e Source #

while :: Monad.Monad m => m Bool -> m a -> m [a] Source #

while_ :: Monad.Monad m => m Bool -> m a -> m () Source #

loop0 :: (a -> a) -> a Source #

Loop with no arguments. This is the same as Fix.fix but the name is clearer.

loop1 :: forall state a. state -> ((state -> a) -> state -> a) -> a Source #

Loop with a single state argument.

loop2 :: forall s1 s2 a. s1 -> s2 -> ((s1 -> s2 -> a) -> s1 -> s2 -> a) -> a Source #

Loop with two state arguments. You could use loop1 with a pair, but sometimes the currying is convenient.

mconcatMap :: Monoid b => (a -> b) -> [a] -> b Source #

This is foldMap specialized to lists.

concatMapM :: (Monad.Monad m, Monoid b) => (a -> m b) -> [a] -> m b Source #

This is actually a mconcatMapM.

A further generalized version would be:

foldMapA :: (Applicative f, Traversable t, Monoid m) =>
   (a -> f m) -> t a -> f m
foldMapA f = fmap Foldable.fold . traverse f

justm :: Monad.Monad m => m (Maybe a) -> (a -> m (Maybe b)) -> m (Maybe b) Source #

Run the second action only if the first action returns Just.

This is like MaybeT, but using MaybeT itself required lots of annoying explicit lifting.

rightm :: Monad.Monad m => m (Either err a) -> (a -> m (Either err b)) -> m (Either err b) Source #

The Either equivalent of justm. EitherT solves the same problem, but requires a runEitherT and lots of hoistEithers.

firstJust :: Monad.Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) Source #

Return the first action to return Just.

firstJusts :: Monad.Monad m => [m (Maybe a)] -> m (Maybe a) Source #

firstJust applied to a list.

justErr :: err -> Maybe a -> Either err a Source #

Throw on Nothing.

tryJust :: MonadError e m => e -> Maybe a -> m a Source #

I usually call this require.

tryRight :: MonadError e m => Either e a -> m a Source #

I usually call this require_right.

rethrow :: MonadError e m => (e -> e) -> m a -> m a Source #

class Bifunctor (p :: Type -> Type -> Type) where #

A bifunctor is a type constructor that takes two type arguments and is a functor in both arguments. That is, unlike with Functor, a type constructor such as Either does not need to be partially applied for a Bifunctor instance, and the methods in this class permit mapping functions over the Left value or the Right value, or both at the same time.

Formally, the class Bifunctor represents a bifunctor from Hask -> Hask.

Intuitively it is a bifunctor where both the first and second arguments are covariant.

You can define a Bifunctor by either defining bimap or by defining both first and second.

If you supply bimap, you should ensure that:

bimap id idid

If you supply first and second, ensure:

first idid
second idid

If you supply both, you should also ensure:

bimap f g ≡ first f . second g

These ensure by parametricity:

bimap  (f . g) (h . i) ≡ bimap f h . bimap g i
first  (f . g) ≡ first  f . first  g
second (f . g) ≡ second f . second g

Since: base-4.8.0.0

Minimal complete definition

bimap | first, second

Methods

bimap :: (a -> b) -> (c -> d) -> p a c -> p b d #

Map over both arguments at the same time.

bimap f g ≡ first f . second g

Examples

Expand
>>> bimap toUpper (+1) ('j', 3)
('J',4)
>>> bimap toUpper (+1) (Left 'j')
Left 'J'
>>> bimap toUpper (+1) (Right 3)
Right 4

first :: (a -> b) -> p a c -> p b c #

Map covariantly over the first argument.

first f ≡ bimap f id

Examples

Expand
>>> first toUpper ('j', 3)
('J',3)
>>> first toUpper (Left 'j')
Left 'J'

second :: (b -> c) -> p a b -> p a c #

Map covariantly over the second argument.

secondbimap id

Examples

Expand
>>> second (+1) ('j', 3)
('j',4)
>>> second (+1) (Right 3)
Right 4

Instances

Instances details
Bifunctor Either

Since: base-4.8.0.0

Instance details

Defined in Data.Bifunctor

Methods

bimap :: (a -> b) -> (c -> d) -> Either a c -> Either b d #

first :: (a -> b) -> Either a c -> Either b c #

second :: (b -> c) -> Either a b -> Either a c #

Bifunctor Arg

Since: base-4.9.0.0

Instance details

Defined in Data.Semigroup

Methods

bimap :: (a -> b) -> (c -> d) -> Arg a c -> Arg b d #

first :: (a -> b) -> Arg a c -> Arg b c #

second :: (b -> c) -> Arg a b -> Arg a c #

Bifunctor Elt Source # 
Instance details

Defined in Util.EList

Methods

bimap :: (a -> b) -> (c -> d) -> Elt a c -> Elt b d #

first :: (a -> b) -> Elt a c -> Elt b c #

second :: (b -> c) -> Elt a b -> Elt a c #

Bifunctor Paired Source # 
Instance details

Defined in Util.Lists

Methods

bimap :: (a -> b) -> (c -> d) -> Paired a c -> Paired b d #

first :: (a -> b) -> Paired a c -> Paired b c #

second :: (b -> c) -> Paired a b -> Paired a c #

Bifunctor Either 
Instance details

Defined in Data.Strict.Either

Methods

bimap :: (a -> b) -> (c -> d) -> Either a c -> Either b d #

first :: (a -> b) -> Either a c -> Either b c #

second :: (b -> c) -> Either a b -> Either a c #

Bifunctor These 
Instance details

Defined in Data.Strict.These

Methods

bimap :: (a -> b) -> (c -> d) -> These a c -> These b d #

first :: (a -> b) -> These a c -> These b c #

second :: (b -> c) -> These a b -> These a c #

Bifunctor Pair 
Instance details

Defined in Data.Strict.Tuple

Methods

bimap :: (a -> b) -> (c -> d) -> Pair a c -> Pair b d #

first :: (a -> b) -> Pair a c -> Pair b c #

second :: (b -> c) -> Pair a b -> Pair a c #

Bifunctor Of 
Instance details

Defined in Data.Functor.Of

Methods

bimap :: (a -> b) -> (c -> d) -> Of a c -> Of b d #

first :: (a -> b) -> Of a c -> Of b c #

second :: (b -> c) -> Of a b -> Of a c #

Bifunctor These 
Instance details

Defined in Data.These

Methods

bimap :: (a -> b) -> (c -> d) -> These a c -> These b d #

first :: (a -> b) -> These a c -> These b c #

second :: (b -> c) -> These a b -> These a c #

Bifunctor (,)

Since: base-4.8.0.0

Instance details

Defined in Data.Bifunctor

Methods

bimap :: (a -> b) -> (c -> d) -> (a, c) -> (b, d) #

first :: (a -> b) -> (a, c) -> (b, c) #

second :: (b -> c) -> (a, b) -> (a, c) #

Bifunctor (Const :: Type -> Type -> Type)

Since: base-4.8.0.0

Instance details

Defined in Data.Bifunctor

Methods

bimap :: (a -> b) -> (c -> d) -> Const a c -> Const b d #

first :: (a -> b) -> Const a c -> Const b c #

second :: (b -> c) -> Const a b -> Const a c #

Bifunctor (Tagged :: Type -> Type -> Type) 
Instance details

Defined in Data.Tagged

Methods

bimap :: (a -> b) -> (c -> d) -> Tagged a c -> Tagged b d #

first :: (a -> b) -> Tagged a c -> Tagged b c #

second :: (b -> c) -> Tagged a b -> Tagged a c #

Bifunctor ((,,) x1)

Since: base-4.8.0.0

Instance details

Defined in Data.Bifunctor

Methods

bimap :: (a -> b) -> (c -> d) -> (x1, a, c) -> (x1, b, d) #

first :: (a -> b) -> (x1, a, c) -> (x1, b, c) #

second :: (b -> c) -> (x1, a, b) -> (x1, a, c) #

Bifunctor (K1 i :: Type -> Type -> Type)

Since: base-4.9.0.0

Instance details

Defined in Data.Bifunctor

Methods

bimap :: (a -> b) -> (c -> d) -> K1 i a c -> K1 i b d #

first :: (a -> b) -> K1 i a c -> K1 i b c #

second :: (b -> c) -> K1 i a b -> K1 i a c #

Bifunctor ((,,,) x1 x2)

Since: base-4.8.0.0

Instance details

Defined in Data.Bifunctor

Methods

bimap :: (a -> b) -> (c -> d) -> (x1, x2, a, c) -> (x1, x2, b, d) #

first :: (a -> b) -> (x1, x2, a, c) -> (x1, x2, b, c) #

second :: (b -> c) -> (x1, x2, a, b) -> (x1, x2, a, c) #

Bifunctor p => Bifunctor (Flip p) 
Instance details

Defined in Data.Bifunctor.Flip

Methods

bimap :: (a -> b) -> (c -> d) -> Flip p a c -> Flip p b d #

first :: (a -> b) -> Flip p a c -> Flip p b c #

second :: (b -> c) -> Flip p a b -> Flip p a c #

Bifunctor ((,,,,) x1 x2 x3)

Since: base-4.8.0.0

Instance details

Defined in Data.Bifunctor

Methods

bimap :: (a -> b) -> (c -> d) -> (x1, x2, x3, a, c) -> (x1, x2, x3, b, d) #

first :: (a -> b) -> (x1, x2, x3, a, c) -> (x1, x2, x3, b, c) #

second :: (b -> c) -> (x1, x2, x3, a, b) -> (x1, x2, x3, a, c) #

(Bifunctor f, Bifunctor g) => Bifunctor (Product f g) 
Instance details

Defined in Data.Bifunctor.Product

Methods

bimap :: (a -> b) -> (c -> d) -> Product f g a c -> Product f g b d #

first :: (a -> b) -> Product f g a c -> Product f g b c #

second :: (b -> c) -> Product f g a b -> Product f g a c #

(Bifunctor p, Bifunctor q) => Bifunctor (Sum p q) 
Instance details

Defined in Data.Bifunctor.Sum

Methods

bimap :: (a -> b) -> (c -> d) -> Sum p q a c -> Sum p q b d #

first :: (a -> b) -> Sum p q a c -> Sum p q b c #

second :: (b -> c) -> Sum p q a b -> Sum p q a c #

Bifunctor ((,,,,,) x1 x2 x3 x4)

Since: base-4.8.0.0

Instance details

Defined in Data.Bifunctor

Methods

bimap :: (a -> b) -> (c -> d) -> (x1, x2, x3, x4, a, c) -> (x1, x2, x3, x4, b, d) #

first :: (a -> b) -> (x1, x2, x3, x4, a, c) -> (x1, x2, x3, x4, b, c) #

second :: (b -> c) -> (x1, x2, x3, x4, a, b) -> (x1, x2, x3, x4, a, c) #

(Functor f, Bifunctor p) => Bifunctor (Tannen f p) 
Instance details

Defined in Data.Bifunctor.Tannen

Methods

bimap :: (a -> b) -> (c -> d) -> Tannen f p a c -> Tannen f p b d #

first :: (a -> b) -> Tannen f p a c -> Tannen f p b c #

second :: (b -> c) -> Tannen f p a b -> Tannen f p a c #

Bifunctor ((,,,,,,) x1 x2 x3 x4 x5)

Since: base-4.8.0.0

Instance details

Defined in Data.Bifunctor

Methods

bimap :: (a -> b) -> (c -> d) -> (x1, x2, x3, x4, x5, a, c) -> (x1, x2, x3, x4, x5, b, d) #

first :: (a -> b) -> (x1, x2, x3, x4, x5, a, c) -> (x1, x2, x3, x4, x5, b, c) #

second :: (b -> c) -> (x1, x2, x3, x4, x5, a, b) -> (x1, x2, x3, x4, x5, a, c) #

(Bifunctor p, Functor f, Functor g) => Bifunctor (Biff p f g) 
Instance details

Defined in Data.Bifunctor.Biff

Methods

bimap :: (a -> b) -> (c -> d) -> Biff p f g a c -> Biff p f g b d #

first :: (a -> b) -> Biff p f g a c -> Biff p f g b c #

second :: (b -> c) -> Biff p f g a b -> Biff p f g a c #

findM :: Monad.Monad m => (a -> m Bool) -> [a] -> m (Maybe a) #

Like find, but where the test can be monadic.

findM (Just . isUpper) "teST"             == Just (Just 'S')
findM (Just . isUpper) "test"             == Just Nothing
findM (Just . const True) ["x",undefined] == Just (Just "x")

andM :: Monad.Monad m => [m Bool] -> m Bool #

A version of and lifted to a monad. Retains the short-circuiting behaviour.

andM [Just True,Just False,undefined] == Just False
andM [Just True,Just True ,undefined] == undefined
\xs -> Just (and xs) == andM (map Just xs)

orM :: Monad.Monad m => [m Bool] -> m Bool #

A version of or lifted to a monad. Retains the short-circuiting behaviour.

orM [Just False,Just True ,undefined] == Just True
orM [Just False,Just False,undefined] == undefined
\xs -> Just (or xs) == orM (map Just xs)

allM :: Monad.Monad m => (a -> m Bool) -> [a] -> m Bool #

A version of all lifted to a monad. Retains the short-circuiting behaviour.

allM Just [True,False,undefined] == Just False
allM Just [True,True ,undefined] == undefined
\(f :: Int -> Maybe Bool) xs -> anyM f xs == orM (map f xs)

anyM :: Monad.Monad m => (a -> m Bool) -> [a] -> m Bool #

A version of any lifted to a monad. Retains the short-circuiting behaviour.

anyM Just [False,True ,undefined] == Just True
anyM Just [False,False,undefined] == undefined
\(f :: Int -> Maybe Bool) xs -> anyM f xs == orM (map f xs)

notM :: Functor m => m Bool -> m Bool #

Like not, but where the test can be monadic.

mapMaybeM :: Monad.Monad m => (a -> m (Maybe b)) -> [a] -> m [b] #

A version of mapMaybe that works with a monadic predicate.

partitionM :: Monad.Monad m => (a -> m Bool) -> [a] -> m ([a], [a]) #

A version of partition that works with a monadic predicate.

partitionM (Just . even) [1,2,3] == Just ([2], [1,3])
partitionM (const Nothing) [1,2,3] == Nothing

errorStack :: Stack => Text -> a Source #

Like error, use when forced.

errorIO :: Stack => MonadIO m => Text -> m a Source #

Throw an error in IO, with a stack.