function-builder-0.1.0.1: Create poly variadic functions for monoidal results

Safe HaskellNone
LanguageHaskell2010

Data.FunctionBuilder

Contents

Description

This library allows you to build function builder libraries.

Several FunctionBuilder values sharing a common monoidal output type can be composed to a big FunctionBuilder value, in order to build an output function that has a flexible number and types of parameters depending, on the individual FunctionBuilders used. This output function can be obtained by toFunction.

FunctionBuilders can also be composed via standard type classes.

This module provides Functor, Applicative, Monad, Semigroup, Monoid and Category instances;

The basic building blocks when generating a poly variadic function are immediate and addParameter.

The output function is obtained from a FunctionBuilder by toFunction.

Synopsis

Documentation

newtype FunctionBuilder acc next f_make_next Source #

A function, that takes an accumulation function as paramater, and returns a function that will have zero or more parameters and returns an accumulated result: @(acc -> next)

A FunctionBuilder acc next f is a function (acc -> next) -> f.

Type parameter:

acc
The final output value that gets build up by the applying the resulting function build by the composed FunctionBuilders. If you were building a printf style library, then acc would probably be String.
next
The next parameter allows composing FunctionBuilders, and the final output will be a function f with zero or more parameters of different type resulting in an acc value. Most FunctionBuilders are parameteric in next and also have next in a in f_make_next. Also note that in (acc -> next) -> f_make_next the next is the output of the continuation acc -> next passed to the FunctionBuilder function, hence this output is actually in input from the perspective of the FunctionBuilder, which makes a FunctionBuilder Contravariant in next.
f_make_next
This is usually a function that returns next or is directly next, this is the resulting - seemingly poly variadic - outout function composed through the composition of FunctionBuilders, and obtained by toFunction.

It is required for the type-class instances allowing the composition as Semigroups or Monoids or even Category.

It is totaly valid to apply it to id, to get f, and behind f typically lies a function of some parameters to next.

At the end of the chain next will be acc and before that the function that takes the next parameters and then returns out.

See toFunction.

Composition comes in two flavours:

  1. By using `(.)` to add to the accumulator a value passed to an additional argument of the resulting output function.
  2. By using `(<>)` to append a fixed value to the accumulator directly.

For example:

import Data.Monoid (Sum(..))

add :: FunctionBuilder (Sum Int) next (Int -> next)
add = FB $ \k -> \x -> k (Sum x)

Here the next parameter in add is just passed through and is the key to be able to compose FunctionBuilders. add is parametric in next. . And when we are done composing, we pass id to the FunctionBuilder, which forces the the next parameter to match the acc type, and which would the make add function look like this:

addToZero :: FunctionBuilder (Sum Int) (Sum Int) (Int -> Sum Int)
addToZero = add

Constructors

FB 

Fields

Instances
Monoid m => Category (FunctionBuilder m :: Type -> Type -> Type) Source #

Compose FunctionBuilders such that the output function first takes all parameters from the first FunctionBuilder and then all parameters from the second FunctionBuilder and then appends the results of both functions, which is why we need the Monoid constraint.

Instance details

Defined in Data.FunctionBuilder

Methods

id :: FunctionBuilder m a a #

(.) :: FunctionBuilder m b c -> FunctionBuilder m a b -> FunctionBuilder m a c #

Monad (FunctionBuilder m r) Source # 
Instance details

Defined in Data.FunctionBuilder

Methods

(>>=) :: FunctionBuilder m r a -> (a -> FunctionBuilder m r b) -> FunctionBuilder m r b #

(>>) :: FunctionBuilder m r a -> FunctionBuilder m r b -> FunctionBuilder m r b #

return :: a -> FunctionBuilder m r a #

fail :: String -> FunctionBuilder m r a #

Functor (FunctionBuilder m r) Source # 
Instance details

Defined in Data.FunctionBuilder

Methods

fmap :: (a -> b) -> FunctionBuilder m r a -> FunctionBuilder m r b #

(<$) :: a -> FunctionBuilder m r b -> FunctionBuilder m r a #

Applicative (FunctionBuilder m r) Source # 
Instance details

Defined in Data.FunctionBuilder

Methods

pure :: a -> FunctionBuilder m r a #

(<*>) :: FunctionBuilder m r (a -> b) -> FunctionBuilder m r a -> FunctionBuilder m r b #

liftA2 :: (a -> b -> c) -> FunctionBuilder m r a -> FunctionBuilder m r b -> FunctionBuilder m r c #

(*>) :: FunctionBuilder m r a -> FunctionBuilder m r b -> FunctionBuilder m r b #

(<*) :: FunctionBuilder m r a -> FunctionBuilder m r b -> FunctionBuilder m r a #

Semigroup m => Semigroup (FunctionBuilder m r r) Source #

