control-block-0.0.1: Higher-order functions with their function arguments at the end, for channeling the full power of BlockArguments and LambdaCase .
Safe HaskellSafe-Inferred
LanguageGHC2021

Control.Block

Description

Higher-order functions with their function arguments at the end, for channeling the full power of BlockArguments and LambdaCase .

Synopsis

Functor

(<$>) :: Functor f => (a -> b) -> f a -> f b infixl 4 #

An infix synonym for fmap.

The name of this operator is an allusion to $. Note the similarities between their types:

 ($)  ::              (a -> b) ->   a ->   b
(<$>) :: Functor f => (a -> b) -> f a -> f b

Whereas $ is function application, <$> is function application lifted over a Functor.

Examples

Expand

Convert from a Maybe Int to a Maybe String using show:

>>> show <$> Nothing
Nothing
>>> show <$> Just 3
Just "3"

Convert from an Either Int Int to an Either Int String using show:

>>> show <$> Left 17
Left 17
>>> show <$> Right 17
Right "17"

Double each element of a list:

>>> (*2) <$> [1,2,3]
[2,4,6]

Apply even to the second element of a pair:

>>> even <$> (2,2)
(2,True)

(<&>) :: Functor f => f a -> (a -> b) -> f b infixl 1 #

Flipped version of <$>.

(<&>) = flip fmap

Examples

Expand

Apply (+1) to a list, a Just and a Right:

>>> Just 2 <&> (+1)
Just 3
>>> [1,2,3] <&> (+1)
[2,3,4]
>>> Right 3 <&> (+1)
Right 4

Since: base-4.11.0.0

fmap :: Functor f => (a -> b) -> f a -> f b #

fmap is used to apply a function of type (a -> b) to a value of type f a, where f is a functor, to produce a value of type f b. Note that for any type constructor with more than one parameter (e.g., Either), only the last type parameter can be modified with fmap (e.g., b in `Either a b`).

Some type constructors with two parameters or more have a Bifunctor instance that allows both the last and the penultimate parameters to be mapped over.

Examples

Expand

Convert from a Maybe Int to a Maybe String using show:

>>> fmap show Nothing
Nothing
>>> fmap show (Just 3)
Just "3"

Convert from an Either Int Int to an Either Int String using show:

>>> fmap show (Left 17)
Left 17
>>> fmap show (Right 17)
Right "17"

Double each element of a list:

>>> fmap (*2) [1,2,3]
[2,4,6]

Apply even to the second element of a pair:

>>> fmap even (2,2)
(2,True)

It may seem surprising that the function is only applied to the last element of the tuple compared to the list example above which applies it to every element in the list. To understand, remember that tuples are type constructors with multiple type parameters: a tuple of 3 elements (a,b,c) can also be written (,,) a b c and its Functor instance is defined for Functor ((,,) a b) (i.e., only the third parameter is free to be mapped over with fmap).

It explains why fmap can be used with tuples containing values of different types as in the following example:

>>> fmap even ("hello", 1.0, 4)
("hello",1.0,True)

imap :: FunctorWithIndex i f => (i -> a -> b) -> f a -> f b #

Map with access to the index.

change :: Functor f => f x -> (x -> y) -> f y Source #

Non-infix version of (<&>).

ichange :: FunctorWithIndex i f => f x -> (i -> x -> y) -> f y Source #

Flipped version of imap.

Applicative

(<**>) :: Applicative f => f a -> f (a -> b) -> f b infixl 4 #

A variant of <*> with the arguments reversed.

apply :: Applicative f => f (x -> y) -> f x -> f y Source #

Non-infix version of (<*>).

through :: Applicative f => f x -> f (x -> y) -> f y Source #

Flipped version of apply. Non-infix version of (<**>).

Monad

bind :: Monad f => f x -> (x -> f y) -> f y Source #

Non-infix version of (>>=).

ibind :: (FunctorWithIndex i f, Monad f) => f x -> (i -> x -> f y) -> f y Source #

Indexed version of bind.

Foldable

With monoids

foldMap :: (Foldable t, Monoid m) => (a -> m) -> t a -> m #

Map each element of the structure into a monoid, and combine the results with (<>). This fold is right-associative and lazy in the accumulator. For strict left-associative folds consider foldMap' instead.

