iworld_v4.hs

import System.IO.Unsafe


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

type CWIO a = CWorld -> (a, CWorld)


-- TODO: figure out a way to make this work

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


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

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


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

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

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


-- Bind & Return

--bind :: (CWorld -> (a, CWorld))
--    -> (a -> CWorld -> (b, CWorld))
--    -> (CWorld -> (b, CWorld))
bind :: CWIO a -> (a -> CWIO b) -> CWIO b
bind action1 action2 w0 =
    let (x1, w1) = action1 w0
        (x2, w2) = action2 x1 w1
    in  (x2, w2)

--blindBind :: (CWorld -> (a, CWorld))
--    -> (CWorld -> (b, CWorld))
--    -> (CWorld -> (b, CWorld))
blindBind :: CWIO a -> CWIO b -> CWIO b
blindBind action1 action2 =
    bind action1 (\_ -> action2)

--cwReturn :: a -> CWorld -> (a, CWorld)
cwReturn :: a -> CWIO a
cwReturn a = \world -> (a, world)


--cwMain :: CWorld -> (String, CWorld)
cwMain :: CWIO String
cwMain =
    (cwWrite "What's your name?") `blindBind`
    (cwUserInput "John") `blindBind`
    cwRead `bind` (\name ->
    cwWrite $ "Hello " ++ name ++ "!") `blindBind`
    cwReturn "42"


--cwMain_really :: CWorld -> (String, CWorld)
cwMain_really :: CWIO String
cwMain_really =
    (cwWrite_really "What's your name?") `blindBind`
    cwRead_really `bind` (\name ->
    cwWrite_really $ "Hello " ++ name ++ "!") `blindBind`
    (cwReturn "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
    where
        (a, cworld_a) = cwMain (CWorld "" "")
        (b, cworld_b) = cwMain_really (CWorld "" "")