[Haskell-cafe] Re: ANNOUNCE: GotoT-transformers version 1.0

Gregory Crosswhite gcross at phys.washington.edu
Sat Sep 11 21:38:38 EDT 2010


  Okay, where that unpost button when I need it...  :-)

So, I hadn't noticed that the script that I copied and pasted didn't 
even compile because I was pressing "up enter" at the console to run it, 
but had forgotten that I was now working with a script with a new name 
and so all I was doing was running a different script over and over 
again!  Doh.  :-)

Anyway, okay, I see your point now.  The following script *does* work.

   import Data.List

   import Control.Monad
   import Control.Monad.IO.Class
   import Control.Monad.Trans.Cont

    goto :: Monad m => ContT r m r -> ContT r m a
    goto (ContT m) = ContT $ \_ -> m return

   myComp :: ContT () IO ()
   myComp = do
     input <- liftIO $ putStrLn "Print something (y/n)?" >> getLine
     unless ("y" `isPrefixOf` input) $ goto exit
     liftIO $ putStrLn "Something."

     input <- liftIO $ putStrLn "Print more (y/n)?" >> getLine
     unless ("y" `isPrefixOf` input) $ goto exit
     liftIO $ putStrLn "More."

     where
       exit = do
         liftIO $ putStrLn "Ok, I'm exiting."
         return ()

    main :: IO ()
    main = runContT myComp return

*HOWEVER*, if we replace main with

     main = runContT myComp (const $ putStrLn "I can't wait to print 
this string!")

Then the program will be eternally disappointed because it will never 
actually get to print that string at the end.

On 9/11/10 6:16 PM, Gregory Crosswhite wrote:
>
>> To recover from my overly complex previous post, here is a much simply
>> goto based on existing monad transformers:
>>
>>> goto :: Monad m =>  ContT r m r ->  ContT r m a
>>> goto (ContT m) = ContT $ \_ ->
>>>                 m return
>>
>
> That doesn't actually work, though.  Try running the following script:
>
> import Data.List
>
> import MonadLib
>
> goto :: Monad m => ContT r m r -> ContT r m a
> goto (ContT m) = ContT $ \_ -> m return
>
> myComp :: ContT () IO ()
> myComp = do
>     input <- inBase $ putStrLn "Print something (y/n)?" >> getLine
>     unless ("y" `isPrefixOf` input) $ goto exit
>     inBase $ putStrLn "Something."
>
>     input <- inBase $ putStrLn "Print more (y/n)?" >> getLine
>     unless ("y" `isPrefixOf` input) $ goto exit
>     inBase $ putStrLn "More."
>
>     where
>       exit = do
>         inBase $ putStrLn "Ok, I'm exiting."
>         return ()
>
> main :: IO ()
> main = runContT return myComp
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe



More information about the Haskell-Cafe mailing list