Posted on 2017-04-07
by Oleg Grenrus
lens

It's not an April's Fool day anymore, but don't take this seriously anyway. Tongue in cheek literate Haskell post on lenses (if interested in more serious ones, see Compiling Lenses, and Affine Traversal ).

A quote by metafunctor

Haskell is so advanced that a inordinate amount of literature is devoted to what in any standard language would be simple getters setters and loops.For loops are too much for me, but getters and setters we can do (in Haskell).

```
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
module MutatedLens where
import Control.Monad.ST
import Control.Lens
import Data.STRef
```

`readSTRef`

and `writeSTRef`

types are just right so we can pass them into `lens`

Unfortunately the type of `view`

is too restrictive, so we have to define a polymorphic version:

```
type GettingP r s t a b = (a -> Const r b) -> s -> Const r t
viewP :: GettingP a s t a b -> s -> a
viewP f s = getConst (f Const s)
```

Seems to work:

Let's define an imperative record, with mutable fields:

and a "lens" into the first field:

```
intField :: Lens (ImpRecord s) (ST s ()) (STRef s Int) (ST s ())
intField = lens _intField (\_ -> id)
```

Now we can *read* and *write* through `intField`

and `stref`

. First we create a record, then read its field; after that we mutate the field and read it again:

```
program :: ST s (Int, Int)
program = do
iRef <- newSTRef 1
bRef <- newSTRef True
let mrecord = ImpRecord iRef bRef
i1 <- viewP (intField . stref) mrecord
set (intField . stref) 2 mrecord
i2 <- viewP (intField . stref) mrecord
pure (i1, i2)
```

If we run the program, it works:

The problem with this approach, is that we cannot drill through `STRef s (STRef s) ...`

.

Normal lens are in `(->)`

, but we can work in `Kleisli (ST s)`

too. So if we change all normal arrows to `Kleisli (ST s)`

(yet unwrapped), we can define `STLens`

:

```
type STLens z s t a b = forall f. MonadTransFunctor f =>
(ST z a -> f (ST z) b) -> s -> f (ST z) t
class MonadTransFunctor t where
tfmap :: Monad m => (a -> m b) -> t m a -> t m b
semibind :: Monad m => m a -> (a -> t m b) -> t m b
stlens :: (s -> ST z a) -> (s -> b -> ST z t) -> STLens z s t a b
stlens getter setter f s = tfmap (setter s) (f (getter s))
```

They compose:

```
infixr 8 `o`
o :: STLens z s t a b -> STLens z a b u v -> STLens z s t u v
o stab abuv f s = stab (\sta -> semibind sta $ \a -> abuv f a) s
```

and we can redefine `stref'`

:

```
stref' :: STLens z (STRef z a) (STRef z a) a a
stref' = stlens readSTRef (\s b -> writeSTRef s b >> pure s)
```

The following definitions for `stview`

and `stover`

are very similar to `lens`

counterparts.

```
newtype ConstT r (m :: * -> *) a = ConstT { getConstT :: m r }
instance MonadTransFunctor (ConstT r) where
tfmap f (ConstT r) = ConstT r
semibind m k = ConstT $ m >>= getConstT . k
type STGetting r z s a =
(ST z a -> ConstT r (ST z) a) -> s -> ConstT r (ST z) s
stview :: STGetting a z s a -> s -> ST z a
stview l s = getConstT (l ConstT s)
```

```
newtype IdentityT m a = IdentityT { runIdentityT :: m a }
type STSetter z s t a b =
(ST z a -> IdentityT (ST z) b) -> s -> IdentityT (ST z) t
instance MonadTransFunctor IdentityT where
tfmap f (IdentityT x) = IdentityT (x >>= f)
semibind m k = IdentityT (m >>= runIdentityT . k)
stover :: STSetter z s t a b -> (a -> ST z b) -> s -> ST z t
stover l f s = runIdentityT (l (\a -> IdentityT (a >>= f)) s)
stset :: STSetter z s t a b -> s -> b -> ST z t
stset l s b = stover l (\_ -> pure b) s
```

And we can now drill through multiple `STRef`

!

```
program2 :: ST s (Int, Int)
program2 = do
ref1 <- newSTRef 42
ref2 <- newSTRef ref1
i1 <- stview (stref' `o` stref') ref2
_ <- stset (stref' `o` stref') ref2 99
i2 <- stview (stref' `o` stref') ref2
pure (i1, i2)
```

So, yet another example that Haskell is good imperative language. And we can have controlled effects in imperative language, you just need expressive enough language. :)

You can run this file with

```
stack --resolver=nightly-2017-03-01 ghci --ghci-options='-pgmL markdown-unlit'
λ> :l mutated-lenses.lhs
```

fetch the source from https://gist.github.com/phadej/a74f0d14749a352b9b3430c10bf35706

Site proudly generated by Hakyll