What Does Graham Hutton Mean by Effect

Hi Everyone, I am reading the 2nd edition of Graham Hutton's Programming in Haskell. I'm not reading the entire book, just the parts of Haskell that I am still iffy on. Anyway, in Chapter 12, Section 3, Hutton introduces monads. He start off with the following code: first module Expr wheredata Expr = Val Int | Div Expr Expreval :: Expr -> Inteval (Val n) = neval (Div el er) = eval el `div` eval er Not using Mixmax yet? And then he points out that the second clause of eval will raise an error if eval er evaluates to 0. One solution is that, instead of using the div function, we use a safeDiv:: Int -> Int -> Maybe Int function, which evaluate to Nothing if the divisor is 0. This means that expr's type changes from eval :: Eval -> Int to eval :: Eval -> Maybe Int, and this means that implementing eval becomes very verbose: second module Expr wheredata Expr = Val Int | Div Expr Expreval :: Expr -> Maybe Inteval (Val n) = Just neval (Div el er) = case eval el of Nothing -> Nothing Just y -> case eval er of Nothing -> Nothing Just x -> y `safeDiv` xsafeDiv :: Int -> Int -> Maybe IntsafeDiv x y | y == 0 = Nothing | otherwise = Just (x `div` y) Not using Mixmax yet? In order to make eval more concise, we can try the applicative style, where the second clause of the eval function becomes pure safeDiv <*> eval el <*> eval er. Of course, that doesn't work because pure safeDiv has the type Int -> Int -> Maybe Int, and what we need is a function of type Int -> Int -> Int. Anyways, this is all setup / context to what Hutton says next: The conclusion is that the function eval does not fit the pattern of effectful programming that is capture by applicative functors. The applicative style restricts us to applying pure functions to effectful arguments: eval does not fit this pattern because the function safeDiv that is used to process the resulting values is not a pure function, but may itself fail. I am confused by Hutton's use of the word effectful and by his description of safeDiv as "not a pure function". I tried skimming the other sections of the book to see if he provided a definition of this somewhere, but if he did, I couldn't find it. So my question is, in what way does Hutton mean for the reader to understand the words effect / effectful, and why does he describe the function safeDiv as not a pure function? Thank you! Steven Leiva 305.528.6038 leiva.steven@gmail.com http://www.linkedin.com/in/stevenleiva

Sorry - for correctness's sake, I meant to say that pure safeDiv :: Maybe (Int -> Int -> Maybe Int). On Mon, Oct 30, 2017 9:49 PM, Steven Leiva leiva.steven@gmail.com wrote: Hi Everyone, I am reading the 2nd edition of Graham Hutton's Programming in Haskell. I'm not reading the entire book, just the parts of Haskell that I am still iffy on. Anyway, in Chapter 12, Section 3, Hutton introduces monads. He start off with the following code: first module Expr wheredata Expr = Val Int | Div Expr Expreval :: Expr -> Inteval (Val n) = neval (Div el er) = eval el `div` eval er Not using Mixmax yet? And then he points out that the second clause of eval will raise an error if eval er evaluates to 0. One solution is that, instead of using the div function, we use a safeDiv:: Int -> Int -> Maybe Int function, which evaluate to Nothing if the divisor is 0. This means that expr's type changes from eval :: Eval -> Int to eval :: Eval -> Maybe Int, and this means that implementing eval becomes very verbose: second module Expr wheredata Expr = Val Int | Div Expr Expreval :: Expr -> Maybe Inteval (Val n) = Just neval (Div el er) = case eval el of Nothing -> Nothing Just y -> case eval er of Nothing -> Nothing Just x -> y `safeDiv` xsafeDiv :: Int -> Int -> Maybe IntsafeDiv x y | y == 0 = Nothing | otherwise = Just (x `div` y) Not using Mixmax yet? In order to make eval more concise, we can try the applicative style, where the second clause of the eval function becomes pure safeDiv <*> eval el <*> eval er. Of course, that doesn't work because pure safeDiv has the type Int -> Int -> Maybe Int, and what we need is a function of type Int -> Int -> Int. Anyways, this is all setup / context to what Hutton says next: The conclusion is that the function eval does not fit the pattern of effectful programming that is capture by applicative functors. The applicative style restricts us to applying pure functions to effectful arguments: eval does not fit this pattern because the function safeDiv that is used to process the resulting values is not a pure function, but may itself fail. I am confused by Hutton's use of the word effectful and by his description of safeDiv as "not a pure function". I tried skimming the other sections of the book to see if he provided a definition of this somewhere, but if he did, I couldn't find it. So my question is, in what way does Hutton mean for the reader to understand the words effect / effectful, and why does he describe the function safeDiv as not a pure function? Thank you! Steven Leiva 305.528.6038 leiva.steven@gmail.com http://www.linkedin.com/in/stevenleiva Steven Leiva 305.528.6038 leiva.steven@gmail.com http://www.linkedin.com/in/stevenleiva

