ContinuationMonad.hs

data Data = Data
    { dataID :: Int
    , dataName :: String
    , dataUrl :: String
    } deriving (Show)

-- save :: Data -> (Data -> IO ()) -> IO ()
-- save dat cont = do
--     print dat
--     cont (dat {dataID = 123, dataUrl = "/user/123"})

-- load :: String -> (Data -> IO ()) -> IO ()
-- load url cont = do
--     cont (Data 1 "hoge" url)


-- main :: IO ()
-- main = do
--     let d = Data 0 "x" "/user"
--     save d (\d' ->
--         load (dataUrl d') (\d'' ->
--             save d'' (\_ -> return ())))

newtype Cont r a = Cont {runCont :: (a -> r) -> r}

instance Monad (Cont r) where
    return x = Cont $ \c -> c x
    (Cont cont) >>= f = Cont $ \c -> cont $ (\x -> runCont (f x) c)

save :: Data -> Cont (IO ()) Data
save dat = Cont $ (\cont -> do
            print dat
            cont (dat {dataID = 123, dataUrl = "/user/123"}))

load :: String -> Cont (IO ()) Data
load url = Cont $ (\cont -> do
            cont (Data 1 "hoge" url))


-- main :: IO ()
-- main = do
--     let d = Data 0 "x" "/user"
--         (Cont cont) = save d
--     cont (\d' ->
--         let (Cont cont') = load (dataUrl d')
--         in
--         cont' (\d'' ->
--             let (Cont cont'') = save d''
--             in
--             cont'' (\_ -> return ())))

main :: IO ()
main = do
    let d = Data 0 "x" "/user"
    let cont = save d >>= (\d' ->
                load (dataUrl d') >>= (\d'' ->
                save d''))
    runCont cont $ \_ -> return ()
    -- let cont = do
    --     d' <- save d
    --     d'' <- load $ dataUrl d'
    --     save d''
    -- runCont cont $ \_ -> return ()