Abstract Promises in Haskell

Promise.hs

module Promise where

import Control.Applicative (Applicative(..))
import Data.Monoid (Monoid(..))

newtype Error = Error { unString :: String } deriving (Eq, Ord, Read, Show)

data Promise a = Failed Error | Deferred | Fulfilled a
  deriving (Eq, Ord, Read, Show)

instance Functor Promise where
  fmap _ (Failed e)    = Failed e
  fmap _ Deferred      = Deferred
  fmap f (Fulfilled a) = Fulfilled (f a)

instance Monad Promise where
  return = Fulfilled

  Failed e    >>= _ = Failed e
  Deferred    >>= _ = Deferred
  Fulfilled a >>= f = f a

  fail = Failed . Error

instance Applicative Promise where
  pure = Fulfilled

  Failed e    <*> _           = Failed e
  Deferred    <*> _           = Deferred
  Fulfilled f <*> Fulfilled a = Fulfilled (f a)
  Fulfilled _ <*> Failed e    = Failed e
  Fulfilled _ <*> Deferred    = Deferred

then_ :: Promise a -> (a -> Promise b) -> Promise b
then_ = (>>=)

promisify :: a -> Promise a
promisify = return

-- Promises actually form a valid Monoid!
instance Monoid a => Monoid (Promise a) where
  mempty = Failed $ Error "Default failure"

  mappend (Failed e)     _            = Failed e
  mappend (Deferred)    (Fulfilled _) = Deferred
  mappend (Deferred)    (Deferred)    = Deferred
  mappend (Fulfilled a) (Fulfilled b) = Fulfilled (a `mappend` b)
  mappend (Fulfilled _) (Deferred)    = Deferred
  mappend _             (Failed e)    = Failed e

In practice, when using Deferred in functions, something like a thunk would be created, and all of the functions that use the value of the promise would wait until the async operation was done.

But that would all be behind the scenes, on implementation level.