Send Beginners mailing list submissions to
        beginners@haskell.org

To subscribe or unsubscribe via the World Wide Web, visit
        http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
or, via email, send a message with subject or body 'help' to
        beginners-requ...@haskell.org

You can reach the person managing the list at
        beginners-ow...@haskell.org

When replying, please edit your Subject line so it is more specific
than "Re: Contents of Beginners digest..."


Today's Topics:

   1.  How works this `do` example? (Baa)
   2. Re:  How works this `do` example? (Francesco Ariis)
   3. Re:  How works this `do` example? (Baa)


----------------------------------------------------------------------

Message: 1
Date: Thu, 13 Jul 2017 11:29:56 +0300
From: Baa <aqua...@gmail.com>
To: The Haskell-Beginners Mailing List - Discussion of primarily
        beginner-level topics related to Haskell <beginners@haskell.org>
Subject: [Haskell-beginners] How works this `do` example?
Message-ID: <20170713112956.15426e6c@Pavel>
Content-Type: text/plain; charset=US-ASCII

Hello, Dear List!

Consider, I have:

  request1 :: A -> Connection -> IO ()
  request2 :: A -> Connection -> IO A

How does it work -

  resp <- getConnection
    >>= do request1 myA
           request2 anotherA

?!

It is compiled but seems that does not execute `request1`...

`request1 myA` gets `Connection` value, good. But it does not return
`IO Connection`! It returns `IO ()`. But how does `request2 anotherA`
get `Connection` value too? Because this is not compiled sure:

  resp <- getConnection
    >>= request1 myA >>= request2 anotherA

I tried this:

    module Main where

    f1 :: Int -> IO ()
    f1 i = do
      print "f1!"
      print i
      return ()

    f2 :: Int -> IO Int
    f2 i = do
      print "f2!"
      print i
      return i

    f0 :: IO Int
    f0 = pure 10

    main :: IO ()
    main = f0
      >>= do f1
             f2
      >> print "end"

and I get output:

    "f2!"
    10
    "end"

which means that `f1` is not executing in `do..`-block, but how does `f2` get 
10 as input?!


==
Cheers,
  Paul


------------------------------

Message: 2
Date: Thu, 13 Jul 2017 11:06:13 +0200
From: Francesco Ariis <fa...@ariis.it>
To: beginners@haskell.org
Subject: Re: [Haskell-beginners] How works this `do` example?
Message-ID: <20170713090613.gx7nqemp5xyln...@x60s.casa>
Content-Type: text/plain; charset=utf-8

On Thu, Jul 13, 2017 at 11:29:56AM +0300, Baa wrote:
>     main :: IO ()
>     main = f0
>       >>= do f1
>              f2
>       >> print "end"
> 
> and I get output:
> 
>     "f2!"
>     10
>     "end"

Hello Paul, your `main` desugars to

    main = f0 >>= (f1 >> f2) >> print "end"

Now, the quizzical part is

    λ> :t (f1 >> f2)
    (f1 >> f2) :: Int -> IO Int

Why does this even type checks? Because:

    λ> :i (->)
    [..]
    instance Monad ((->) r) -- Defined in ‘GHC.Base’
    [..]

((->) r) is an instance of Monad! The instance is:

    instance Monad ((->) r) where
        f >>= k = \r -> k (f r) r

you already know that `m >> k` is defined as `m >>= \_ -> k`, so

        f >> k = \r -> (\_ -> k) (f r) r
               = \r -> k r

Is it clear enough?


------------------------------

Message: 3
Date: Thu, 13 Jul 2017 12:41:49 +0300
From: Baa <aqua...@gmail.com>
To: beginners@haskell.org
Subject: Re: [Haskell-beginners] How works this `do` example?
Message-ID: <20170713124149.069163e2@Pavel>
Content-Type: text/plain; charset=UTF-8

I suspected that it was in Read monad, but I don't see where is it this
"Read" monad here :)  Francesco, thank you very much!!

Absolutely clear :)


В Thu, 13 Jul 2017 11:06:13 +0200
Francesco Ariis <fa...@ariis.it> wrote:

> On Thu, Jul 13, 2017 at 11:29:56AM +0300, Baa wrote:
> >     main :: IO ()
> >     main = f0  
> >       >>= do f1  
> >              f2  
> >       >> print "end"  
> > 
> > and I get output:
> > 
> >     "f2!"
> >     10
> >     "end"  
> 
> Hello Paul, your `main` desugars to
> 
>     main = f0 >>= (f1 >> f2) >> print "end"
> 
> Now, the quizzical part is
> 
>     λ> :t (f1 >> f2)  
>     (f1 >> f2) :: Int -> IO Int
> 
> Why does this even type checks? Because:
> 
>     λ> :i (->)  
>     [..]
>     instance Monad ((->) r) -- Defined in ‘GHC.Base’
>     [..]
> 
> ((->) r) is an instance of Monad! The instance is:
> 
>     instance Monad ((->) r) where
>         f >>= k = \r -> k (f r) r
> 
> you already know that `m >> k` is defined as `m >>= \_ -> k`, so
> 
>         f >> k = \r -> (\_ -> k) (f r) r
>                = \r -> k r
> 
> Is it clear enough?
> _______________________________________________
> Beginners mailing list
> Beginners@haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners



------------------------------

Subject: Digest Footer

_______________________________________________
Beginners mailing list
Beginners@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners


------------------------------

End of Beginners Digest, Vol 109, Issue 15
******************************************

Reply via email to