## Profunctors

A profunctor, -- type `(p a b)`

, is a generalisation of a mapping between two domains, contravariant on the first (the input `a`

) and covariant on the second (the output `b`

)

```
-- here we pass to `dimap` a contramap to the first type parameter of the profunctor (p b c)
-- and a map to the second one
class Profunctor p where
dimap :: (a -> b) -> (c -> d) -> p b c -> p a d
```

So `dimap (contramap :: a -> b) (map :: c -> d)`

offers a transformation from the input `a`

to the output `d`

, as function of, a transformation from `b`

to `c`

.

Applying `dimap (contramap :: a -> b) (map :: c -> d)`

to an instance of `p b c`

gives `p a d`

: an instance of the same type `p`

transforming the input `a`

to the output `d`

.

Some instances of profunctors are

- Functions:
`Profunctor (->)`

*Kleisli*arrows:`Functor f => Profunctor (Kleisli f)`

Note: An *Arrow* is a generalisation of a computation with an input and an unrelated output. Monads can be lifted to arrows with the *Kleisli* datatype.

For a more detailed introduction check

the School of Haskell article "I love profunctors. They're so easy"

## Profunctor based lenses with Mezzolens

Mezzolens is a library written by Russell O'Connor.

A lens is defined here as a means to transform a structure, as function of, a transformation on one of its components. So you may combine the focused component mapping and the lens, over the initial structure, giving a transformed structure or a query result.

It takes the shape of a function of a profunctor on the component, giving a profunctor on the structure.

To characterize a lens (lens generation) you need a component selection function, and a structure update or query function from the image of the selected component transformation.

Since uncurrying is needed for lens generators, we add the *Strong* class lenses over pairs, defined below, as requirement.

```
-- given 'a' the type of the target component of an input structure of type 'ta'
-- and 'b' the type of a transformed 'a', from which you produce 'tb'
type Optical p ta tb a b = p a b -> p ta tb
type Lens ta tb a b = forall p. Strong p => p a b -> p ta tb
-- where
class Profunctor p => Strong p where
_1 :: p a b -> p (a, c) (b, c)
_2 :: p a b -> p (c, a) (c, b)
-- simple lenses:
-- Lens' is the type of lenses that don't change the types of component and structure.
type Lens' ta a = Lens ta ta a a
```

The methods of a *Strong profunctor* can be seen as lenses that provide a transformation of a Pair, as function of, the transformation of one of its components.

Since a function is an instance of it, applying its lens to a function, gives as result a function over pairs:

```
Prelude> import Mezzolens.Profunctor as MP
Prelude MP>:t _1 (f :: a -> b)
:: (a, c) -> (b, c)
Prelude MP>:t _2 (f :: a -> b)
:: (c, a) -> (c, b)
```

Lens generation:

```
-- from Mezzolens.Unchecked
-- lens :: (ta -> a) {- component selection -}
-> (b -> ta -> tb) {- struct. transf. with component image -}
-> Lens ta tb a b
-- ^ lens getter updater
```

As lenses are functions, they can compose, giving you access to items deep in a complex structure.

```
{-| file test-mezzo.hs -}
{-# LANGUAGE PackageImports #-}
import "mezzolens" Mezzolens (Lens', (^.), get, set)
import "mezzolens" Mezzolens.Unchecked (lens)
import Data.Function ((&)) -- (&): backwards application
data Arc = Arc {_degree, _minute, _second :: Int} deriving (Show)
data Location = Location {_latitude, _longitude :: Arc} deriving (Show)
-- structure to play with
locBcn = Location (arcFromDecimal 41.399423) (arcFromDecimal 2.128037)
-- decimal to sexagesimal
arcFromDecimal :: Double -> Arc
arcFromDecimal v = Arc intPart mins secs
where
(intPart, fraction) = properFraction v
-- divide negative lat/lon fractions towards 0 with quotRem
(mins, secs) = truncate (fraction * 3600) `quotRem` 60
-- lens generators
degree, minute, second :: Lens' Arc Int
degree = lens _degree (\v arc -> arc {_degree = v})
minute = lens _minute (\v arc -> arc {_minute = v})
second = lens _second (\v arc -> arc {_second = v})
latitude :: Lens' Location Arc
latitude = lens _latitude (\v loc -> loc {_latitude = v})
-- composing lenses
lensDegreesFromLatitude, lensMinutesFromLatitude, lensSecondsFromLatitude :: Lens' Location Int
lensDegreesFromLatitude = latitude . degree
lensMinutesFromLatitude = latitude . minute
lensSecondsFromLatitude = latitude . second
-- get the focused component
degreeLat = locBcn & get lensDegreesFromLatitude
-- (^.) is an infix version of 'get'
-- update the focused component:
-- (+2) is a unary function (unary functions are instances of ''Profunctor'')
-- applying the lens to the Profunctor value (+2) will give us a profunctor of the same type (a function) on the structure
locTwoDegreesNordOfBcn = locBcn & lensDegreesFromLatitude (+2)
-- 'set' applies the lens to a constant function
-- set lens v = lens (const v)
```