Examples

Expand

Basic usage:

>>> foldMap Sum [1, 3, 5]
Sum {getSum = 9}
>>> foldMap Product [1, 3, 5]
Product {getProduct = 15}
>>> foldMap (replicate 3) [1, 2, 3]
[1,1,1,2,2,2,3,3,3]

When a Monoid's (<>) is lazy in its second argument, foldMap can return a result even from an unbounded structure. For example, lazy accumulation enables Data.ByteString.Builder to efficiently serialise large data structures and produce the output incrementally:

>>> import qualified Data.ByteString.Lazy as L
>>> import qualified Data.ByteString.Builder as B
>>> let bld :: Int -> B.Builder; bld i = B.intDec i <> B.word8 0x20
>>> let lbs = B.toLazyByteString $ foldMap bld [0..]
>>> L.take 64 lbs
"0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24"

foldMap1 :: (Foldable1 t, Semigroup m) => (a -> m) -> t a -> m #

Map each element of the structure to a semigroup, and combine the results.

>>> foldMap1 Sum (1 :| [2, 3, 4])
Sum {getSum = 10}

Since: base-4.18.0.0

foldMapA :: (Foldable t, Applicative f, Monoid m) => (x -> f m) -> t x -> f m Source #

foldMap through an Applicative functor.

foldMapA1 :: (Foldable1 t, Applicative f, Semigroup s) => (x -> f s) -> t x -> f s Source #

foldMap1 through an Applicative functor.

ifoldMap :: (FoldableWithIndex i f, Monoid m) => (i -> a -> m) -> f a -> m #

Fold a container by mapping value to an arbitrary Monoid with access to the index i.

When you don't need access to the index then foldMap is more flexible in what it accepts.

foldMapifoldMap . const

ifoldMapA :: (FoldableWithIndex i t, Applicative f, Monoid m) => (i -> x -> f m) -> t x -> f m Source #

ifoldMap through an Applicative functor.

reduce :: (Foldable t, Monoid m) => t x -> (x -> m) -> m Source #

Flipped version of foldMap.

reduce1 :: (Foldable1 t, Semigroup s) => t x -> (x -> s) -> s Source #

Flipped version of foldMap1.

reduceA :: (Foldable t, Applicative f, Monoid m) => t x -> (x -> f m) -> f m Source #

Flipped version of foldMapA.

reduceA1 :: (Foldable1 t, Applicative f, Semigroup s) => t x -> (x -> f s) -> f s Source #

Flipped version of foldMapA1.

ireduce :: (FoldableWithIndex i t, Monoid m) => t x -> (i -> x -> m) -> m Source #

Flipped version of ifoldMap.

ireduceA :: (FoldableWithIndex i t, Applicative f, Monoid m) => t x -> (i -> x -> f m) -> f m Source #

Flipped version of foldMapA.

Without monoids

reduceL :: Foldable t => y -> t x -> (y -> x -> y) -> y Source #

A version of foldl' taking the accumulator first, then the Foldable.

reduceL1 :: Foldable1 t => t x -> (x -> x -> x) -> x Source #

A version of foldl1' taking the accumulator first, then the Foldable1.

reduceR :: Foldable t => y -> t x -> (x -> y -> y) -> y Source #

A version of foldr taking the accumulator first, then the Foldable.

reduceR1 :: Foldable1 t => t x -> (x -> x -> x) -> x Source #

A version of foldr1 taking the accumulator first, then the Foldable.

Traversable

traverse :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) #

Map each element of a structure to an action, evaluate these actions from left to right, and collect the results. For a version that ignores the results see traverse_.

Examples

Expand

Basic usage:

In the first two examples we show each evaluated action mapping to the output structure.

>>> traverse Just [1,2,3,4]
Just [1,2,3,4]
>>> traverse id [Right 1, Right 2, Right 3, Right 4]
Right [1,2,3,4]

In the next examples, we show that Nothing and Left values short circuit the created structure.

>>> traverse (const Nothing) [1,2,3,4]
Nothing
>>> traverse (\x -> if odd x then Just x else Nothing)  [1,2,3,4]
Nothing
>>> traverse id [Right 1, Right 2, Right 3, Right 4, Left 0]
Left 0

