Evil Promises
module Main where
{-
Warning: This is not an example of something you should ever do.
This is an academic excercise to scratch an itch.
Every single line of this file is morally wrong and violates all that
is good and holy in the world.
-}
import Data.IORef
import Data.Maybe(isJust)
import Control.Applicative
import Control.Monad
data Promise a = Promise
{ observers :: IORef [a -> IO ()]
, value :: IORef (Maybe a)
}
mkPromise = Promise <$> (newIORef []) <*> (newIORef Nothing)
(#) = flip ($)
(<<-) = writeIORef
fromJust (Just a) = a
pResolve :: Promise a -> a -> IO ()
pResolve promise v = do
promise # value <<- Just v
obs <- readIORef (promise #observers)
forM_ obs (\fn -> fn v)
pOnSuccess :: Promise a -> (a -> IO ()) -> IO ()
pOnSuccess promise fn = do
v <- readIORef (promise #value)
if (isJust v) then
fn (fromJust v)
else
modifyIORef (observers promise) (\xs -> fn : xs)
pMap :: Promise a -> (a -> b) -> IO (Promise b)
pMap promise fn = do
p <- mkPromise
promise `pOnSuccess` (\result ->
pResolve p (fn result)
)
return p
pBind :: Promise a -> (a -> Promise b) -> IO (Promise b)
pBind promise fn = do
p <- mkPromise
promise `pOnSuccess` (\result -> (fn result) `pOnSuccess` (\innerResult -> pResolve p innerResult))
return p
main = do
p <- mkPromise
p2 <- p `pMap` (*2)
p2 `pOnSuccess` (\x -> putStrLn $ "Got: " ++ (show x))
p `pResolve` 11