Easier lenses, Profunctor based, with the Mezzolens library

11 Jan 2019 Gabriel Riba Faura View Markdown source

As of March 2020, School of Haskell has been switched to read-only mode.

Sections

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

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 as M
Prelude M> import Mezzolens.Profunctor as MP
Prelude M MP> import Data.Function ((&))       -- (&): backwards application

Prelude M MP>:t _1 (f :: a -> b) 
:: (a, c) -> (b, c)

Prelude M MP>:t _2 (f :: a -> b) 
:: (c, a) -> (c, b)

-- focusing with a lens and the function (+2), gets the structure updated
Prelude M MP> (1, 2) & _1 (+2)  
(3, 2)

-- the function `M.get` with a lens, queries the focused component
Prelude M MP> (1, 2) & M.get _1
1

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 latitude/longitude
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 match -}
      -> (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. from 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