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, with an input domain parameter (contravariant) and a result domain parameter (covariant) with an operation dimap that applies a contramap to the input domain and a map to the output domain, giving another profunctor between the origin domain of the contramap and the destination domain of the map.

class Profunctor p where
  dimap :: (a -> b) -> (c -> d) -> p b c -> p a d
  

Some instances of profunctors are

  • 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 transformation of a structure, as function of, a transformation of a component.

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

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 = floor v
      fraction = v - fromIntegral intPart
      (mins, secs) = truncate (fraction * 3600) `divMod` 60

-- lens generation (with "lens getter setter" from Mezzolens.Unchecked)
-- lens :: (ta -> a) -> (b -> ta -> tb) -> Lens ta tb a b

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, lensMinuteFromLatitude, lensSecondFromLatitude :: Lens' Location Int
lensDegreesFromLatitude = latitude . degree
lensMinuteFromLatitude = latitude . minute
lensSecondFromLatitude = latitude . second

-- get the focused component
degreeLat = locBcn & get lensDegreesFromLatitude

-- (^.) is an infix version of 'get'

-- update the focused component:
-- (+2) is a function (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 sequenciality is required, e.g. you have a monadic transformation function on the component, turn it into 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> :t runKleisli . lensDegreesFromLatitude . Kleisli $ (\x -> return (x+2))
runKleisli . lensDegreesFromLatitude . Kleisli $ (\x -> return (x+2))
  :: Monad m => Location -> m Location

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 may modify an Either variant with the input profunctor.

-- a Prism generator from Mezzolens.Unchecked
prism :: (ta -> Either tb a) -> (b -> tb) -> Prism ta tb a b
  • the first prism parameter should give either the component in case of success, or the result structure in case of fail.

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 eiHeadOrNil :: [a] -> Either [a] a
*Main M MU|     eiHeadOrNil = \case
*Main M MU|                      (x : _) -> Right x  -- target variant result
*Main M MU|                      [] -> Left []     -- non target variant result
*Main M MU| let _Head = MU.prism eiHeadOrNil (\x -> [x])
*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:

class (Strong p, Choice p) => Wandering p where
  wander :: Traversable f => p a b -> p (f a) (f b)

wander offers a lens that let you traverse a traversable

  • 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}}]

-- (sumOf): a Fold on the Sum monoid (See the next section explanation.)

*Main M MP> [locBcn, locTwoDegreesNordOfBcn] & M.sumOf (MP.wander . lensDegreesFromLatitude)
84

-- (toListOf): {toListOf lens = gets lens pure} it uses the same trick as 'sumOf' composing with a Monoid the elements of the traversal, but uses 'pure' to map them to a generic Applicative and Monoid also (explained later), that, constraint to a list, will give you the 'mappend'ed result of 'pure' list singletons.

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

Understanding the fold with sumOf

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

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

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.

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