between-0.10.0.0: Function combinator "between" and derived combinators

Copyright(c) 2013-2015 Peter Trsko
LicenseBSD3
Maintainerpeter.trsko@gmail.com
Stabilityexperimental
PortabilityNoImplicitPrelude
Safe HaskellSafe-Inferred
LanguageHaskell98

Data.Function.Between.Strict

Contents

Description

Implementation of strict between combinator and its variations. For introductory documentation see module Data.Function.Between and for lazy versions import Data.Function.Between.Lazy module.

All functions in this module use strict (or should I say stricter?) definition of function composition:

(f . g) x = f $! g $! x

Since version 0.10.0.0.

Synopsis

Between Function Combinator

Captures common pattern of \g -> (f . g . h) where f and h are fixed parameters.

between :: (c -> d) -> (a -> b) -> (b -> c) -> a -> d Source

Core combinator of this module and we build others on top of. It also has an infix form ~@~ and flipped infix form ~@@~.

This function Defined as:

between f g -> (f .) . (. g)

Since version 0.10.0.0.

(~@~) :: (c -> d) -> (a -> b) -> (b -> c) -> a -> d infixl 8 Source

Infix variant of between.

Fixity is left associative and set to value 8, which is one less then fixity of function composition (.).

Since version 0.10.0.0.

(~@@~) :: (a -> b) -> (c -> d) -> (b -> c) -> a -> d infixr 8 Source

Flipped variant of ~@~, i.e. flipped infix variant of between.

Fixity is right associative and set to value 8, which is one less then fixity of function composition (.).

Since version 0.10.0.0.

Derived Combinators

Combinators that either further parametrise f or g in f . g . h, or apply ~@~ more then once.

(^@~) :: (a -> c -> d) -> (a -> b) -> (b -> c) -> a -> d infixl 8 Source

As ~@~, but first function is also parametrised with a, hence the name ^@~. Character ^ indicates which argument is parametrised with additional argument.

This function is defined as:

(f ^@~ g) h a -> ((f $! a) ~@~ g)) h a

Fixity is left associative and set to value 8, which is one less then fixity of function composition (.).

Since version 0.10.0.0.

(~@@^) :: (a -> b) -> (a -> c -> d) -> (b -> c) -> a -> d infixr 8 Source

Flipped variant of ^@~.

Fixity is right associative and set to value 8, which is one less then fixity of function composition (.).

Since version 0.10.0.0.

(^@^) :: (a -> d -> e) -> (a -> b -> c) -> (c -> d) -> a -> b -> e infix 8 Source

Pass additional argument to first two function arguments.

This function is defined as:

(f ^@~ g) h a b -> ((f $! a) ~@~ (g $! a)) h b

See also ^@~ to note the difference, most importantly that ^@~ passes the same argument to all its functional arguments. Since this function uses strict function composition and strict application it is not so simple to define it in terms of other combinators in this package and vice versa. See lazy ^@~ for details.

Fixity is set to value 8, which is one less then of function composition (.).

Since version 0.10.0.0.

(^@@^) :: (a -> b -> c) -> (a -> d -> e) -> (c -> d) -> a -> b -> e infix 8 Source

Flipped variant of ^@^.

Fixity is set to value 8, which is one less then of function composition (.).

Since version 0.10.0.0.

between2l :: (c -> d) -> (a -> b) -> (b -> b -> c) -> a -> a -> d Source

Apply function g to each argument of binary function and f to its result. In suffix "2l" the number is equal to arity of the function it accepts as a third argument and character "l" is for "left associative".

between2l f g = (f ~@~ g) ~@~ g

Interesting observation:

(\f g -> between2l id g f) === on

Since version 0.10.0.0.

between3l :: (c -> d) -> (a -> b) -> (b -> b -> b -> c) -> a -> a -> a -> d Source

Apply function g to each argument of ternary function and f to its result. In suffix "3l" the number is equal to arity of the function it accepts as a third argument and character "l" is for "left associative".

This function is defined as:

between3l f g = ((f ~@~ g) ~@~ g) ~@~ g

Alternatively it can be defined using between2l:

between3l f g = between2l f g ~@~ g

Since version 0.10.0.0.

Lifted Combinators

Combinators based on ~@~, ^@~, ^@^, and their flipped variants, that use fmap to lift one or more of its arguments to operate in Functor context.

(<~@~>) :: (Functor f, Functor g) => (c -> d) -> (a -> b) -> (f b -> g c) -> f a -> g d infix 8 Source

Convenience wrapper for:

\f g -> fmap f ~@~ fmap g

Name of <~@~> simply says that we apply <$> (fmap) to both its arguments and then we apply ~@~.

Fixity is left associative and set to value 8, which is one less then of function composition (.).

Since version 0.10.0.0.

(<~@@~>) :: (Functor f, Functor g) => (a -> b) -> (c -> d) -> (f b -> g c) -> f a -> g d infix 8 Source

Flipped variant of <~@~>.

Name of <~@@~> simply says that we apply <$> (fmap) to both its arguments and then we apply ~@@~.

Fixity is set to value 8, which is one less then of function composition (.).

Since version 0.10.0.0.

(<~@~) :: Functor f => (c -> d) -> (a -> b) -> (b -> f c) -> a -> f d infixl 8 Source

Apply fmap to first argument of ~@~. Dual to ~@~> which applies fmap to second argument.

Defined as:

f <~@~ g = fmap f ~@~ g