Allow appending a FunctionBuilder to another without changing the resulting output function. For example, FunctionBuilders that have FunctionBuilder m r r can append something to m. It is not possible to add new parameters to the output function, this can only be done by the Category instance.

Instance details

Defined in Data.FunctionBuilder

Methods

(<>) :: FunctionBuilder m r r -> FunctionBuilder m r r -> FunctionBuilder m r r #

sconcat :: NonEmpty (FunctionBuilder m r r) -> FunctionBuilder m r r #

stimes :: Integral b => b -> FunctionBuilder m r r -> FunctionBuilder m r r #

Monoid m => Monoid (FunctionBuilder m r r) Source #

Allow appending a FunctionBuilder to another without changing the resulting output function. For example, FunctionBuilders that have FunctionBuilder m r r can append something to m. It is not possible to add new parameters to the output function, this can only be done by the Category instance.

Instance details

Defined in Data.FunctionBuilder

toFunction :: FunctionBuilder output output make_output -> make_output Source #

Turn a FunctionBuilder into the output function that consumes zero or more of parameter and then always return outout.

If passed a FunctionBuilder value of type FunctionBuilder String String (Int -> Double -> Int -> String)

For example:

example :: Int -> Double -> Int -> String
example = toFunction (i . d . i)

s :: String -> FunctionBuilder String a a
s x = FB (\k -> k x)

i :: FunctionBuilder String next (Int -> next)
i = FB (\k x -> k $ show x)

d :: FunctionBuilder String next (Double -> next)
d = FB (\k x -> k $ show x)

Building FunctionBuilders

immediate :: m -> FunctionBuilder m r r Source #

Create a FunctionBuilder that appends something to the (monoidal-) output value.

This is a smart constructor for a FunctionBuilder. This functions is probably equal to:

immediate x = FB (\k -> k x)

Example:

When building a String formatting FunctionBuilder the function to append a literal string could be:

s :: String -> FunctionBuilder String a a
s = immediate
c :: Char -> FunctionBuilder String a a
c = immediate . (:[])
example :: String
example = toFunction (s "hello" . c ' ' . s "world")
>>> example
"hello world"

See the example in toFunction.

addParameter :: (a -> m) -> FunctionBuilder m r (a -> r) Source #

Create a FunctionBuilder that adds an argument to the output function, and converts that argument to a value that can be accumulated in the resulting monoidal value.

This is a smart constructor for a FunctionBuilder. This functions is probably equal to:

addParameter f = FB (\k x -> k (f x))

Example:

When building a String formatting FunctionBuilder the function to append a parameter that has a show instance could be:

showing :: Show a => FunctionBuilder String r (a -> r)
showing = addParameter show
example :: (Show a, Show b) => a -> b -> String
example = toFunction (showing . showing)
>>> example True 0.33214
"True0.33214"

See the example in toFunction.

Modifying Parameters of FunctionBuilders

fillParameter :: FunctionBuilder m r (a -> b) -> a -> FunctionBuilder m r b Source #

Take away a function parameter added with addParameter by pre - applying it to some value. This is equivalent to:

    fillParameter f x = f * pure x

tagParameter :: forall tag m r a b. FunctionBuilder m r (a -> b) -> FunctionBuilder m r (Tagged tag a -> b) Source #

Convert a FunctionBuilder for a function (a -> b) to (Tagged tag a -> b).

FunctionBuilder Transformations

bind :: FunctionBuilder m b c -> (m -> FunctionBuilder n a b) -> FunctionBuilder n a c Source #

Compose to FunctionBuilders such that the second FunctionBuilder may depend on the intermediate result of the first. If you skwirm hard enough you almost see '(>>=)' with m ~ n.

mapAccumulator :: (m -> n) -> FunctionBuilder m a b -> FunctionBuilder n a b Source #

Convert the accumulated (usually monoidal-) value, this allows to change the underlying accumlator type.

mapNext :: (s -> r) -> FunctionBuilder m r a -> FunctionBuilder m s a Source #

Convert the output of a FunctionBuilder value; since most FunctionBuilders are parameteric in r they also have r in a in a, such that a always either is r or is a function returning r eventually.

In order to get from a FunctionBuilder that can accept a continuation returning it an r to a FunctionBuilder that accepts continuations returning an s instead, we need to apply a function s -> r to the return value of the continuation.

Note that a mapNext will not only change the r to an s but probably also the the a, when it is parametric, as in this contrived example:

example :: Int -> x -> Sum Int
example = toFunction (ign add)

add :: FunctionBuilder (Sum Int) next (Int -> next)
add = FB (\k x -> k $ Sum x)

ign :: FunctionBuilder m (x -> r) a -> FunctionBuilder m r a
ign = mapNext const

Here the extra parameter x is pushed down into the a of the add FunctionBuilder.