Evil Promises

EvilPromise.hs

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