With Ghci

```
$ ghci
GHCi, version 7.10.3: http://www.haskell.org/ghc/ :? for help
Prelude> :l test-mezzo
[1 of 1] Compiling Main ( test-mezzo.hs, interpreted )
Ok, modules loaded: Main.
*Main> import Mezzolens as M
*Main M> :t M.get lensDegreesFromLatitude
M.get lensDegreesFromLatitude :: Location -> Int
*Main M> :t lensDegreesFromLatitude (+2)
lensDegreesFromLatitude (+2) :: Location -> Location
```

If you want a monadic transformation, wrap the monadic computation as a *Kleisli arrow*. Mezzolens brings an instance of Profunctor for Kleisli arrows.

Applying the lens to an *arrow* on the component returns an *arrow* on the structure, where you can get the monadic function inside with the Kleisli accessor *runKleisli*.

```
*Main M> import Control.Arrow as A
*Main M A> :{
*Main M A| let myMonadicCompoTransf :: Monad m => Int -> m Int
*Main M A| myMonadicCompoTransf = return . (+2)
*Main M A| :}
*Main M A> :t runKleisli . lensDegreesFromLatitude . Kleisli $ myMonadicCompoTransf
runKleisli . lensDegreesFromLatitude . Kleisli $ myMonadicCompoTransf
:: Monad m => Location -> m Location
```

But a monadic use is questionable unless you use state lenses which I will not cover here.

### Prisms

Prisms are lenses where the component selection may not succeed, as they target parts of *sum types*.

Since the component selection results in an Either, we will require profunctors with the *Choice* class lenses over *Either*, needed in prism generators

```
type Prism ta tb a b = forall p. Choice p => p a b -> p ta tb
-- where
class Profunctor p => Choice p where
_Left :: p a b -> p (Either a c) (Either b c)
_Right :: p a b -> p (Either c a) (Either c b)
```

A Choice profunctor is one that brings lenses methods that let you transform an Either variant content with the input profunctor.

```
-- a Prism generator from Mezzolens.Unchecked
prism :: (ta -> Either tb a) {- component selection -}
-> (b -> tb) {- struct. build up from component image -}
-> Prism ta tb a b
-- ^ prism match build
```

the first

*prism*generator parameter (component selection) should give either the component in case of success, or a result structure in case of fail.the second (final structure from component image) builds a sum type variant of

*tb*from the image (type*b*) of the selected component

Example on the *head* of a List.

```
*Main> import Mezzolens as M
*Main M> import Mezzolens.Unchecked as MU
*Main M MU> :set -XLambdaCase
*Main M MU> :{
*Main M MU| let headMatch :: [a] -> Either [a] a
*Main M MU| headMatch = \case
*Main M MU| x : _ -> Right x -- target variant
*Main M MU| [] -> Left [] -- fail case giving a zero/empty structure
*Main M MU| let headBuild = \x -> [x]
*Main M MU| let _Head = MU.prism headMatch headBuild
*Main M MU| :}
-- Prism query (optional result)
*Main M MU> [locBcn] ^? (_Head . lensDegreesFromLatitude)
Just 41
-- Update on a target variant
*Main M MU> [locBcn] & (_Head . lensDegreesFromLatitude) (+2)
[Location {_latitude = Arc {_degree = 43, _minute = 23, _second = 57}, _longitude = Arc {_degree = 2, _minute = 7, _second = 40}}]
-- Update on the non target variant
*Main M MU> [] & (_Head . lensDegreesFromLatitude) (+2)
[]
```

### Traverses and folds

The *Wandering* class and the function *gets*:

*wander*offers a lens that let you traverse a traversable, transforming its elements with the input profunctor.The

*gets*function offers a means to get a fold of the codomain (target set) of mapping the items focused by a traversal to a Monoid.

