Making monadic code shorter - haskell

Consider the following code:
transform :: Foo -> Bar
transform foo =
case foo of
Foo1 x -> Foo1 x
Foo2 x y -> Foo2 x (transform y)
Foo3 x y z -> Foo3 x (transform y) (transform z)
Now suppose for some reason I change this to work in a monad (e.g., because I have state I want to carry around or whatever). Now we have
transform :: Foo -> State Int Bar
transform foo =
case foo of
Foo1 x -> return $ Foo1 x
Foo2 x y -> do
y' <- transform y
return $ Foo2 x y'
Foo3 x y z -> do
y' <- transform y
z' <- transform z
return $ Foo3 x y' z'
Well that all works and everything, but... can we improve this? I have a nagging feeling that I ought to be able to define some nifty infix function to make this look nicer, but every time I try to work out how, my mind goes numb after a while...

Your intuition is right. This is the role of the ap function in the Monad class, or equivalently of the <*> operator in the Applicative class, which pretty much all monads implement (and will actually become a superclass of Monad in the future).
Here is its type:
(<*>) :: (Applicative f) => f (a -> b) -> f a -> f b
So it basically applies a wrapped function a -> b to a wrapped a to return a wrapped b. It is equivalent to:
mf <*> mx = do
f <- mf
x <- mx
return $ f x
Here is how to use it in your case, emphasizing the similarity between the different cases:
transform foo =
case foo of
Foo1 x -> return Foo1 <*> return x
Foo2 x y -> return Foo2 <*> return x <*> transform y
Foo3 x y z -> return Foo3 <*> return x <*> transform y <*> transform z
This can be shortened by considering that return f <*> return x == return (f x):
transform foo =
case foo of
Foo1 x -> return $ Foo1 x
Foo2 x y -> return (Foo2 x) <*> transform y
Foo3 x y z -> return (Foo3 x) <*> transform y <*> transform z
And even further, by using the operator <$> which is equivalent to fmap from the Functor class:
transform foo =
case foo of
Foo1 x -> return $ Foo1 x
Foo2 x y -> Foo2 x <$> transform y
Foo3 x y z -> Foo3 x <$> transform y <*> transform z

