Interactive code snippets not yet available for SoH 2.0, see our Status of of School of Haskell 2.0 blog post

Easier lenses, Profunctor based, with the Mezzolens library

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

  • Unary functions: Profunctor (->)
  • Kleisli arrows: Functor f => Profunctor (Kleisli f)

For a more detailed introduction check

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