persistent-map-0.0.0: Data/TStorage.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.TStorage
-- Copyright   :  Peter Robinson 2009
-- License     :  LGPL
--
-- Maintainer  :  Peter Robinson <thaldyron@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable (requires STM)
--
-- Provides a high level interface to 'Data.TMap'. This module was inspired
-- by the TCache package, (C) Alberto Gomez Corona.
--
-- The essential difference to the low level functions in 'Data.TMap' is 
-- that this interface assumes that the stored type is an instance of 
-- 'HasKey', allowing partially filled (i.e. complete enough for deducing 
-- the key) values to be passed to the interface functions. 
-----------------------------------------------------------------------------

module Data.TStorage( TMap,
                      HasKey(..),
                      newTMapIO,
                      add,
                      tryComplete,
                      complete,
                      remove,
                      removeKey,
                      apply,
                      purgeTMap,
                      purgeTMapIO,
                    )
                    
where
import Control.Concurrent.AdvSTM
import Control.Exception 
import Prelude hiding (lookup,catch)

import qualified Data.TMap.Backend as B
import qualified Data.CacheStructure as C

import qualified Data.Edison.Assoc as M

import Data.TMap

-- | Instantiated by types where values have a unique key. 
class HasKey a k | a -> k where
  key :: a -> k

-- | Adds a new element to the map. The key is automatically deduced by the
-- 'HasKey' instantiation.
add :: (M.FiniteMapX map k, MonadAdvSTM m, Ord k, B.Backend k a b, C.CacheStructure c k
       , HasKey a k) 
    => a -> TMap map k a b c -> m () 
add a = insert (key a) a


-- | Tries to fill a partially initialized value with data from the TMap. Returns
-- 'Nothing' if the TMap does not contain a corresponding entry. 
tryComplete :: (M.FiniteMapX map k, MonadAdvSTM m, Ord k, B.Backend k a b, C.CacheStructure c k
               , HasKey a k) 
            => a -> TMap map k a b c -> m (Maybe a)
tryComplete a = lookup (key a)

-- | Fills a partially initialized value with data from the TMap. Throws
-- a 'TMapNotFound' exception if there is no corresponding entry.
complete :: (M.FiniteMapX map k, MonadAdvSTM m, Ord k, B.Backend k a b, C.CacheStructure c k
            , HasKey a k) 
         => a -> TMap map k a b c -> m a
complete a tmap = do
  mval <- tryComplete a tmap
  case mval of
    Just val -> return val
    Nothing  -> throw TMapNotFound

-- | Removes the element from the map.
remove :: (M.FiniteMapX map k, MonadAdvSTM m, Ord k, B.Backend k a b, C.CacheStructure c k
          , HasKey a k) 
       => a -> TMap map k a b c -> m ()
remove a = delete (key a) 

-- | Removes the entry that has the supplied key.
removeKey :: (M.FiniteMapX map k, MonadAdvSTM m, Ord k, B.Backend k a b, C.CacheStructure c k
             , HasKey a k) 
          => k -> TMap map k a b c -> m ()
removeKey = delete 

-- | Applies a function to an element that might be only partially initialized.
apply :: (M.FiniteMapX map k, MonadAdvSTM m, Ord k, B.Backend k a b, C.CacheStructure c k
         , HasKey a k) 
       => (a -> a) -> a -> TMap map k a b c -> m a
apply f a tmap = do
  adjust f (key a) tmap
  complete a tmap