```
-- from Mezzolens.Profunctor
class (Strong p, Choice p) => Wandering p where
wander :: Traversable f => p a b -> p (f a) (f b)
-- from Mezzolens
gets :: Monoid r => Fold ta tb a b -> (a -> r) -> ta -> r
-- from Mezzolens.Optics
type Fold ta tb a b = forall p. (OutPhantom p, Wandering p) => Optical p ta tb a b
-- (OutPhantom p) means that the profunctor output type is coercible
```

with Ghci and the test code loaded

```
*Main> import Mezzolens as M
*Main M> import Mezzolens.Profunctor as MP
-- traverse a list, updating its elements
*Main M MP> [locBcn, locTwoDegreesNordOfBcn] & (MP.wander . lensDegreesFromLatitude) (+3)
[Location {_latitude = Arc {_degree = 44, _minute = 23, _second = 57}, _longitude = Arc {_degree = 2, _minute = 7, _second = 40}},Location {_latitude = Arc {_degree = 46, _minute = 23, _second = 57}, _longitude = Arc {_degree = 2, _minute = 7, _second = 40}}]
-- (toListOf): {toListOf lens = gets lens pure} it uses 'pure' to map the focused elements to a generic Applicative that when constraint to a List gives List singletons, folded with the List Monoid instance into a concatenation.
*Main M MP> [locBcn, locTwoDegreesNordOfBcn] & M.toListOf (MP.wander . lensDegreesFromLatitude) :: [Int]
[41,43]
-- (^..) is an infix version of toListOf
*Main M MP> [locBcn, locTwoDegreesNordOfBcn] ^.. (MP.wander . lensDegreesFromLatitude) :: [Int]
[41,43]
-- (sumOf): maps the focused elements to the Monoid Sum and combine. See next section.
*Main M MP> [locBcn, locTwoDegreesNordOfBcn] & M.sumOf (MP.wander . lensDegreesFromLatitude)
84
```

### Understanding folds like *sumOf*

We take *Sum* as the *gets* mapping function, fetching the result with its accessor *getSum*:

```
sumOf lens = getSum . gets lens Sum
gets :: Optical (SubStar (Constant r)) ta tb a b -> (a -> r) -> ta -> r
gets lens f = getConstant . h
where
Kleisli h = lens (Kleisli (Constant . f))
-- type SubStar = Kleisli -- from Mezzolens.Profunctor
-- substituting ''h'' extracting it with ''runKleisli''
gets lens f = getConstant . (runKleisli (lens (Kleisli (Constant . f))))
```

using *wander* as *lens* in the *gets* expression, then reducing *wander* on a Kleisli arrow:

```
Prelude ...> let g f = getConstant . (runKleisli (wander (Kleisli (Constant . f))))
-- from Mezzolens code:
instance Applicative f => Wandering (Kleisli f) where
wander (Kleisli h) = Kleisli (traverse h)
-- since there is an Applicative instance for Constant
Prelude ...> let g f = getConstant . (runKleisli (Kleisli (traverse (Constant . f))))
-- since {runKleisli . Kleisli == id}
Prelude ...> let g f = getConstant . (traverse (Constant . f))
Prelude ...> g Sum [1,2,3]
Sum {getSum = 6}
```

understanding *Constant* from Data.Functor.Constant

```
-- Constant has a phantom type parameter, so (Constant a) can be seen as a structure:
newtype Constant a b = Constant { getConstant :: a }
-- the (Constant a) instance for Applicative is defined only for 'a' Monoid
instance (Monoid a) => Applicative (Constant a) where
pure _ = Constant mempty -- applicative combinators will be ignored !!
Constant x <*> Constant y = Constant (x `mappend` y)
Prelude ...> :t traverse
traverse
:: (Applicative f, Traversable t) => (a -> f b) -> t a -> f (t b)
```

Since Constant is the Applicative type in the traversal, because in its instance *"pure"* ignores the combinator, whatever the traversable instance, you will get the Monoid composition instead, folding left to right as the container is traversed.

```
Prelude ...> :t traverse Constant
traverse Constant
:: (Traversable t, Monoid a) => t a -> Constant a (t b)
-- you will not get (t b) inside Constant
-- but ''mempty'' from (''pure'' traversable_combinator), ''mappend''ed to all a's
Prelude ...> traverse Constant [Sum 1, Sum 2, Sum 3]
Constant (Sum {getSum = 6})
```

as summary:

```
Prelude ...> :t gets wander
gets wander :: (Traversable f, Monoid r) => (a -> r) -> f a -> r
Prelude ...> :t gets wander Sum
gets wander Sum :: (Num a, Traversable f) => f a -> Sum a
Prelude ...> gets wander Sum [1,2,3]
Sum {getSum = 6}
```

