## Profunctors

A profunctor is a generalisation of a mapping between two domains, contravariant on the first (the input) and covariant on the second (the output)

```
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`

Some instances of profunctors are

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.

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

```
-- given 'a' the type of the target component of an input structure of type 'ta'
-- and 'b' the type of a transformed 'a', component of an output structure of type '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)
```

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 generation (from Mezzolens.Unchecked)
-- lens :: (ta -> a) -> (b -> ta -> tb) -> Lens ta tb a b
-- ^ lens getter updater
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 a monadic component transformation function 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 that may not succeed, as they target parts of *sum types*

```
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 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) -> (b -> tb) -> Prism ta tb a b
-- ^ prism match build
```

the first

*prism*parameter should give either the component in case of success, or a result structure in case of fail.the second builds a sum type variant of

*tb*from the component*b*

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*:

```
-- 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
```

*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 Monoid fold of the items focused by a traversal, mapped to a Monoid domain.

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*

```
sumOf lens = getSum . gets lens Sum -- getSum is the Sum type accessor
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
gets lens f = getConstant . (runKleisli (lens (Kleisli (Constant . f))))
```

taking *wander* as lens

```
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}
```

substituting the lens *wander* 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
newtype Constant a b = Constant { getConstant :: a }
-- Constant instance of 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, whatever the traversable instance, its combinator will be ignored and 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})
```

### 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 -} -> (b -> ta -> tb) {- setter-} -> Lens ta tb a b
-- let's obtain an output map for our lens
> :t uncurry setter
:: (b, ta) -> tb
-- now lets's build a matching contramap
-- with (&&&) from Arrow -- it pairs the results of two arrows of the same input type
> :t getter &&& id -- since functions are instances of Arrow
:: ta -> (a, ta)
> :t dimap (getter &&& id) (uncurry setter)
:: 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) -> (b -> ta -> tb) -> 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)
-- from Control.Arrow.Arrow class
-- (&&&) :: Arrow a => a b c -> a b c' -> a b (c, 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) {- match -} -> (b -> tb) {- build -} -> 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 `tb` in case of fail
-- `build` should wrap the transformed component `b` in a `tb` variant of the sum type result structure
-- (|||) from ArrowChoice, splices the input types of two arrows of the same result type in an Either
> :t id ||| build -- since functions are instances of ArrowChoice
:: Either tb b -> tb
> :t dimap match (id ||| build)
:: Profunctor p => p (Either tb a) (Either tb b) -> p ta tb
```

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.

```
-- the generator:
prism :: (ta -> Either tb a) -> (b -> tb) -> Prism ta tb a b
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)
-- from Control.Arrow.ArrowChoice class
-- (|||) :: ArrowChoice a => a b d -> a c d -> a (Either b c) d
```

#### 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 on a profunctor over its swapped type
_swap :: Iso (a,b) (c,d) (b,a) (d,c)
_swap = iso swap swap
```