In this specific case it is actually pure, because Maybe is pure, but in
the general case it behaves with respect to Applicative (and Monad, which
this appears to be leading up to) as effectful. In this context, an effect
is just whatever behavior is captured by the Applicative/Monad.
"purity" is a bit overloaded:
- purity with respect to an effect of some unspecified kind, as here;
- purity with respect to IO which encapsulates behavior not contained
specifically within your program, the most common meaning in Haskell;
- purity with respect to cross-thread effects in IO/STM;
- purity with respect to mutability in ST;
....
On Mon, Oct 30, 2017 at 9:49 PM, Steven Leiva
Hi Everyone,
I am reading the 2nd edition of Graham Hutton's Programming in Haskell. I'm not reading the entire book, just the parts of Haskell that I am still iffy on.
Anyway, in Chapter 12, Section 3, Hutton introduces monads.
He start off with the following code:
first
module Expr where data Expr = Val Int | Div Expr Expr eval :: Expr -> Int eval (Val n) = n eval (Div el er) = eval el `div` eval er
[image: Mixmax] https://mixmax.com/r/59ec918e83319a2a077ff18c Not using Mixmax yet? https://mixmax.com/r/59ec918e83319a2a077ff18c
And then he points out that the second clause of *eval* will raise an error if *eval er* evaluates to 0.
One solution is that, instead of using the *div* function, we use a *safeDiv* *:: Int -> Int -> Maybe Int* function, which evaluate to *Nothing* if the divisor is 0. This means that *expr*'s type changes from *eval :: Eval -> Int* to *eval :: Eval -> Maybe Int*, and this means that implementing *eval* becomes very verbose:
second
module Expr where data Expr = Val Int | Div Expr Expr eval :: Expr -> Maybe Int eval (Val n) = Just n eval (Div el er) = case eval el of Nothing -> Nothing Just y -> case eval er of Nothing -> Nothing Just x -> y `safeDiv` x safeDiv :: Int -> Int -> Maybe Int safeDiv x y | y == 0 = Nothing | otherwise = Just (x `div` y)
[image: Mixmax] https://mixmax.com/r/59ec918e83319a2a077ff18c Not using Mixmax yet? https://mixmax.com/r/59ec918e83319a2a077ff18c
In order to make *eval* more concise, we can try the applicative style, where the second clause of the *eval* function becomes *pure safeDiv <*> eval el <*> eval er*. Of course, that doesn't work because *pure safeDiv* has the type *Int -> Int -> Maybe Int*, and what we need is a function of type *Int -> Int -> Int*.
Anyways, this is all setup / context to what Hutton says next:
*The conclusion is that the function eval does not fit the pattern of effectful programming that is capture by applicative functors. The applicative style restricts us to applying pure functions to effectful arguments: eval does not fit this pattern because the function safeDiv that is used to process the resulting values is not a pure function, but may itself fail. *
I am confused by Hutton's use of the word effectful and by his description of safeDiv as "not a pure function". I tried skimming the other sections of the book to see if he provided a definition of this somewhere, but if he did, I couldn't find it. So my question is, in what way does Hutton mean for the reader to understand the words effect / effectful, and why does he describe the function safeDiv as not a pure function?
Thank you!
Steven Leiva 305.528.6038 <(305)%20528-6038> leiva.steven@gmail.com http://www.linkedin.com/in/stevenleiva
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
-- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net

