Forgot to post the list :(

On Wed, Dec 9, 2009 at 10:40 PM, legajid <legajid@free.fr> wrote:
Hello,
i wrote the following (very simplified) program :

word :: [Char]
word="initial"
letters=['a'..'z']

myloop = do
 myloop2

myloop2 = do
 putStrLn word
 putStrLn letters

main = do
     putStrLn "Enter the word"
     word <- enter_word
     myloop
enter_word= do
  return("abcdefghij")

Remind that a haskell function depends only on its parameters. Unless you use an unsafe trick, often frowned upon, mutable global variables don't exist.

So normally you have to modify your functions to pass the string as a parameter. While it may seem tedious at first, perhaps you will realise that having the type signature mention that you need a string is a precious information. Also, start by modifying only myloop2, ghc will complain about every function that use the new myloop2 the wrong way, so refactoring is not that hard.

In the case you have a more complicated program where state is an important part, you can use the State monad, or more specifically in your example a State transformer that uses IO as the underlying monad. Your program would look like : ( you can copy and paste this in a source file, then play with it in ghci )

module Main where

import Control.Monad.State


word :: [Char]
word="initial"
letters=['a'..'z']

myloop = do
 myloop2

myloop2 =  do
  word <- get  -- récupère l'état.
  liftIO $ do
    putStrLn word
    putStrLn letters

main = runStateT mafonction word

mafonction = do
     liftIO $ putStrLn "Enter the word"
     w <- enter_word
     put w           -- enregistre l'état

     myloop

enter_word= do
  return("abcdefghij")

Note how the myloop function wasn't modified. On the other hand, have a look at the type signatures using ghci. Your function now is in the StateT String IO monad. So that's why every time you use IO you have to use liftIO to reach the underlying IO monad.  So there's still some rewriting.

David.