iworld_v4.hs

import System.IO.Unsafe


data CWorld = CWorld {
    cin :: String,
    cout :: String
}

newtype CWIO a = CWIO { unCWIO :: CWorld -> (a, CWorld) }

instance Monad CWIO where
    action1 >>= action2 = CWIO $ \w0 ->
        let (x1, w1) = (unCWIO action1) w0
            (x2, w2) = (unCWIO $ action2 x1) w1
        in  (x2, w2)
    return a = CWIO $ \world -> (a, world)


cwWrite :: String -> CWIO ()
cwWrite str = CWIO $ \(CWorld cin cout0) ->
    ((), CWorld cin (cout0 ++ "~ " ++ str ++ "\n"))

cwWrite_really :: String -> CWIO ()
cwWrite_really str = CWIO $ \(CWorld cin cout0) ->
    unsafePerformIO $ do
        putStrLn str
        return ((), CWorld cin (cout0 ++ "~ " ++ str ++ "\n"))


cwRead :: CWIO String
cwRead = CWIO $ \(CWorld cin0 cout) ->
    (cin0, CWorld "" cout)

cwUserInput :: String -> CWIO ()
cwUserInput str = CWIO $ \(CWorld cin0 cout0) ->
    ((), CWorld str (cout0 ++ "~ " ++ str ++ "\n"))

cwRead_really :: CWIO String
cwRead_really = CWIO $ \(CWorld cin0 cout0) ->
    unsafePerformIO $ do
        input <- getLine
        return (input, CWorld "" (cout0 ++ "~ " ++ input ++ "\n"))


cwMain :: CWIO String
--cwMain =
--    (cwWrite "What's your name?") >>
--    (cwUserInput "John") >>
--    cwRead >>= (\name ->
--    cwWrite $ "Hello " ++ name ++ "!") >>
--    (return "42")
cwMain = do
    cwWrite "What's your name?"
    cwUserInput "John"
    name <- cwRead
    cwWrite $ "Hello " ++ name ++ "!"
    return "42"


cwMain_really :: CWIO String
--cwMain_really =
--    (cwWrite_really "What's your name?") >>
--    cwRead_really >>= (\name ->
--    cwWrite_really $ "Hello " ++ name ++ "!") >>
--    (return "fourtytwo")
cwMain_really = do
    cwWrite_really "What's your name?"
    name <- cwRead_really
    cwWrite_really $ "Hello " ++ name ++ "!"
    return "fourtytwo"


main = do
    putStr (cout cworld_a)
    putStrLn $ "...and the a answer is: " ++ a
    putStr (cout cworld_b)
    putStrLn $ "...and the b answer is: " ++ b
    x <- return "XX"
    putStrLn $ "...and x is: " ++ x
    let y = "YY" in
        putStrLn $ "...and y is: " ++ y
    where
        (a, cworld_a) = unCWIO cwMain $ CWorld "" ""
        (b, cworld_b) = unCWIO cwMain_really $ CWorld "" ""