packages feed

vault 0.3.0.0 → 0.3.0.1

raw patch · 10 files changed

+30/−624 lines, 10 filesdep ~basedep ~containers

Dependency ranges changed: base, containers

Files

src/Data/Unique/Really.hs view
@@ -1,10 +1,5 @@-{------------------------------------------------------------------------------    vault-------------------------------------------------------------------------------}-{-# LANGUAGE CPP #-}+-- | An abstract interface to a unique symbol generator. module Data.Unique.Really (-    -- | An abstract interface to a unique symbol generator.-         Unique, newUnique, hashUnique,     ) where @@ -43,14 +38,14 @@  newNumber = atomicModifyIORef' refNumber $ \x -> let x' = x+1 in (x', x') -newtype Unique = Unique Integer deriving (Eq)- -- | An abstract unique value. -- Values of type 'Unique' may be compared for equality -- and hashed into Int. -- -- NOTE: You haven't compiled this module with GHC. -- The functionality will be identitcal to "Data.Unique".+newtype Unique = Unique Integer deriving (Eq,Ord)+ newUnique = Unique <$> newNumber hashUnique (Unique s) = fromIntegral s
src/Data/Vault/Lazy.hs view
@@ -1,82 +1,6 @@-{------------------------------------------------------------------------------    vault-------------------------------------------------------------------------------}-module Data.Vault.Lazy (-    -- * Synopsis-    -- | A persistent store for values of arbitrary types.-    ---    -- The 'Vault' type in this module is strict in the keys but lazy in the values.-    -    -- * 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.Lazy as ST+#define LAZINESS Lazy -{------------------------------------------------------------------------------    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 :: *--- > instance Monoid Vault-type Vault = ST.Vault RealWorld---- | Keys for the vault.------ > type Key :: * -> *-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 :: *-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+-- The 'Vault' type in this module is strict in the keys but lazy in the values.+#include "IO.hs"
− src/Data/Vault/ST/GHC_Lazy.hs 
@@ -1,64 +0,0 @@-{------------------------------------------------------------------------------    vault-------------------------------------------------------------------------------}-module Data.Vault.ST.GHC_Lazy where--import Prelude hiding (lookup)-import Data.Functor-import Control.Monad.ST-import Control.Monad.ST.Unsafe as STUnsafe--import Data.Unique.Really---- 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.Lazy 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--empty :: Vault s-empty = Vault Map.empty--newKey :: ST s (Key s a)-newKey = STUnsafe.unsafeIOToST $ Key <$> newUnique--lookup :: Key s a -> Vault s -> Maybe a-lookup (Key k) (Vault m) = fromAny <$> Map.lookup k m--insert :: Key s a -> a -> Vault s -> Vault s-insert (Key k) x (Vault m) = Vault $ Map.insert k (toAny x) m--adjust :: (a -> a) -> Key s a -> Vault s -> Vault s-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--union (Vault m) (Vault m') = Vault $ Map.union m m'--{------------------------------------------------------------------------------    Locker-------------------------------------------------------------------------------}-data Locker s = Locker !Unique !Any--lock :: Key s a -> a -> Locker s-lock (Key k) = Locker k . toAny--unlock :: Key s a -> Locker s -> Maybe a-unlock (Key k) (Locker k' a)-  | k == k' = Just $ fromAny a-  | otherwise = Nothing
− src/Data/Vault/ST/GHC_Strict.hs 
@@ -1,64 +0,0 @@-{------------------------------------------------------------------------------    vault-------------------------------------------------------------------------------}-module Data.Vault.ST.GHC_Strict where--import Prelude hiding (lookup)-import Data.Functor-import Control.Monad.ST-import Control.Monad.ST.Unsafe as STUnsafe--import Data.Unique.Really---- 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.Strict 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--empty :: Vault s-empty = Vault Map.empty--newKey :: ST s (Key s a)-newKey = STUnsafe.unsafeIOToST $ Key <$> newUnique--lookup :: Key s a -> Vault s -> Maybe a-lookup (Key k) (Vault m) = fromAny <$> Map.lookup k m--insert :: Key s a -> a -> Vault s -> Vault s-insert (Key k) x (Vault m) = Vault $ Map.insert k (toAny x) m--adjust :: (a -> a) -> Key s a -> Vault s -> Vault s-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--union (Vault m) (Vault m') = Vault $ Map.union m m'--{------------------------------------------------------------------------------    Locker-------------------------------------------------------------------------------}-data Locker s = Locker !Unique !Any--lock :: Key s a -> a -> Locker s-lock (Key k) = Locker k . toAny--unlock :: Key s a -> Locker s -> Maybe a-unlock (Key k) (Locker k' a)-  | k == k' = Just $ fromAny a-  | otherwise = Nothing
src/Data/Vault/ST/Lazy.hs view
@@ -1,103 +1,7 @@-{------------------------------------------------------------------------------    vault-------------------------------------------------------------------------------}-{-# LANGUAGE CPP #-}-module Data.Vault.ST.Lazy (-    -- * Synopsis-    -- | A persistent store for values of arbitrary types.-    -- Variant for the 'ST' monad.-    ---    -- The 'Vault' type in this module is strict in the keys but lazy in the values.--    -    -- * 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.Monad.ST--{--    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-import qualified Data.Vault.ST.GHC_Lazy as ST-#else-import qualified Data.Vault.ST.Pure_Lazy as ST-#endif+#define LAZINESS Lazy -{------------------------------------------------------------------------------    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 :: * -> *--- > instance Monoid Vault-type Vault = ST.Vault--instance Monoid (ST.Vault s) where-    mempty = empty-    mappend = union---- | Keys for the vault.------ > type Key :: * -> * -> *-type Key = ST.Key---- | The empty vault.-empty :: Vault s-empty = ST.empty---- | Create a new key for use with a vault.-newKey :: ST s (Key s a)-newKey = ST.newKey---- | Lookup the value of a key in the vault.-lookup :: Key s a -> Vault s -> Maybe a-lookup = ST.lookup---- | Insert a value for a given key. Overwrites any previous value.-insert :: Key s a -> a -> Vault s -> Vault s-insert = ST.insert---- | Adjust the value for a given key if it's present in the vault.-adjust :: (a -> a) -> Key s a -> Vault s -> Vault s-adjust = ST.adjust---- | Delete a key from the vault.-delete :: Key s a -> Vault s -> Vault s-delete = ST.delete---- | Merge two vaults (left-biased).-union :: Vault s -> Vault s -> Vault s-union = ST.union--{------------------------------------------------------------------------------    Locker-------------------------------------------------------------------------------}--- | A persistent store for a single value.+-- Variant for the 'ST' monad. ----- > type Locker :: * -> *-type Locker = ST.Locker---- | Put a single value into a 'Locker'.-lock :: Key s a -> a -> Locker s-lock = ST.lock---- | Retrieve the value from the 'Locker'.-unlock :: Key s a -> Locker s -> Maybe a-unlock = ST.unlock+-- The 'Vault' type in this module is strict in the keys but lazy in the values.+#include "ST.hs"
− src/Data/Vault/ST/Pure_Lazy.hs 
@@ -1,58 +0,0 @@-{------------------------------------------------------------------------------    vault-------------------------------------------------------------------------------}-module Data.Vault.ST.Pure_Lazy where--import Prelude hiding (lookup)-import Data.Functor-import Data.IORef-import Control.Applicative-import Control.Monad.ST--import System.IO.Unsafe (unsafePerformIO)-import Control.Monad.ST.Unsafe--import Data.Unique--import qualified Data.Map.Lazy as Map-type Map = Map.Map--{------------------------------------------------------------------------------    Locker-------------------------------------------------------------------------------}-data Key s a  = Key    !Unique (IORef (Maybe a))-data Locker s = Locker !Unique (IO ())--lock :: Key s a -> a -> Locker s-lock (Key u ref) x = Locker u $ writeIORef ref $ Just x--unlock :: Key s a -> Locker s -> Maybe a-unlock (Key _ ref) (Locker _ m) = unsafePerformIO $ do-    m-    mx <- readIORef ref     -- FIXME: race condition!-    writeIORef ref Nothing-    return mx--{------------------------------------------------------------------------------    Vault-------------------------------------------------------------------------------}--- implemented as a collection of lockers-newtype Vault s = Vault (Map Unique (Locker s))--empty  = Vault Map.empty--newKey :: ST s (Key s a)-newKey = Control.Monad.ST.Unsafe.unsafeIOToST $-    Key <$> newUnique <*> newIORef Nothing--lookup :: Key s a -> Vault s -> Maybe a-lookup key@(Key k _)   (Vault m) = unlock key =<< Map.lookup k m--insert key@(Key k _) x (Vault m) = Vault $ Map.insert k (lock key x) m--adjust :: (a -> a) -> Key s a -> Vault s -> Vault s-adjust f key@(Key k _) (Vault m) = Vault $ Map.update f' k m-    where f' = fmap (lock key . f) . unlock key--delete (Key k _) (Vault m)  = Vault $ Map.delete k m-union  (Vault m) (Vault m') = Vault $ Map.union m m'
− src/Data/Vault/ST/Pure_Strict.hs 
@@ -1,60 +0,0 @@-{------------------------------------------------------------------------------    vault-    -    FIXME: Make Implementation actually strict!-------------------------------------------------------------------------------}-module Data.Vault.ST.Pure_Strict where--import Prelude hiding (lookup)-import Data.Functor-import Data.IORef-import Control.Applicative-import Control.Monad.ST--import System.IO.Unsafe (unsafePerformIO)-import Control.Monad.ST.Unsafe--import Data.Unique--import qualified Data.Map.Strict as Map-type Map = Map.Map--{------------------------------------------------------------------------------    Locker-------------------------------------------------------------------------------}-data Key s a  = Key    !Unique (IORef (Maybe a))-data Locker s = Locker !Unique (IO ())--lock :: Key s a -> a -> Locker s-lock (Key u ref) x = x `seq` (Locker u $ writeIORef ref $ Just x)--unlock :: Key s a -> Locker s -> Maybe a-unlock (Key _ ref) (Locker _ m) = unsafePerformIO $ do-    m-    mx <- readIORef ref     -- FIXME: race condition!-    writeIORef ref Nothing-    return mx--{------------------------------------------------------------------------------    Vault-------------------------------------------------------------------------------}--- implemented as a collection of lockers-newtype Vault s = Vault (Map Unique (Locker s))--empty  = Vault Map.empty--newKey :: ST s (Key s a)-newKey = Control.Monad.ST.Unsafe.unsafeIOToST $-    Key <$> newUnique <*> newIORef Nothing--lookup :: Key s a -> Vault s -> Maybe a-lookup key@(Key k _)   (Vault m) = unlock key =<< Map.lookup k m--insert key@(Key k _) x (Vault m) = Vault $ Map.insert k (lock key x) m--adjust :: (a -> a) -> Key s a -> Vault s -> Vault s-adjust f key@(Key k _) (Vault m) = Vault $ Map.update f' k m-    where f' = fmap (lock key . f) . unlock key--delete (Key k _) (Vault m)  = Vault $ Map.delete k m-union  (Vault m) (Vault m') = Vault $ Map.union m m'
src/Data/Vault/ST/Strict.hs view
@@ -1,102 +1,8 @@-{------------------------------------------------------------------------------    vault-------------------------------------------------------------------------------}-{-# LANGUAGE CPP #-}-module Data.Vault.ST.Strict (-    -- * Synopsis-    -- | A persistent store for values of arbitrary types.-    -- Variant for the 'ST' monad.-    ---    -- The 'Vault' type in this module is strict in both keys and values.-    -    -- * 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.Monad.ST--{--    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-import qualified Data.Vault.ST.GHC_Strict as ST-#else-import qualified Data.Vault.ST.Pure_Strict as ST-#endif+#define LAZINESS Strict+#define IsStrict 1 -{------------------------------------------------------------------------------    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 :: * -> *--- > instance Monoid Vault-type Vault = ST.Vault--instance Monoid (ST.Vault s) where-    mempty = empty-    mappend = union---- | Keys for the vault.------ > type Key :: * -> * -> *-type Key = ST.Key---- | The empty vault.-empty :: Vault s-empty = ST.empty---- | Create a new key for use with a vault.-newKey :: ST s (Key s a)-newKey = ST.newKey---- | Lookup the value of a key in the vault.-lookup :: Key s a -> Vault s -> Maybe a-lookup = ST.lookup---- | Insert a value for a given key. Overwrites any previous value.-insert :: Key s a -> a -> Vault s -> Vault s-insert = ST.insert---- | Adjust the value for a given key if it's present in the vault.-adjust :: (a -> a) -> Key s a -> Vault s -> Vault s-adjust = ST.adjust---- | Delete a key from the vault.-delete :: Key s a -> Vault s -> Vault s-delete = ST.delete---- | Merge two vaults (left-biased).-union :: Vault s -> Vault s -> Vault s-union = ST.union--{------------------------------------------------------------------------------    Locker-------------------------------------------------------------------------------}--- | A persistent store for a single value.+-- Variant for the 'ST' monad. ----- > type Locker :: * -> *-type Locker = ST.Locker---- | Put a single value into a 'Locker'.-lock :: Key s a -> a -> Locker s-lock = ST.lock---- | Retrieve the value from the 'Locker'.-unlock :: Key s a -> Locker s -> Maybe a-unlock = ST.unlock+-- The 'Vault' type in this module is strict in both keys and values.+#include "ST.hs"
src/Data/Vault/Strict.hs view
@@ -1,82 +1,6 @@-{------------------------------------------------------------------------------    vault-------------------------------------------------------------------------------}-module Data.Vault.Strict (-    -- * Synopsis-    -- | A persistent store for values of arbitrary types.-    ---    -- The 'Vault' type in this module is strict in both keys and values.-    -    -- * 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.Strict as ST+#define LAZINESS Strict -{------------------------------------------------------------------------------    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 :: *--- > instance Monoid Vault-type Vault = ST.Vault RealWorld---- | Keys for the vault.------ > type Key :: * -> *-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 :: *-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+-- The 'Vault' type in this module is strict in both keys and values.+#include "IO.hs"
vault.cabal view
@@ -1,5 +1,5 @@ Name:               vault-Version:            0.3.0.0+Version:            0.3.0.1 Synopsis:           a persistent store for values of arbitrary types Description:   A /vault/ is a persistent store for values of arbitrary types.@@ -13,7 +13,9 @@   .   Changelog:   .-  * 0.3.0.0 Split modules into Lazy and Strict variants, no default choice.+  * 0.3.0.1 - Use CPP to reduce code duplication.+  .+  * 0.3.0.0 - Split modules into Lazy and Strict variants, no default choice.   Add Hashable instance to Data.Unique.Really for all implementations.      Category:           Data@@ -33,10 +35,14 @@     type:           git     location:       git://github.com/HeinrichApfelmus/vault.git -    +flag UseGHC+    description: Use GHC-specific packages and extensions.+    default:     True+ Library     hs-source-dirs:     src-    build-depends:      base == 4.6.*, containers == 0.5.*,+    build-depends:      base >= 4.5 && < 4.7,+                        containers >= 0.4 && < 0.6,                         unordered-containers >= 0.2.3.0 && < 0.3,                         hashable >= 1.1.2.5 && < 1.3 @@ -49,13 +55,6 @@                         Data.Vault.ST.Lazy,                         Data.Vault.ST.Strict,                         Data.Unique.Really-                        -    if impl(ghc)++    if impl(ghc) && flag(UseGHC)         CPP-options:    -DUseGHC-        other-modules:-                        Data.Vault.ST.GHC_Lazy,-                        Data.Vault.ST.GHC_Strict-    else-        other-modules:-                        Data.Vault.ST.Pure_Lazy,-                        Data.Vault.ST.Pure_Strict