{-# LANGUAGE FlexibleContexts #-}

module Data.IVar (IVar (..), Cacheable (..), cacheIVar) where

import Control.Applicative
import Control.Monad
import Data.IORef
import Data.Monoid
import System.IO.Unsafe

newtype IVar m a = IVar { force :: m a }

class Cacheable m where
    -- |Caches the result of an action. The caching may be
    --  conditional.
    cache :: m a -> m a

instance Cacheable IO where
    cache = join . readIORef . unsafeActionRef

unsafeActionRef :: IO a -> IORef (IO a)
unsafeActionRef action = ref
    where ref = unsafePerformIO . newIORef $ do
                        x <- action
                        writeIORef ref $ return x
                        return x
{-# NOINLINE unsafeActionRef #-}

cacheIVar :: Cacheable m => m a -> IVar m a
cacheIVar = IVar . cache

instance (Cacheable m, Functor m) => Functor (IVar m) where
    f `fmap` x = cacheIVar $ f <$> force x

instance (Cacheable m, Applicative m) => Applicative (IVar m) where
    pure = cacheIVar . pure
    f <*> x = cacheIVar $ force f <*> force x

instance (Cacheable m, Monad m) => Monad (IVar m) where
    return = cacheIVar . return
    m >>= k = cacheIVar $ force . k =<< force m

instance (Cacheable m, Monoid (m a)) => Monoid (IVar m a) where
    mempty = cacheIVar mempty
    a `mappend` b = cacheIVar $ force a `mappend` force b