transform :: Foo -> State Int Bar
transform foo =
case foo of
Foo1 x -> return $ Foo1 x
Foo2 x y -> Foo2 x <$> transform y
Foo3 x y z -> Foo3 x <$> transform y <*> transform z
Requires Control.Applicative and Functor/Applicative instances for your Monad (they're there for state, and relatively trivial to implement for other Monads).

For anybody else trying to figure this out...
It seems the crucial definitions are these:
mf <*> mx = do
f <- mf
x <- mx
return (f x)
f <$> mx = do
x <- mx
return (f x)
In particular, the types are different; <*> takes mf while <$> takes f:
(<*>) :: Monad m => m (x -> y) -> m x -> m y
(<$>) :: Monad m => (x -> y) -> m x -> m y
(Not, of course, that either of these are actually Monad methods, or even methods at all. But you get the idea...)
As somebody who never uses fmap, this takes a while to get used to...

Related

Pattern matching for return values

I know I can use pattern matching for function parameters like this:
fn :: (Integral a) => (a,a) -> (a, a)
fn (x,y) = (y,x)
But how can I match the return value? I would expect something like this:
g :: (Integral a) => a -> a
g z = do
(x, y) = fn (z, z + 5)
x `mod` y
This results in a syntax error. Is there a way to match return values? Basically, I want to split the returned tuple into two variables.
The do is used a syntactical sugar for monads. Your function is however not a monad.
What you can do is use a let-clause, like:
g :: (Integral a) => a -> a
g z = let (x,y) = fn (z,(z+5)) in x `mod` y
Or a where-clause:
g :: (Integral a) => a -> a
g z = x `mod` y
where (x,y) = fn (z,(z+5))
You can also define a pattern in a lambda-expression, like:
g :: (Integral a) => a -> a
g z = (\(x,y) -> x `mod` y) $ fn (z,(z+5))
Along these lines, you can also define a helper function that does the pattern matching, like:
g :: (Integral a) => a -> a
g z = h $ fn (z,(z+5))
where h (x,y) = x `mod` y
This can be useful if there are several patterns that need to be handled differently (like the Nothing and Just x for the Maybe a type).
Say for instance that you defined a function:
foo :: Int -> Int -> Maybe Int
foo x y | x > y = Just x
| otherwise = Nothing
than you can define bar with a helper function qux to handle the output of foo, like:
bar :: Int -> Int -> Int
bar x y = qux $ foo x y
where qux Nothing = y
qux (Just z) = z
Finally in the case of 2-tuples, you can decide not to use pattern matching, but use fst :: (a,b) -> a and snd :: (a,b) -> b, like for instance:
g :: (Integral a) => a -> a
g z = let t = fn (z,(z+5)) in ( fst t) `mod` (snd t)
But this is less elegant since here one has to start thinking about what fst and snd do, and furtermore if not optimized, it can result in additional computation overhead.
Which one to pick depends of course on the context and a bit on personal taste. Since here the pattern is the only one, I would pick the let or where pattern, but like the French say: "Les goûts et les couleurs ne se discutent pas.".
My personal preference in the general case, is to use a case .. of expression. For instance, if f :: Int -> Maybe Int, we can write
g :: Int -> Int
g x = case f x of
Nothing -> 5
Just y -> x+y
For types with only one constructor, like tuples, then let .. in can also be used:
h a = let (x, y) = foo a in ...
Remember, however, that case is strict while let is lazy. E.g.
case undefined of (x,y) -> 5
raises an error. Instead
let (x, y) = undefined in 5
evaluates to 5. So, they are not completely equivalent. They became such when using irrefutable patterns, or matching against a newtype constructor.

Automatically deriving Provable for predicates over records in SBV

I'm in a situation where I have a data type like
data X = X {foo :: SInteger, bar :: SInteger}
and I want to prove e.g.
forAll_ $ \x -> foo x + bar x .== bar x + foo x
using haskell's sbv.
This doesn't compile because X -> SBool is not an instance of Provable. I can make it an instance with e.g.
instance (Provable p) => Provable (X -> p) where
forAll_ k = forAll_ $ \foo bar -> forAll_ $ k $ X foo bar
forAll (s : ss) k =
forAll ["foo " ++ s, "bar " ++ s] $ \foo bar -> forAll ss $ k $ X foo bar
forAll [] k = forAll_ k
-- and similarly `forSome_` and `forSome`
but this is tedious and error prone (e.g. using forSome when forAll should've been used). Is there a way to automatically derive Provable for my type?
It can at least be made less error-prone:
onX :: (((SInteger, SInteger) -> a) -> b) -> ((X -> a) -> b)
onX f g = f (g . uncurry X)
instance Provable p => Provable (X -> p) where
forAll_ = onX forAll_
forSome_ = onX forSome_
forAll = onX . forAll
forSome = onX . forSome
There's also a generalizable pattern, in case SBV's existing instances for up to 7-tuples are not sufficient.
data Y = Y {a, b, c, d, e, f, g, h, i, j :: SInteger}
-- don't try to write the types of these, you will wear out your keyboard
fmap10 = fmap . fmap . fmap . fmap . fmap . fmap . fmap . fmap . fmap . fmap
onY f g = f (fmap10 g Y)
instance Provable p => Provable (Y -> p) where
forAll_ = onY forAll_
forSome_ = onY forSome_
forAll = onY . forAll
forSome = onY . forSome
Still tedious, though.
Daniel's answer is "as good as it gets" if you really want to use quantifiers directly with your lambda-expressions. However, instead of creating a Provable instance, I'd strongly recommend defining a variant of free for your type:
freeX :: Symbolic X
freeX = do f <- free_
b <- free_
return $ X f b
Now you can use it like this:
test = prove $ do x <- freeX
return $ foo x + bar x .== bar x + foo x
This is much easier to use, and composes well with constraints. For instance, if your data type has the extra constraint that both components are positive, and the first one is larger than the second, then you can write freeX thusly:
freeX :: Symbolic X
freeX = do f <- free_
b <- free_
constrain $ f .> b
constrain $ b .> 0
return $ X f b
Note that this will work correctly in both prove and sat contexts, since free knows how to behave correctly in each case.
I think this is much more readable and easier to use, even though it forces you to use the do-notation. You can also create a version that accepts names, like this:
freeX :: String -> Symbolic X
freeX nm = do f <- free $ nm ++ "_foo"
b <- free $ nm ++ "_bar"
constrain $ f .> b
constrain $ b .> 0
return $ X f b
test = prove $ do x <- freeX "x"
return $ foo x + bar x .== bar x * foo x
Now we get:
*Main> test
Falsifiable. Counter-example:
x_foo = 3 :: Integer
x_bar = 1 :: Integer
You can also make X "parseable" by SBV. In this case the full code looks like this:
data X = X {foo :: SInteger, bar :: SInteger} deriving Show
freeX :: Symbolic X
freeX = do f <- free_
b <- free_
return $ X f b
instance SatModel X where
parseCWs xs = do (x, ys) <- parseCWs xs
(y, zs) <- parseCWs ys
return $ (X (literal x) (literal y), zs)
The following test demonstrates:
test :: IO (Maybe X)
test = extractModel `fmap` (prove $ do
x <- freeX
return $ foo x + bar x .== bar x * foo x)
We have:
*Main> test >>= print
Just (X {foo = -4 :: SInteger, bar = -5 :: SInteger})
Now you can take your counter-examples and post-process them as you wish.

How to use function composition for `foo (bar x) (bar y)` in Haskell?

I know that in Haskell, there is a awesome feature called function composition so that we could make our Haskell code pithier, like:
use (f . g) x instead of f (g x),
use foo x $ bar y z instead of foo x (bar y z)
But is it possible that we could use function composition for foo (bar x) (bar y)?
You can use the on function for this, for instance
import Data.Function
data Person = Person{name::String, age::Int}
compare `on` age --same as `\x y -> compare (age x) (age y)`
Define it yourself! Just a new infix function:
-- foo (bar x) (bar y) === foo $.$ bar (x y)
($.$) :: (b -> b -> c) -> (a -> b) -> (a -> a -> c)
f $.$ g = \x y -> f (g x) (g y)
-- test 3 5 = 3*3 + 5*5
test = (\x y -> x + y) $.$ (\z -> z * z)
Then in ghci:
ghci> test 3 5
34
is it possible that we could use function composition for foo (bar x) (bar y)
#ilyavf has given an answer, for a function definition such that (foo $.$ bar) x y will act like foo (bar x) (bar y). And #jamshidh offers that it exists as on in Data.Function.
But notice the type signature of is kind of a specific shape:
(b -> b -> c) -> (a -> b) -> (a -> a -> c)
As a function, though, it's "shaped funny" due to an assumption it has to make. That assumption is that both of foo's arguments are of the same type. (otherwise, how could it be correct to use the result of bar for both?)
The "more pleasing shape" to which Haskell gravitates doesn't call out the special case of working with functions that have two arguments of the same type. Because what is so special about 2? Much more interesting is "N", and if your function takes N arguments of the same type, then a list is nicer...and can compose as you would like, with a map operation that could work with any number of arguments:
foo [bar x, bar y] => (foo . map bar) [x, y]
A Control.Arrow alternative:
curry (uncurry f . (g *** g))
Not as readable as the previously posted solutions.
Pointless equivalences for \x y -> foo (bar x) (bar y):
Data.Function.Meld
foo $* bar $$ bar *$ id
Control.Compose
(bar ~> bar ~> id) foo
Data.Function.Tacit (uses -XTypeApplications)
lurryA #N2 (foo <$> (bar <$> _1) <*> (bar <$> _2))
lurryA #N4 (_1 <*> (_2 <*> _3) <*> (_2 <*> _4)) foo bar

Is there a way to elegantly represent this pattern in Haskell?

Mind the pure function below, in an imperative language:
def foo(x,y):
x = f(x) if a(x)
if c(x):
x = g(x)
else:
x = h(x)
x = f(x)
y = f(y) if a(y)
x = g(x) if b(y)
return [x,y]
That function represents a style where you have to incrementally update variables. It can be avoided in most cases, but there are situations where that pattern is unavoidable - for example, writing a cooking procedure for a robot, which inherently requires a series of steps and decisions. Now, imagine we were trying to represent foo in Haskell.
foo x0 y0 =
let x1 = if a x0 then f x0 else x0 in
let x2 = if c x1 then g x1 else h x1 in
let x3 = f x2 in
let y1 = if a y0 then f y0 else y0 in
let x4 = if b y1 then g x3 else x3 in
[x4,y1]
That code works, but it is too complicated and error prone due to the need for manually managing the numeric tags. Notice that, after x1 is set, x0's value should never be used again, but it still can. If you accidentally use it, that will be an undetected error.
I've managed to solve this problem using the State monad:
fooSt x y = execState (do
(x,y) <- get
when (a x) (put (f x, y))
(x,y) <- get
if c x
then put (g x, y)
else put (h x, y)
(x,y) <- get
put (f x, y)
(x,y) <- get
when (a y) (put (x, f y))
(x,y) <- get
when (b y) (put (g x, x))) (x,y)
This way, need for tag-tracking goes away, as well as the risk of accidentally using an outdated variable. But now the code is verbose and much harder to understand, mainly due to the repetition of (x,y) <- get.
So: what is a more readable, elegant and safe way to express this pattern?
Full code for testing.
Your goals
While the direct transformation of imperative code would usually lead to the ST monad and STRef, lets think about what you actually want to do:
You want to manipulate values conditionally.
You want to return that value.
You want to sequence the steps of your manipulation.
Requirements
Now this indeed looks first like the ST monad. However, if we follow the simple monad laws, together with do notation, we see that
do
x <- return $ if somePredicate x then g x
else h x
x <- return $ if someOtherPredicate x then a x
else b x
is exactly what you want. Since you need only the most basic functions of a monad (return and >>=), you can use the simplest:
The Identity monad
foo x y = runIdentity $ do
x <- return $ if a x then f x
else x
x <- return $ if c x then g x
else h x
x <- return $ f x
y <- return $ if a x then f y
else y
x <- return $ if b y then g x
else y
return (x,y)
Note that you cannot use let x = if a x then f x else x, because in this case the x would be the same on both sides, whereas
x <- return $ if a x then f x
else x
is the same as
(return $ if a x then (f x) else x) >>= \x -> ...
and the x in the if expression is clearly not the same as the resulting one, which is going to be used in the lambda on the right hand side.
Helpers
In order to make this more clear, you can add helpers like
condM :: Monad m => Bool -> a -> a -> m a
condM p a b = return $ if p then a else b
to get an even more concise version:
foo x y = runIdentity $ do
x <- condM (a x) (f x) x
x <- fmap f $ condM (c x) (g x) (h x)
y <- condM (a y) (f y) y
x <- condM (b y) (g x) x
return (x , y)
Ternary craziness
And while we're up to it, lets crank up the craziness and introduce a ternary operator:
(?) :: Bool -> (a, a) -> a
b ? ie = if b then fst ie else snd ie
(??) :: Monad m => Bool -> (a, a) -> m a
(??) p = return . (?) p
(#) :: a -> a -> (a, a)
(#) = (,)
infixr 2 ??
infixr 2 #
infixr 2 ?
foo x y = runIdentity $ do
x <- a x ?? f x # x
x <- fmap f $ c x ?? g x # h x
y <- a y ?? f y # y
x <- b y ?? g x # x
return (x , y)
But the bottomline is, that the Identity monad has everything you need for this task.
Imperative or non-imperative
One might argue whether this style is imperative. It's definitely a sequence of actions. But there's no state, unless you count the bound variables. However, then a pack of let … in … declarations also gives an implicit sequence: you expect the first let to bind first.
Using Identity is purely functional
Either way, the code above doesn't introduce mutability. x doesn't get modified, instead you have a new x or y shadowing the last one. This gets clear if you desugar the do expression as noted above:
foo x y = runIdentity $
a x ?? f x # x >>= \x ->
c x ?? g x # h x >>= \x ->
return (f x) >>= \x ->
a y ?? f y # y >>= \y ->
b y ?? g x # x >>= \x ->
return (x , y)
Getting rid of the simplest monad
However, if we would use (?) on the left hand side and remove the returns, we could replace (>>=) :: m a -> (a -> m b) -> m b) by something with type a -> (a -> b) -> b. This just happens to be flip ($). We end up with:
($>) :: a -> (a -> b) -> b
($>) = flip ($)
infixr 0 $> -- same infix as ($)
foo x y = a x ? f x # x $> \x ->
c x ? g x # h x $> \x ->
f x $> \x ->
a y ? f y # y $> \y ->
b y ? g x # x $> \x ->
(x, y)
This is very similar to the desugared do expression above. Note that any usage of Identity can be transformed into this style, and vice-versa.
The problem you state looks like a nice application for arrows:
import Control.Arrow
if' :: (a -> Bool) -> (a -> a) -> (a -> a) -> a -> a
if' p f g x = if p x then f x else g x
foo2 :: (Int,Int) -> (Int,Int)
foo2 = first (if' c g h . if' a f id) >>>
first f >>>
second (if' a f id) >>>
(\(x,y) -> (if b y then g x else x , y))
in particular, first lifts a function a -> b to (a,c) -> (b,c), which is more idiomatic.
Edit: if' allows a lift
import Control.Applicative (liftA3)
-- a functional if for lifting
if'' b x y = if b then x else y
if' :: (a -> Bool) -> (a -> a) -> (a -> a) -> a -> a
if' = liftA3 if''
I'd probably do something like this:
foo x y = ( x', y' )
where x' = bgf y' . cgh . af $ x
y' = af y
af z = (if a z then f else id) z
cgh z = (if c z then g else h) z
bg y x = (if b y then g else id) x
For something more complicated, you may want to consider using lens:
whenM :: Monad m => m Bool -> m () -> m ()
whenM c a = c >>= \res -> when res a
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM mb ml mr = mb >>= \b -> if b then ml else mr
foo :: Int -> Int -> (Int, Int)
foo = curry . execState $ do
whenM (uses _1 a) $
_1 %= f
ifM (uses _1 c)
(_1 %= g)
(_1 %= h)
_1 %= f
whenM (uses _2 a) $
_2 %= f
whenM (uses _2 b) $ do
_1 %= g
And there's nothing stopping you from using more descriptive variable names:
foo :: Int -> Int -> (Int, Int)
foo = curry . execState $ do
let x :: Lens (a, c) (b, c) a b
x = _1
y :: Lens (c, a) (c, b) a b
y = _2
whenM (uses x a) $
x %= f
ifM (uses x c)
(x %= g)
(x %= h)
x %= f
whenM (uses y a) $
y %= f
whenM (uses y b) $ do
x %= g
This is a job for the ST (state transformer) library.
ST provides:
Stateful computations in the form of the ST type. These look like ST s a for a computation that results in a value of type a, and may be run with runST to obtain a pure a value.
First-class mutable references in the form of the STRef type. The newSTRef a action creates a new STRef s a reference with an initial value of a, and which can be read with readSTRef ref and written with writeSTRef ref a. A single ST computation can use any number of STRef references internally.
Together, these let you express the same mutable variable functionality as in your imperative example.
To use ST and STRef, we need to import:
{-# LANGUAGE NoMonomorphismRestriction #-}
import Control.Monad.ST.Safe
import Data.STRef
Instead of using the low-level readSTRef and writeSTRef all over the place, we can define the following helpers to match the imperative operations that the Python-style foo example uses:
-- STRef assignment.
(=:) :: STRef s a -> ST s a -> ST s ()
ref =: x = writeSTRef ref =<< x
-- STRef function application.
($:) :: (a -> b) -> STRef s a -> ST s b
f $: ref = f `fmap` readSTRef ref
-- Postfix guard syntax.
if_ :: Monad m => m () -> m Bool -> m ()
action `if_` guard = act' =<< guard
where act' b = if b then action
else return ()
This lets us write:
ref =: x to assign the value of ST computation x to the STRef ref.
(f $: ref) to apply a pure function f to the STRef ref.
action `if_` guard to execute action only if guard results in True.
With these helpers in place, we can faithfully translate the original imperative definition of foo into Haskell:
a = (< 10)
b = even
c = odd
f x = x + 3
g x = x * 2
h x = x - 1
f3 x = x + 2
-- A stateful computation that takes two integer STRefs and result in a final [x,y].
fooST :: Integral n => STRef s n -> STRef s n -> ST s [n]
fooST x y = do
x =: (f $: x) `if_` (a $: x)
x' <- readSTRef x
if c x' then
x =: (g $: x)
else
x =: (h $: x)
x =: (f $: x)
y =: (f $: y) `if_` (a $: y)
x =: (g $: x) `if_` (b $: y)
sequence [readSTRef x, readSTRef y]
-- Pure wrapper: simply call fooST with two fresh references, and run it.
foo :: Integral n => n -> n -> [n]
foo x y = runST $ do
x' <- newSTRef x
y' <- newSTRef y
fooST x' y'
-- This will print "[9,3]".
main = print (foo 0 0)
Points to note:
Although we first had to define some syntactical helpers (=:, $:, if_) before translating foo, this demonstrates how you can use ST and STRef as a foundation to grow your own little imperative language that's directly suited to the problem at hand.
Syntax aside, this matches the structure of the original imperative definition exactly, without any error-prone restructuring. Any minor changes to the original example can be mirrored directly to Haskell. (The addition of the temporary x' <- readSTRef x binding in the Haskell code is only in order to use it with the native if/else syntax: if desired, this can be replaced with an appropriate ST-based if/else construct.)
The above code demonstrates giving both pure and stateful interfaces to the same computation: pure callers can use foo without knowing that it uses mutable state internally, while ST callers can directly use fooST (and for example provide it with existing STRefs to modify).
#Sibi said it best in his comment:
I would suggest you to stop thinking imperatively and rather think in a functional way. I agree that it will take some time to getting used to the new pattern, but try to translate imperative ideas to functional languages isn't a great approach.
Practically speaking, your chain of let can be a good starting point:
foo x0 y0 =
let x1 = if a x0 then f x0 else x0 in
let x2 = if c x1 then g x1 else h x1 in
let x3 = f x2 in
let y1 = if a y0 then f y0 else y0 in
let x4 = if b y1 then g x3 else x3 in
[x4,y1]
But I would suggest using a single let and giving descriptive names to the intermediate stages.
In this example unfortunately I don't have a clue what the various x's and y's do, so I cannot suggest meaningful names. In real code you would use names such as x_normalized, x_translated, or such, instead of x1 and x2, to describe what those values really are.
In fact, in a let or where you don't really have variables: they're just shorthand names you give to intermediate results, to make it easy to compose the final expression (the one after in or before the where.)
This is the spirit behind the x_bar and x_baz below. Try to come up with names that are reasonably descriptive, given the context of your code.
foo x y =
let x_bar = if a x then f x else x
x_baz = f if c x_bar then g x_bar else h x_bar
y_bar = if a y then f y else y
x_there = if b y_bar then g x_baz else x_baz
in [x_there, y_bar]
Then you can start recognizing patterns that were hidden in the imperative code. For example, x_bar and y_bar are basically the same transformation, applied respectively to x and y: that's why they have the same suffix "_bar" in this nonsensical example; then your x2 probably doesn't need an intermediate name , since you can just apply f to the result of the entire "if c then g else h".
Going on with the pattern recognition, you should factor out the transformations that you are applying to variables into sub-lambdas (or whatever you call the auxiliary functions defined in a where clause.)
Again, I don't have a clue what the original code did, so I cannot suggest meaningful names for the auxiliary functions. In a real application, f_if_a would be called normalize_if_needed or thaw_if_frozen or mow_if_overgrown... you get the idea:
foo x y =
let x_bar = f_if_a x
y_bar = f_if_a y
x_baz = f (g_if_c_else_h x_bar)
x_there = g_if_b x_baz y_bar
in [x_there, y_bar]
where
f_if_a x
| a x = f x
| otherwise = x
g_if_c_else_h x
| c x = g x
| otherwise = h x
g_if_b x y
| b y = g x
| otherwise = x
Don't disregard this naming business.
The whole point of Haskell and other pure functional languages is to express algorithms without the assignment operator, meaning the tool that can modify the value of an existing variable.
The names you give to things inside a function definition, whether introduced as arguments, let, or where, can only refer to one value (or auxiliary function) throughout the entire definition, so that your code can be more easily reasoned about and proven correct.
If you don't give them meaningful names (and conversely giving your code a meaningful structure) then you're missing out on the entire purpose of Haskell.
(IMHO the other answers so far, citing monads and other shenanigans, are barking up the wrong tree.)
I always prefer layering state transformers to using a single state over a tuple: it definitely declutters things by letting you "focus" on a specific layer (representations of the x and y variables in our case):
import Control.Monad.Trans.Class
import Control.Monad.Trans.State
foo :: x -> y -> (x, y)
foo x y =
(flip runState) y $ (flip execStateT) x $ do
get >>= \v -> when (a v) (put (f v))
get >>= \v -> put ((if c v then g else h) v)
modify f
lift $ get >>= \v -> when (a v) (put (f v))
lift get >>= \v -> when (b v) (modify g)
The lift function allows us to focus on the inner state layer, which is y.

Writing Category Instance for custom Lens

I have been reading this article for understanding Lenses. I know this is different from
Edward Knett's lens package, but nonetheless it's useful for fundamentals.
So, A Lens is defined like this:
type Lens a b = (a -> b, b -> a -> a)
It has been mentioned that Lenses form a category and I have been
trying out to create an instance for Category typeclass. For a start, I
wrote the type definition for the functions:
(.) :: Lens y z -> Lens x y -> Lens x z
id :: Lens x x
And after this, I just stare it for all day. What exactly is the
thought process for writing it's definition?
I found this article (Lenses from Scratch on fpcomplete by Joseph Abrahamson) to be very good, it starts from the same representation of lenses you started with, defines composition for it and continues along the path to a representation more similar to lens
EDIT: I find type holes to be excellent when doing this kind of things:
(<.>):: Lens y z -> Lens x y -> Lens x z
(getA,setA) <.> (getB,setB) = (_,_)
So now we have 2 holes, the first in the tuple says (output cleaned):
Found hole ‘_’ with type: x -> z
...
Relevant bindings include
setB :: y -> x -> x
getB :: x -> y
setA :: z -> y -> y
getA :: y -> z
(<.>) :: Lens y z -> Lens x y -> Lens x z
Looking hard at the bindings, we already have what we need! getB :: x -> y and getA :: y -> z together with function composition (.) :: (b -> c) -> (a -> b) -> a -> c
So we happily insert this:
(<.>):: Lens y z -> Lens x y -> Lens x z
(getA,setA) <.> (getB,setB) = (getA . getB, _)
And continue with the second type hole, which says:
Found hole ‘_’ with type: z -> x -> x
Relevant bindings include
setB :: y -> x -> x
getB :: x -> y
setA :: z -> y -> y
getA :: y -> z
The most similar thing we have is setA :: z -> y -> y, we start by inserting a lambda, capturing the arguments:
(getA,setA) <.> (getB,setB) = (getA . getB, \z x -> _)
changing your type hole to:
Found hole ‘_’ with type: x
Relevant bindings include
x :: x
z :: z
setB :: y -> x -> x
getB :: x -> y
setA :: z -> y -> y
getA :: y -> z
we could insert x which type checks, but does not give us what we want (nothing happens when setting). The only other binding that could give us an x is setB, so we insert that:
(getA,setA) <.> (getB,setB) = (getA . getB, \z x -> setB _ _)
Our first type hole says:
Found hole ‘_’ with type: y
Relevant bindings include
x :: x
z :: z
setB :: y -> x -> x
getB :: x -> y
setA :: z -> y -> y
getA :: y -> z
So we need an y, looking at what is in scope, getB can give us a y if we give it a x, which we happen to have, but this would lead us to a useless lens doing nothing again. The alternative is to use setA:
(getA,setA) <.> (getB,setB) = (getA . getB, \z x -> setB (setA _ _) _)
(Speeding things a little up from here on)
Again the first hole wants something of type z which he happen to have as an argument to our lambda:
(getA,setA) <.> (getB,setB) = (getA . getB, \z x -> setB (setA z _) _)
To fill the first type hole of type y we can use getB :: x -> y giving it the argument of our lambda:
(getA,setA) <.> (getB,setB) = (getA . getB, \z x -> setB (setA z (getB x)) _)
Which leaves us with one remaining type hole, which can trivially be replaced by x, leading to the final definition:
(<.>):: Lens y z -> Lens x y -> Lens x z
(getA,setA) <.> (getB,setB) = (getA . getB, \z x -> setB (setA z (getB x)) x)
You can try to define id for yourself, using type holes and hoogle if necessary
Try this:
(.) :: Lens y z -> Lens x y -> Lens x z
(getZfromY , setZinY) . (getYfromX , setYinX) = (getZfromX , setZinX)
where getZfromX someX = ...
setZinX someZ someX = ...
The idea is: combine the two getters to make the new getter, and combine the two setters to make a new setter.
For the identity, think about:
id :: Lens x x
id = (getXfromX , setXinX)
where getXfromX someX = ...
setXinX newX oldX = ...
It seems to be a fairly straighforward process. But also need to check that you get a category - this requires equational reasoning - because, for example, there is at least one more way to implement the setter of id with type x->x->x - only one of those will make a category.
So, let's start with getting functions of the right type.
Lens y z -> Lens x y -> Lens x z ==
(y->z, z->y->y) -> (x->y, y->x->x) -> (x->z, z->x->x)
It seems clear how to get x->z from x->y and y->z - compose. Well, and you have ways to construct new x from old x and new y, and a way to get old y from old x, so if you can construct new y from z and old y, you are done.
(.) (yz, zyy) (xy, yxx) = (yz . xy, \z x -> yxx (zyy z (xy x)) x)
Similarly for id:
Lens x x ==
(x->x, x->x->x)
So
id = (id, const)
So far so good, the types check. Now let's check that we've got a category. There is one law:
f . id = f = id . f
Checking one way (a bit informal, so need to bear in mind that . and id refer to different things in f . id and fg . id):
f . id = (fg, fs) . (id, const) =
(fg . id, \z x -> const (fs z (id x)) x) =
(fg, \z x -> fs z (id x)) = (fg, fs)
Checking the other way:
id . f = (id, const) . (fg, fs) =
(id . fg, \z x -> fs (const z (fg x)) x) =
(fg, \z x -> fs z x) = (fg, fs)

Resources