MapWith-0.1.0.0: mapWith: like fmap, but with additional arguments (isFirst, isLast, etc).

Copyright(c) David James 2020
LicenseBSD3
StabilityExperimental
Safe HaskellSafe
LanguageHaskell2010

MapWith

Contents

Description

Provides fmap-like functionality, but can also "inject" additional parameters to the mapping function, such as:

  • whether the first / last item
  • the previous / next item
  • the index from the start / end
Synopsis

Type Names

These names are used for types and variables throughout:

t
the Traversable we're mapping over
a
the value in the input Traversable
b
the result in the output Traversable
i
an output from an Injector, injected into a map function
s
the internal state in an Injector

Pre-Packaged Maps

Some pre-defined maps with commonly used injectors.

withFirstLast :: Traversable t => (a -> Bool -> Bool -> b) -> t a -> t b Source #

Maps over a Traversable, with additional parameters indicating whether an item is the first or last (or both) in the list.

>>> let f x isFirst isLast = star isFirst ++ x ++ star isLast; star b = if b then "*" else "" in withFirstLast f ["foo", "bar", "baz"]
["*foo", "bar", "baz*"]

andFirstLast :: Traversable t => t a -> t (a, Bool, Bool) Source #

andFirstLast = withFirstLast (,,)

withPrevNext :: Traversable t => (a -> Maybe a -> Maybe a -> b) -> t a -> t b Source #

Maps over a Traversable, with additional parameters indicating the previous and next elements.

The second (or third) parameter to the map function is Nothing when called for the first (or last) item, otherwise it's Just the previous (or next) item.

>>> let f x prvMay nxtMay = maybe "*" (cmp x) prvMay ++ x ++ maybe "*" (cmp x) nxtMay; cmp x y = show $ compare x y in withPrevNext f ["foo", "bar", "baz"]
["*fooGT","LTbarLT","GTbaz*"]

andPrevNext :: Traversable t => t a -> t (a, Maybe a, Maybe a) Source #

andPrevNext = withPrevNext (,,)

Custom Maps

In general, a map function will take one parameter from the Traversable, then one each from any number of Injectors. For example:

>>> mapFn w x y z = (w, x, y, z)
>>> injectedFn = mapFn <-^ isLim ^-> eltIx <-^ eltFrom [8,2,7,1]
>>> mapWith injectedFn "abc"
[('a',False,0,7),('b',False,1,2),('c',True,2,8)]

Where:

  • mapFn: a function that maps over a Traversable, but requires additional parameters
  • injectedFn: represents the combination of mapFn with three injectors that provide the required parameters:

    • <-^ isLim: injects True if this is the limit, from the right (i.e. the last item).
    • ^-> eltIx: inject the index, from the left
    • <-^ eltFrom [8,2,7,1]: inject elements from this list, from the right.

mapWith then maps the mapFn over the Traversable, with the following parameters:

Call w x y z
1 'a' False 0 7
2 'b' False 1 2
3 'c' True 2 8

mapWith :: Traversable t => InjectedFn a b -> t a -> t b Source #

maps an InjectedFn over a Traversable type t, turning a t a into a t b and preserving the structure of t.

Parameters (as defined in the InjectedFn) are passed to a map function (embedded in the InjectedFn), in addition to the elements of the Traversable.

mapWithM :: (Traversable t, Monad m) => InjectedFn a (m b) -> t a -> m (t b) Source #

like mapM, but with an InjectedFn.

mapWithM_ :: (Traversable t, Monad m) => InjectedFn a (m b) -> t a -> m () Source #

like mapM_ (which is like mapM but ignores the results), but with an InjectedFn.

foldMapWith :: (Traversable t, Monoid b) => InjectedFn a b -> t a -> b Source #

like foldMap, but with an InjectedFn

data InjectedFn a b Source #

Represents a function from a, plus a number of injected values, to b.

Used by mapWith (& related), which maps over a Traversable, injecting the additional values as it goes.

Constructed by combining a map function with Injectors using the ^-> and <-^ operators.

The sequence:

(a -> i1 -> i2 -> ... -> in -> b) op1 inj1 op2 inj2 ... opn injn

where:

produces an InjectedFn a b, with n injected values.

Instances
Injectable InjectedFn Source # 
Instance details

Defined in MapWith

Methods

(^->) :: InjectedFn a (i -> b) -> Injector a i -> InjectedFn a b Source #

(<-^) :: InjectedFn a (i -> b) -> Injector a i -> InjectedFn a b Source #

class Injectable m where Source #

An Injectable is (recursively) either:

Methods