This function allows us to define lenses mostly for pair of functions that form an isomorphism. See section Constructing Lenses for details.

Name of <~@~ simply says that we apply <$> (fmap) to first (left) argument and then we apply ~@~.

Fixity is left associative and set to value 8, which is one less then of function composition (.).

Since version 0.10.0.0.

(~@@~>) :: Functor f => (a -> b) -> (c -> d) -> (b -> f c) -> a -> f d infixr 8 Source

Flipped variant of <~@~.

This function allows us to define lenses mostly for pair of functions that form an isomorphism. See section Constructing Lenses for details.

Name of ~@@~> simply says that we apply <$> (fmap) to second (right) argument and then we apply ~@@~.

Fixity is right associative and set to value 8, which is one less then fixity of function composition (.).

Since version 0.10.0.0.

(~@~>) :: Functor f => (c -> d) -> (a -> b) -> (f b -> c) -> f a -> d infixl 8 Source

Apply fmap to second argument of ~@~. Dual to <~@~ which applies fmap to first argument.

Defined as:

f ~@~> g -> f ~@~ fmap g

Name of ~@~> simply says that we apply <$> (fmap) to second (right) argument and then we apply ~@~.

Fixity is right associative and set to value 8, which is one less then of function composition (.).

Since version 0.10.0.0.

(<~@@~) :: Functor f => (a -> b) -> (c -> d) -> (f b -> c) -> f a -> d infixr 8 Source

Flipped variant of ~@~>.

Name of <~@@~ simply says that we apply <$> (fmap) to first (left) argument and then we apply ~@@~.

Fixity is left associative and set to value 8, which is one less then fixity of function composition (.).

Since version 0.10.0.0.

(<^@~) :: Functor f => (a -> c -> d) -> (a -> b) -> (b -> f c) -> a -> f d infixl 8 Source

Convenience wrapper for: \f g -> fmap . f '^~' g@.

This function has the same functionality as function

lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b

Which is defined in lens package. Only difference is that arguments of <^@~ are flipped. See also section Constructing Lenses.

Name of <^@~ simply says that we apply <$> (fmap) to first (left) arguments and then we apply ^@~.

Fixity is left associative and set to value 8, which is one less then of function composition (.).

Since version 0.10.0.0.

(~@@^>) :: Functor f => (a -> b) -> (a -> c -> d) -> (b -> f c) -> a -> f d infixl 8 Source

Flipped variant of ~@^>.

This function has the same functionality as function

lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b

Which is defined in lens package. See also section Constructing Lenses.

Name of ~@^> simply says that we apply <$> (fmap) to second (right) arguments and then we apply ~@^>.

Fixity is left associative and set to value 8, which is one less then of function composition (.).

Since version 0.10.0.0.

(<^@^>) :: (Functor f, Functor g) => (a -> d -> e) -> (a -> b -> c) -> (f c -> g d) -> a -> f b -> g e infix 8 Source

Convenience wrapper for: \f g -> fmap . f '^^' fmap . g@.

Name of <^@^> simply says that we apply <$> (fmap) to both its arguments and then we apply ^@^.

Fixity is left associative and set to value 8, which is one less then of function composition (.).

Since version 0.10.0.0.

(<^@@^>) :: (Functor f, Functor g) => (a -> b -> c) -> (a -> d -> e) -> (f c -> g d) -> a -> f b -> g e infix 8 Source

Flipped variant of <^@^>.

Name of <^@@^> simply says that we apply <$> (fmap) to both its arguments and then we apply ^@@^.

Fixity is set to value 8, which is one less then of function composition (.).

Since version 0.10.0.0.

(<^@^) :: Functor f => (a -> d -> e) -> (a -> b -> c) -> (c -> f d) -> a -> b -> f e infix 8 Source

Convenience wrapper for: \f g -> fmap . f '^^' g@.

This function allows us to define generic lenses from gettern and setter. See section Constructing Lenses for details.

Name of <^@^ simply says that we apply <$> (fmap) to first (left) arguments and then we apply ^@^.

Fixity is left associative and set to value 8, which is one less then of function composition (.).

Since version 0.10.0.0.

(^@@^>) :: Functor f => (a -> b -> c) -> (a -> d -> e) -> (c -> f d) -> a -> b -> f e infix 8 Source

Flipped variant of <^@^.

This function allows us to define generic lenses from gettern and setter. See section Constructing Lenses for details.

Name of ^@@^> simply says that we apply <$> (fmap) to second (right) arguments and then we apply ^@@^.

Fixity is set to value 8, which is one less then of function composition (.).

Since version 0.10.0.0.

(^@^>) :: Functor f => (a -> d -> e) -> (a -> b -> c) -> (f c -> d) -> a -> f b -> e infix 8 Source

Convenience wrapper for: \f g -> f '^^' fmap . g@.

Name of ^@^> simply says that we apply <$> (fmap) to second (right) arguments and then we apply ^@^.

Fixity is left associative and set to value 8, which is one less then of function composition (.).

Since version 0.10.0.0.

(<^@@^) :: Functor f => (a -> b -> c) -> (a -> d -> e) -> (f c -> d) -> a -> f b -> e infix 8 Source

Flipped variant of ^@^>.

Name of <^@@^ simply says that we apply <$> (fmap) to first (left) arguments and then we apply ^@@^.

Fixity is set to value 8, which is one less then of function composition (.).

Since version 0.10.0.0.