vault 0.3.0.1 → 0.3.0.2

raw patch · 4 files changed

+191/−2 lines, 4 filesdep ~base

Dependency ranges changed: base

Files

• src/Data/Vault/IO.hs +70/−0
• src/Data/Vault/ST/ST.hs +72/−0
• src/Data/Vault/ST/backends/GHC.hs +41/−0
• vault.cabal +8/−2

@@ -0,0 +1,70 @@+module Data.Vault.LAZINESS (+    -- * Vault+    Vault, Key,+    empty, newKey, lookup, insert, adjust, delete, union,++    -- * Locker+    Locker,+    lock, unlock,+    ) where++import Prelude hiding (lookup)+import Control.Monad.ST+import qualified Data.Vault.ST.LAZINESS as ST+++{-----------------------------------------------------------------------------+    Vault+------------------------------------------------------------------------------}++-- | A persistent store for values of arbitrary types.+--+-- This variant is the simplest and creates keys in the 'IO' monad.+-- See the module "Data.Vault.ST" if you want to use it with the 'ST' monad instead.+type Vault = ST.Vault RealWorld++-- | Keys for the vault.+type Key = ST.Key RealWorld++-- | The empty vault.+empty :: Vault+empty = ST.empty++-- | Create a new key for use with a vault.+newKey :: IO (Key a)+newKey = stToIO ST.newKey++-- | Lookup the value of a key in the vault.+lookup :: Key a -> Vault -> Maybe a+lookup = ST.lookup++-- | Insert a value for a given key. Overwrites any previous value.+insert :: Key a -> a -> Vault -> Vault+insert = ST.insert++-- | Adjust the value for a given key if it's present in the vault.+adjust :: (a -> a) -> Key a -> Vault -> Vault+adjust = ST.adjust++-- | Delete a key from the vault.+delete :: Key a -> Vault -> Vault+delete = ST.delete++-- | Merge two vaults (left-biased).+union :: Vault -> Vault -> Vault+union = ST.union++{-----------------------------------------------------------------------------+    Locker+------------------------------------------------------------------------------}++-- | A persistent store for a single value.+type Locker = ST.Locker RealWorld++-- | Put a single value into a 'Locker'.+lock :: Key a -> a -> Locker+lock = ST.lock++-- | Retrieve the value from the 'Locker'.+unlock :: Key a -> Locker -> Maybe a+unlock = ST.unlock

@@ -0,0 +1,72 @@+module Data.Vault.ST.LAZINESS (+    -- * Vault+    Vault, Key,+    empty, newKey, lookup, insert, adjust, delete, union,++    -- * Locker+    Locker,+    lock, unlock,+    ) where++import Data.Monoid (Monoid(..))+import Prelude hiding (lookup)+import Control.Applicative hiding (empty)+import Control.Monad.ST+import Control.Monad.ST.Unsafe as STUnsafe++import Data.Unique.Really++{-+    The GHC-specific implementation uses  unsafeCoerce+    for reasons of efficiency.++    See  http://apfelmus.nfshost.com/blog/2011/09/04-vault.html+    for the second implementation that doesn't need to+    bypass the type checker.+-}+#if UseGHC+#include "backends/GHC.hs"+#else+#include "backends/IORef.hs"+#endif++{-----------------------------------------------------------------------------+    Vault+------------------------------------------------------------------------------}++instance Monoid (Vault s) where+    mempty = empty+    mappend = union++-- | The empty vault.+empty :: Vault s+empty = Vault Map.empty++-- | Create a new key for use with a vault.+newKey :: ST s (Key s a)++-- | Lookup the value of a key in the vault.+lookup :: Key s a -> Vault s -> Maybe a++-- | Insert a value for a given key. Overwrites any previous value.+insert :: Key s a -> a -> Vault s -> Vault s++-- | Adjust the value for a given key if it's present in the vault.+adjust :: (a -> a) -> Key s a -> Vault s -> Vault s++-- | Delete a key from the vault.+delete :: Key s a -> Vault s -> Vault s++-- | Merge two vaults (left-biased).+union :: Vault s -> Vault s -> Vault s+union (Vault m) (Vault m') = Vault $ Map.union m m'++{-----------------------------------------------------------------------------+    Locker+------------------------------------------------------------------------------}++-- | Put a single value into a 'Locker'.+lock :: Key s a -> a -> Locker s++-- | Retrieve the value from the 'Locker'.+unlock :: Key s a -> Locker s -> Maybe a

@@ -0,0 +1,41 @@+-- This implementation is specific to GHC+-- und uses  unsafeCoerce  for reasons of efficiency.+import GHC.Exts (Any)+import Unsafe.Coerce (unsafeCoerce)++import qualified Data.HashMap.LAZINESS as Map+type Map = Map.HashMap++toAny :: a -> Any+toAny = unsafeCoerce++fromAny :: Any -> a+fromAny = unsafeCoerce++{-----------------------------------------------------------------------------+    Vault+------------------------------------------------------------------------------}+newtype Vault s = Vault (Map Unique Any)+newtype Key s a = Key Unique++newKey = STUnsafe.unsafeIOToST $ Key <$> newUnique++lookup (Key k) (Vault m) = fromAny <$> Map.lookup k m++insert (Key k) x (Vault m) = Vault $ Map.insert k (toAny x) m++adjust f (Key k) (Vault m) = Vault $ Map.adjust f' k m+    where f' = toAny . f . fromAny++delete (Key k) (Vault m) = Vault $ Map.delete k m++{-----------------------------------------------------------------------------+    Locker+------------------------------------------------------------------------------}+data Locker s = Locker !Unique !Any++lock (Key k) = Locker k . toAny++unlock (Key k) (Locker k' a)+  | k == k' = Just $ fromAny a+  | otherwise = Nothing

@@ -1,5 +1,5 @@ Name:               vault-Version:            0.3.0.1+Version:            0.3.0.2 Synopsis:           a persistent store for values of arbitrary types Description:   A /vault/ is a persistent store for values of arbitrary types.@@ -13,6 +13,8 @@   .   Changelog:   .+  * 0.3.0.2 - Fix tarball.+  .   * 0.3.0.1 - Use CPP to reduce code duplication.   .   * 0.3.0.0 - Split modules into Lazy and Strict variants, no default choice.@@ -29,7 +31,11 @@ build-type:         Simple cabal-version:      >= 1.6 -extra-source-files: Readme.md+extra-source-files:+    Readme.md+    src/Data/Vault/IO.hs+    src/Data/Vault/ST/ST.hs+    src/Data/Vault/ST/backends/GHC.hs  source-repository head     type:           git