### Some generators

#### The *lens* generator

```
type Optical p ta tb a b = p a b -> p ta tb
type Lens ta tb a b = forall p. Strong p => Optical p ta tb a b
lens :: (ta -> a) {- getter: component selection -}
-> (b -> ta -> tb) {- setter: struct. transf. with component image -}
-> Lens ta tb a b
-- we need to find parameters for ''dimap''
-- let's obtain an output map for our lens, pairing the setter parameters
> :t uncurry setter
:: (b, ta) -> tb
-- a matching contramap changing the component woud be
-- :: ta -> (a, ta)
-- with (&&&) from Arrow -- it pairs the results of two arrows of the same input type
-- from Control.Arrow.Arrow class
-- (&&&) :: Arrow a => a b c -> a b c' -> a b (c, c')
> :t getter &&& id -- since functions are instances of Arrow
:: ta -> (a, ta)
> :t dimap \
(getter &&& id) {- :: ta -> (a, ta) -} \
(uncurry setter) {- :: (b, ta) -> tb -}
:: Profunctor p => p (a, ta) (b, ta) -> p ta tb
```

With `dimap (getter &&& id) (uncurry setter)`

you have a lens from the structure to a pair.

Composing it with `_1`

(the lens on the first item of a pair) we further put the focus on the component transformation `p a b`

, adding the requirement that the profunctor should implement the class Strong where `_1`

is defined.

```
import Control.Arrow ((&&&), (|||))
type Optical p ta tb a b = p a b -> p ta tb
type Lens ta tb a b = forall p. Strong p => Optical p ta tb a b
-- the generator:
lens :: (ta -> a) {- component selection -}
-> (b -> ta -> tb) {- structure transf. with component image -}
-> Lens ta tb a b
lens getter setter = lensStructFromPair . _1
where
lensStructFromPair :: Profunctor p
=> p (a, ta) (b, ta)
-> p ta tb
lensStructFromPair = dimap (getter &&& id) (uncurry setter)
-- _1 is a lens on the first component of a pair
-- _1 :: Strong p => p a b -> p (a, c) (b, c)
```

#### The *prism* generator

Prisms target sum type variants

```
type Prism ta tb a b = forall p. Choice p => Optical p ta tb a b
prism :: (ta -> Either tb a) {- component selection "match" -}
-> (b -> tb) {- build final struct. with component image -}
-> Prism ta tb a b
-- `match` should give an (Either tb a) which means a component `a` in case of success or a zero result structure of type `tb` in case of fail
-- `build` should wrap the transformed component `b` in a variant of the sum type structure of type `tb`
-- we need to find parameters for ''dimap''
-- we take ''(match :: ta -> Either tb a)'' as the contramap operation
-- a matching map switching the comp. type with its image
-- would be ''(Either tb b -> tb)''
-- we have ''(build :: b -> tb)''
-- (|||) from ArrowChoice, splices the input types of two arrows of the same result type in an Either
-- from Control.Arrow.ArrowChoice class
-- (|||) :: ArrowChoice a => a b d -> a c d -> a (Either b c) d
> :t id ||| build -- since functions are instances of ArrowChoice
:: Either tb b -> tb
> :t dimap \
match {- :: ta -> Either tb a -} \
(id ||| build) {- :: Either tb b -> tb -}
:: Profunctor p => p (Either tb a) (Either tb b) -> p ta tb
prism match build = lensStructFromEither . _Right
where
lensStructFromEither :: Profunctor p
=> p (Either tb a) (Either tb b)
-> p ta tb
lensStructFromEither = dimap match (id ||| build)
-- _Right is a lens on the second domain of an Either
-- _Right :: Choice p => p a b -> p (Either c a) (Either c b)
```

With `dimap match (id ||| build)`

you have a lens from the Structure to an Either having the component as Right or a Left `tb`

structure in case of mismatch.

Composing it with the lens *_Right*, will make possible to focus on the component, adding the requirement that the profunctor should also implement the class Choice where *_Right* is defined.

#### Isos

Iso's are lenses that convert a profunctor on structures, on one over an Isomorphic representation

```
type Iso ta tb a b = forall p. Profunctor p => Optical p ta tb a b
-- the generator:
iso :: (ta -> a) -> (b -> tb) -> Iso ta tb a b
iso = dimap
-- as example, the lens _swap converts a profunctor on pairs into a profunctor over its swapped type
_swap :: Iso (a,b) (c,d) (b,a) (d,c)
_swap = iso swap swap
```