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

-- MutableMap.hs
-- created: Mon Mar 29 14:16:46 JST 2010

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

module Sound.Conductive.MutableMap where

import Control.Concurrent.STM
import Control.Monad
import Data.Maybe
import qualified Data.Map as M

type MutableMap t t1 = (TVar (M.Map t t1))

newMMapSingleton :: Ord k => (k, a) -> IO (TVar (M.Map k a))
newMMapSingleton (k,v) = do
    newStore <- newTVarIO $ M.fromList [(k,v)]
    return newStore

newMMap :: Ord k => [(k, a)] -> IO (TVar (M.Map k a))
newMMap kvs = do
    newStore <- newTVarIO $ M.fromList kvs
    return newStore

-- can this be done with fmap instead? if so, is there any advantage to doing so?

withMMap :: TVar t -> (t -> b) -> IO b
withMMap mm func = do
    mmap <- readTVarIO mm
    return $ func mmap

mapMMapIO_ :: TVar (M.Map k a) -> ((k, a) -> IO b) -> IO ()
mapMMapIO_ mm func = do
    mmap <- readTVarIO mm
    mapM_ func $ M.toList mmap

modifyMMap :: TVar a -> (a -> a) -> IO ()
modifyMMap mm func = atomically $ modifyTVar' mm func

addVal :: Ord k => TVar (M.Map k a) -> (k, a) -> IO ()
addVal mm (k,v) = modifyMMap mm $ M.insert k v

addVals :: Ord k => TVar (M.Map k a) -> [(k, a)] -> IO ()
addVals mm kvs = sequence_ $ map (addVal mm) kvs

(+@) :: Ord k => TVar (M.Map k a) -> (k, a) -> IO ()
(+@) mm (k,v) = addVal mm (k,v)

(?@) :: Ord k => TVar (M.Map k a) -> k -> IO (Maybe a)
(?@) mm k = withMMap mm $ M.lookup k

deleteVal :: Ord k => TVar (M.Map k a) -> k -> IO ()
deleteVal mm key = modifyMMap mm $ M.delete key

(-@) :: Ord k => TVar (M.Map k a) -> k -> IO ()
(-@) mm key = deleteVal mm key

copyVal :: Ord k => TVar (M.Map k a) -> k -> k -> IO ()
copyVal mm key newKey = do
    source <- mm ?@ key
    addVal mm (newKey,fromJust source)

changeVal :: Ord k => TVar (M.Map k a) -> (k, a) -> IO ()
changeVal mm (k,v) = addVal mm (k,v)

changeKey :: Ord k => TVar (M.Map k a) -> k -> k -> IO ()
changeKey mm oldKey newKey = do
    copyVal mm oldKey newKey
    deleteVal mm oldKey

keys :: TVar (M.Map k a) -> IO [k]
keys mm = withMMap mm M.keys

elems :: TVar (M.Map k a) -> IO [a]
elems mm = withMMap mm M.elems

withKey :: Ord k => TVar (M.Map k t) -> (t -> a) -> k -> IO (Maybe a)
withKey mm func key = let
    runFunc (Nothing) = Nothing
    runFunc (Just x) = Just (func x)
    in do v <- mm ?@ key
          return $ runFunc v

withKeys :: Ord a => TVar (M.Map a t) -> (t -> a1) -> [a] -> IO [Maybe a1]
withKeys mm func keys = mapM (withKey mm func) keys

withKeys_ :: Ord a => TVar (M.Map a t) -> (t -> a1) -> [a] -> IO ()
withKeys_ mm func keys = mapM_ (withKey mm func) keys

toMap :: TVar a -> IO a
toMap mm = readTVarIO mm