Test.hs

module Test where

import Control.Concurrent.MVar
import Control.Monad.IO.Class
import Control.Monad (join)

-- Memoize an IO result
memoIO :: MonadIO m => m a -> m (m a)
memoIO action = do
  ref <- liftIO $ newMVar Nothing
  return $ do
    x <- maybe action return =<< liftIO (takeMVar ref)
    liftIO . putMVar ref $ Just x
    return x

--------------

-- prints "hi" twice, returns 5
main :: IO Int
main = do
    hi5
    hi5
  where hi5 = join . memoIO $ do
                  putStrLn "hi"
                  return 5

--------------

-- prints "hi" once, returns 4
main2 :: IO Int
main2 = do
    hi <- hi4
    hi
    hi
  where hi4 = memoIO $ do
                  putStrLn "hi"
                  return 4