cont.hs

import Control.Monad.Cont
import Control.Monad.Except
import Control.Concurrent

type Promise a =
  ContT () (ExceptT String IO) a

run :: Promise a -> (a -> IO ()) -> IO ()
run (ContT x) h =
  either putStrLn return =<< runExceptT (x (liftIO . h))

father :: String -> Promise String
father name = ContT (\resolve -> do
  -- fake a request
  liftIO (threadDelay (1000 * 1000))
  case name of
    "Bob"  -> resolve "Joe"
    "Joe"  -> resolve "Phil"
    "Phil" -> resolve "Eric"
    _ -> throwError "Not in database"
  return ())

grandFather p = do
  f <- father p
  g <- father f
  return g