Hello Again Brandon,
Thank you for the explanation. I'll have to mull it over a bit to let it sink
in. I am finding the overloading of purity to be easier to grasp than the
meaning of effect. I think the reason for that is precisely because it depends
on the context (generally speaking) in which it is being used. For example, in
the case of Maybe, the effect is possible failure. In the case of lists, the
effect is non-determinism, etc.
On Mon, Oct 30, 2017 10:02 PM, Brandon Allbery allbery.b@gmail.com wrote:
In this specific case it is actually pure, because Maybe is pure, but in the
general case it behaves with respect to Applicative (and Monad, which this
appears to be leading up to) as effectful. In this context, an effect is just
whatever behavior is captured by the Applicative/Monad.
"purity" is a bit overloaded:
- purity with respect to an effect of some unspecified kind, as here;
- purity with respect to IO which encapsulates behavior not contained
specifically within your program, the most common meaning in Haskell;
- purity with respect to cross-thread effects in IO/STM;
- purity with respect to mutability in ST;
....
On Mon, Oct 30, 2017 at 9:49 PM, Steven Leiva

The meaning of "pure", and the meaning of "effect" are closely intertwined,
because essentially, "pure" (in this usage) means "not having any effects",
and "effect" means "the part of the function result that isn't pure". If
what you have in your mind is a function `div :: Int -> Int -> Int`, and
instead have to settle for `div :: Int -> Int -> Maybe Int`, they you could
consider the first the type it should have "if it were pure", and call the
Maybe type "an effect". The words are relative to your starting assumption
of what type div should have, though. As you mention, you could also quite
reasonably admit that `Maybe Int` is a perfectly good type on its own, and
consider `safeDiv` to be a pure function with this type as a codomain.
You can even pull the same trick with more powerful effects. The type `IO
Int` is a (more or less) defined type, and its values are ACTIONS that your
computer could take, which if they don't fail return an Int. From this
perspective, even a function like `readFile :: FilePath -> IO ByteString`
is a "pure" function, which maps file paths to actions. But if you
consider it as a map from file paths to bytestrings, then it is effectful.
Again, these words are defined relative to what you consider the result to
be. (I'm ignoring, here, some questions about what the correct semantics
for IO types even is...)
If you want a more formal (but less intuitive) way to think about this,
then you can turn to category theory. In category theory, a monad (say, F)
is an endofunctor in some category -- for us, typically the category of
Haskell types and functions. But F also defines a SECOND category, called
the Kleisli category of F: the set of types here the same, but a "Kleisli
arrow" between two objects A and B is a function A -> F B in the base
category. Notice that any Kleisli arrow IS an arrow in the base category,
so in that sense you could claim that it's "pure". But IF you choose to
think about it as an arrow from A to B, THEN you must be talking about the
Kleisli category, and it has an effect captured by F. If that wasn't what
you were looking for, though, feel free to ignore it.
On Mon, Oct 30, 2017 at 7:11 PM, Steven Leiva
Hello Again Brandon,
Thank you for the explanation. I'll have to mull it over a bit to let it sink in. I am finding the overloading of purity to be easier to grasp than the meaning of effect. I think the reason for that is precisely because it depends on the context (generally speaking) in which it is being used. For example, in the case of Maybe, the effect is possible failure. In the case of lists, the effect is non-determinism, etc.
On Mon, Oct 30, 2017 10:02 PM, Brandon Allbery allbery.b@gmail.com wrote:
In this specific case it is actually pure, because Maybe is pure, but in the general case it behaves with respect to Applicative (and Monad, which this appears to be leading up to) as effectful. In this context, an effect is just whatever behavior is captured by the Applicative/Monad.
"purity" is a bit overloaded:
- purity with respect to an effect of some unspecified kind, as here;
- purity with respect to IO which encapsulates behavior not contained specifically within your program, the most common meaning in Haskell;
- purity with respect to cross-thread effects in IO/STM;
- purity with respect to mutability in ST;
....
On Mon, Oct 30, 2017 at 9:49 PM, Steven Leiva
wrote: Hi Everyone,
I am reading the 2nd edition of Graham Hutton's Programming in Haskell. I'm not reading the entire book, just the parts of Haskell that I am still iffy on.
Anyway, in Chapter 12, Section 3, Hutton introduces monads.
He start off with the following code:
first
module Expr where data Expr = Val Int | Div Expr Expr eval :: Expr -> Int eval (Val n) = n eval (Div el er) = eval el `div` eval er
[image: Mixmax] https://mixmax.com/r/59ec918e83319a2a077ff18c Not using Mixmax yet? https://mixmax.com/r/59ec918e83319a2a077ff18c
And then he points out that the second clause of *eval* will raise an error if *eval er* evaluates to 0.
One solution is that, instead of using the *div* function, we use a *safeDiv* *:: Int -> Int -> Maybe Int* function, which evaluate to *Nothing* if the divisor is 0. This means that *expr*'s type changes from *eval :: Eval -> Int* to *eval :: Eval -> Maybe Int*, and this means that implementing *eval* becomes very verbose:
second
module Expr where data Expr = Val Int | Div Expr Expr eval :: Expr -> Maybe Int eval (Val n) = Just n eval (Div el er) = case eval el of Nothing -> Nothing Just y -> case eval er of Nothing -> Nothing Just x -> y `safeDiv` x safeDiv :: Int -> Int -> Maybe Int safeDiv x y | y == 0 = Nothing | otherwise = Just (x `div` y)
[image: Mixmax] https://mixmax.com/r/59ec918e83319a2a077ff18c Not using Mixmax yet? https://mixmax.com/r/59ec918e83319a2a077ff18c
In order to make *eval* more concise, we can try the applicative style, where the second clause of the *eval* function becomes *pure safeDiv <*> eval el <*> eval er*. Of course, that doesn't work because *pure safeDiv* has the type *Int -> Int -> Maybe Int*, and what we need is a function of type *Int -> Int -> Int*.
Anyways, this is all setup / context to what Hutton says next:
*The conclusion is that the function eval does not fit the pattern of effectful programming that is capture by applicative functors. The applicative style restricts us to applying pure functions to effectful arguments: eval does not fit this pattern because the function safeDiv that is used to process the resulting values is not a pure function, but may itself fail. *
I am confused by Hutton's use of the word effectful and by his description of safeDiv as "not a pure function". I tried skimming the other sections of the book to see if he provided a definition of this somewhere, but if he did, I couldn't find it. So my question is, in what way does Hutton mean for the reader to understand the words effect / effectful, and why does he describe the function safeDiv as not a pure function?
Thank you!
Steven Leiva 305.528.6038 <(305)%20528-6038> leiva.steven@gmail.com http://www.linkedin.com/in/stevenleiva
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
-- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net
Steven Leiva 305.528.6038 <(305)%20528-6038> leiva.steven@gmail.com http://www.linkedin.com/in/stevenleiva
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.