itraverse :: (TraversableWithIndex i t, Applicative f) => (i -> a -> f b) -> t a -> f (t b) #

Traverse an indexed container.

itraverseitraverseOf itraversed

itraverse_ :: (FoldableWithIndex i t, Applicative f) => (i -> a -> f b) -> t a -> f () #

Traverse elements with access to the index i, discarding the results.

When you don't need access to the index then traverse_ is more flexible in what it accepts.

traverse_ l = itraverse . const

for :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b) #

for is traverse with its arguments flipped. For a version that ignores the results see for_.

ifor :: (TraversableWithIndex i t, Applicative f) => t a -> (i -> a -> f b) -> f (t b) #

Traverse with an index (and the arguments flipped).

for a ≡ ifor a . const
iforflip itraverse

ifor_ :: (FoldableWithIndex i t, Applicative f) => t a -> (i -> a -> f b) -> f () #

Traverse elements with access to the index i, discarding the results (with the arguments flipped).

ifor_flip itraverse_

When you don't need access to the index then for_ is more flexible in what it accepts.

for_ a ≡ ifor_ a . const

Maybe and List

mabye :: Maybe x -> y -> (x -> y) -> y Source #

A version of maybe with the Maybe argument first.

emptn :: [x] -> y -> (NonEmpty x -> y) -> y Source #

Act on the empty or NonEmpty cases of a regular list.

Filterable

(<$?>) :: Filterable f => (a -> Maybe b) -> f a -> f b infixl 4 #

An infix alias for mapMaybe. The name of the operator alludes to <$>, and has the same fixity.

Since: witherable-0.3.1

(<&?>) :: Filterable f => f a -> (a -> Maybe b) -> f b infixl 1 #

Flipped version of <$?>, the Filterable version of <&>. It has the same fixity as <&>.

(<&?>) = flip mapMaybe

Since: witherable-0.3.1

filter :: Filterable f => (a -> Bool) -> f a -> f a #

filter f . filter g ≡ filter (liftA2 (&&) g f)

ifilter :: FilterableWithIndex i t => (i -> a -> Bool) -> t a -> t a #

ifilter f . ifilter g ≡ ifilter (i -> liftA2 (&&) (f i) (g i))

sift :: Filterable t => t x -> (x -> Bool) -> t x Source #

Flipped version of filter.

isift :: FilterableWithIndex i t => t x -> (i -> x -> Bool) -> t x Source #

Flipped version of ifilter.

mapMaybe :: Filterable f => (a -> Maybe b) -> f a -> f b #

Like mapMaybe.

imapMaybe :: FilterableWithIndex i t => (i -> a -> Maybe b) -> t a -> t b #

changeMaybe :: Filterable t => t x -> (x -> Maybe y) -> t y Source #

Flipped version of Filterable.

ichangeMaybe :: FilterableWithIndex i t => t x -> (i -> x -> Maybe y) -> t y Source #

Flipped version of imapMaybe.

Witherable

filterA :: (Witherable t, Applicative f) => (a -> f Bool) -> t a -> f (t a) #

ifilterA :: (WitherableWithIndex i t, Applicative f) => (i -> a -> f Bool) -> t a -> f (t a) #

siftA :: (Applicative f, Witherable t) => t x -> (x -> f Bool) -> f (t x) Source #

Flipped version of filterA.

isiftA :: (Applicative f, WitherableWithIndex i t) => t x -> (i -> x -> f Bool) -> f (t x) Source #

Flipped version of ifilterA.

wither :: (Witherable t, Applicative f) => (a -> f (Maybe b)) -> t a -> f (t b) #

Effectful mapMaybe.

wither (pure . f) ≡ pure . mapMaybe f

iwither :: (WitherableWithIndex i t, Applicative f) => (i -> a -> f (Maybe b)) -> t a -> f (t b) #

Effectful imapMaybe.

iwither ( i -> pure . f i) ≡ pure . imapMaybe f

forMaybe :: (Witherable t, Applicative f) => t a -> (a -> f (Maybe b)) -> f (t b) #

iforMaybe :: (Applicative f, WitherableWithIndex i t) => t x -> (i -> x -> f (Maybe y)) -> f (t y) Source #

Flipped version of iwither.