Safe Haskell | None |
---|---|
Language | Haskell2010 |
Primarily pulled from the
package newtype-generics
,
and based on Conor McBride's Epigram work, but
generalised to work over anything Coercible
.
>>>
ala Sum foldMap [1,2,3,4 :: Int] :: Int
10
>>>
ala Endo foldMap [(+1), (+2), (subtract 1), (*2) :: Int -> Int] (3 :: Int) :: Int
8
>>>
under2 Min (<>) 2 (1 :: Int) :: Int
1
>>>
over All not (All False) :: All
All {getAll = True)
Note: All of the functions in this module take an argument that solely directs the type of the coercion. The value of this argument is ignored.
Synopsis
- (#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c
- (.#) :: Coercible a b => (b -> c) -> (a -> b) -> a -> c
- op :: Coercible a b => (a -> b) -> b -> a
- ala :: (Coercible a b, Coercible a' b') => (a -> b) -> ((a -> b) -> c -> b') -> c -> a'
- ala' :: (Coercible a b, Coercible a' b') => (a -> b) -> ((d -> b) -> c -> b') -> (d -> a) -> c -> a'
- under :: (Coercible a b, Coercible a' b') => (a -> b) -> (b -> b') -> a -> a'
- over :: (Coercible a b, Coercible a' b') => (a -> b) -> (a -> a') -> b -> b'
- under2 :: (Coercible a b, Coercible a' b') => (a -> b) -> (b -> b -> b') -> a -> a -> a'
- over2 :: (Coercible a b, Coercible a' b') => (a -> b) -> (a -> a -> a') -> b -> b -> b'
- underF :: (Coercible a b, Coercible a' b', Functor f, Functor g) => (a -> b) -> (f b -> g b') -> f a -> g a'
- overF :: (Coercible a b, Coercible a' b', Functor f, Functor g) => (a -> b) -> (f a -> g a') -> f b -> g b'
Coercive composition
The classic "newtype" combinators
op :: Coercible a b => (a -> b) -> b -> a Source #
Reverse the type of a "packer".
>>>
op All (All True)
True>>>
op (Identity . Sum) (Identity (Sum 3))
3
ala :: (Coercible a b, Coercible a' b') => (a -> b) -> ((a -> b) -> c -> b') -> c -> a' Source #
The workhorse of the package. Given a "packer" and a "higher order function" (hof), it handles the packing and unpacking, and just sends you back a regular old function, with the type varying based on the hof you passed.
The reason for the signature of the hof is due to ala
not caring about structure.
To illustrate why this is important, consider this alternative implementation of under2
:
under2' :: (Coercible a b, Coercible a' b')
=> (a -> b) -> (b -> b -> b') -> (a -> a -> a')
under2' pa f o1 o2 = ala
pa (\p -> uncurry f . bimap p p) (o1, o2)
Being handed the "packer", the hof may apply it in any structure of its choosing – in this case a tuple.
>>>
ala Sum foldMap [1,2,3,4 :: Int] :: Int
10
ala' :: (Coercible a b, Coercible a' b') => (a -> b) -> ((d -> b) -> c -> b') -> (d -> a) -> c -> a' Source #
The way it differs from the ala
function in this package,
is that it provides an extra hook into the "packer" passed to the hof.
However, this normally ends up being id
, so ala
wraps this function and
passes id
as the final parameter by default.
If you want the convenience of being able to hook right into the hof,
you may use this function.
>>>
ala' Sum foldMap length ["hello", "world"] :: Int
10
>>>
ala' First foldMap (readMaybe @Int) ["x", "42", "1"] :: Maybe Int
Just 42
under :: (Coercible a b, Coercible a' b') => (a -> b) -> (b -> b') -> a -> a' Source #
A very simple operation involving running the function under the "packer".
>>>
under Product (stimes 3) (3 :: Int) :: Int
27
over :: (Coercible a b, Coercible a' b') => (a -> b) -> (a -> a') -> b -> b' Source #
The opposite of under
. I.e., take a function which works on the
underlying "unpacked" types, and switch it to a function that works
on the "packer".
>>>
over All not (All False) :: All
All {getAll = True}
under2 :: (Coercible a b, Coercible a' b') => (a -> b) -> (b -> b -> b') -> a -> a -> a' Source #
Lower a binary function to operate on the underlying values.
>>>
under2 Any (<>) True False :: Bool
True
over2 :: (Coercible a b, Coercible a' b') => (a -> b) -> (a -> a -> a') -> b -> b -> b' Source #
The opposite of under2
.