(^->) :: m a (i -> b) -> Injector a i -> InjectedFn a b infixl 1 Source #

Inject "from the left"

(<-^) :: m a (i -> b) -> Injector a i -> InjectedFn a b infixl 1 Source #

Inject "from the right"

Instances
Injectable InjectedFn Source # 
Instance details

Defined in MapWith

Methods

(^->) :: InjectedFn a (i -> b) -> Injector a i -> InjectedFn a b Source #

(<-^) :: InjectedFn a (i -> b) -> Injector a i -> InjectedFn a b Source #

Injectable ((->) :: Type -> Type -> Type) Source # 
Instance details

Defined in MapWith

Methods

(^->) :: (a -> (i -> b)) -> Injector a i -> InjectedFn a b Source #

(<-^) :: (a -> (i -> b)) -> Injector a i -> InjectedFn a b Source #

Predefined Injectors

Use these (or custom Injectors) to create InjectedFns that can be used with mapWith

isLim :: Injector a Bool Source #

inject True if the item is at the limit:

  • from the left: if it's the first item
  • from the right: if it's the last item

else inject False.

adjElt :: Injector a (Maybe a) Source #

inject Just the adjacent item:

  • from the left: the previous item, except for the first item
  • from the right: the next item, except for the last item. (The "previous from the right" is the "next".)

inject Nothing if there is no adjacent item (i.e. for the first / last).

eltIx :: Integral i => Injector a i Source #

inject the item index:

  • from the left: the first item is 0, the second 1, etc.
  • from the right: the last item is 0, the penultimate 1, etc.

eltFrom Source #

Arguments

:: Foldable f 
=> f i

The elements to inject. There must be enough elements.

-> Injector a i 

Inject each given element in turn:

  • from the left: the first element will be injected for the first item in the Traversable.
  • from the right: the first element will be injected for the last item in the Traversable.

As a result of laziness, it is not always an error if there are not enough elements, for example:

>>> drop 1 $ mapWith ((\_ i -> i) <-^ eltFrom [8,2]) "abc"
[2,8]

eltFromMay :: Foldable f => f i -> Injector a (Maybe i) Source #

a safe version of eltFrom. Injects Just each given element in turn, or Nothing after they've been exhausted.

eltFromDef :: Foldable f => i -> f i -> Injector a i Source #

a safe version of eltFrom. Injects each given element in turn, or the default after they've been exhausted.

Pre-Combined Injectors

These are combinations of ^-> or <-^ with isLim or adjElt.

They work well with the & operator, and can be combined with the ^-> and <-^ operators e.g.:

mapWith (f & isFirst <-^ eltFrom [9,2]) == mapWith (f ^-> isLim <-^ eltFrom [9,2])

You may find them more memorable or easier to type.

isFirst :: Injectable f => f a (Bool -> b) -> InjectedFn a b Source #

isLim, from the left.

isLast :: Injectable f => f a (Bool -> b) -> InjectedFn a b Source #

isLim, from the right.

prevElt :: Injectable f => f a (Maybe a -> b) -> InjectedFn a b Source #

adjElt, from the left.

nextElt :: Injectable f => f a (Maybe a -> b) -> InjectedFn a b Source #

adjElt, from the right.

Custom Injectors

data Injector a i Source #

Injectors have an initial state and a generate function.

For each item in the Traversable, the generate function can use both:

to determine both:

  • the injection value, and
  • the new state.

The first value to inject is determined by a first call to the generate function. The first call to the generate function is with the first (if combined with ^->) or last (if combined with <-^) item from the Traversable and the initial state.

For example:

>>> funnyNext a s = (a + s, a + 1)
>>> funnyInjector = Injector funnyNext 17
>>> mapWith ((\_ i -> i) ^-> funnyInjector) [4,8,3]
[21,13,12]
Call Initial State Item Injection New State
1 17 4 17+4=21 4+1=5
2 5 8 5+8=13 8+1=9
3 9 3 9+3=12 3+1=4 (ignored)
>>> mapWith ((\_ i -> i) <-^ funnyInjector) [4,8,3]
[13,12,20]
Call Initial State Item Injection New State
1 17 3 17+3=20 3+1=4
2 4 8 4+8=12 8+1=9
3 9 4 9+4=13 4+1=5 (ignored)

More usefully, this would allow for e.g. the prior two elements:

prev2Inj = Injector (\x i@(prev1May, prev2May) -> (i, (Just x, prev1May))) (Nothing, Nothing)

or random values, etc.

Constructors

Injector (a -> s -> (i, s)) s

the first argument is a generate function, the second argument is the initial state.