Thank you Chris. The idea that "effect" and "pure" are relative to something,
as you mentioned, helped this click for me.
On Mon, Oct 30, 2017 11:08 PM, Chris Smith cdsmith@gmail.com wrote:
The meaning of "pure", and the meaning of "effect" are closely intertwined,
because essentially, "pure" (in this usage) means "not having any effects", and
"effect" means "the part of the function result that isn't pure". If what you
have in your mind is a function `div :: Int -> Int -> Int`, and instead have to
settle for `div :: Int -> Int -> Maybe Int`, they you could consider the first
the type it should have "if it were pure", and call the Maybe type "an effect".
The words are relative to your starting assumption of what type div should have,
though. As you mention, you could also quite reasonably admit that `Maybe Int`
is a perfectly good type on its own, and consider `safeDiv` to be a pure
function with this type as a codomain.
You can even pull the same trick with more powerful effects. The type `IO Int`
is a (more or less) defined type, and its values are ACTIONS that your computer
could take, which if they don't fail return an Int. From this perspective, even
a function like `readFile :: FilePath -> IO ByteString` is a "pure" function,
which maps file paths to actions. But if you consider it as a map from file
paths to bytestrings, then it is effectful. Again, these words are defined
relative to what you consider the result to be. (I'm ignoring, here, some
questions about what the correct semantics for IO types even is...)
If you want a more formal (but less intuitive) way to think about this, then you
can turn to category theory. In category theory, a monad (say, F) is an
endofunctor in some category -- for us, typically the category of Haskell types
and functions. But F also defines a SECOND category, called the Kleisli
category of F: the set of types here the same, but a "Kleisli arrow" between two
objects A and B is a function A -> F B in the base category. Notice that any
Kleisli arrow IS an arrow in the base category, so in that sense you could claim
that it's "pure". But IF you choose to think about it as an arrow from A to B,
THEN you must be talking about the Kleisli category, and it has an effect
captured by F. If that wasn't what you were looking for, though, feel free to
ignore it.
On Mon, Oct 30, 2017 at 7:11 PM, Steven Leiva
participants (3)
-
Brandon Allbery
-
Chris Smith
-
Steven Leiva