vault 0.3.1.5 → 0.3.1.6
raw patch · 8 files changed
+113/−69 lines, 8 filesdep −semigroupsdep ~basedep ~containersdep ~unordered-containers
Dependencies removed: semigroups
Dependency ranges changed: base, containers, unordered-containers
Files
- CHANGELOG.md +10/−0
- README.md +0/−3
- src/Data/Unique/Really.hs +5/−7
- src/Data/Vault/IO.h +0/−1
- src/Data/Vault/ST/ST.h +1/−5
- src/Data/Vault/ST/backends/GHC.h +1/−1
- src/Data/Vault/ST/backends/IORef.hs +40/−0
- vault.cabal +56/−52
CHANGELOG.md view
@@ -1,5 +1,15 @@ ## Changelog for the `vault` package +**0.3.1.6**++Added++* Add support for MicroHs++Removed++* Dropped support for `GHC < 8.4`+ **0.3.1.5** * Compatibility with GHC-9.0
README.md view
@@ -1,6 +1,3 @@-[](https://travis-ci.org/HeinrichApfelmus/vault)-- *Vault* is a tiny library that provides a single data structure called *vault*. A *vault* is a type-safe, persistent storage for values of arbitrary types. Like `IORef`, I want to be able to store values of any type in it, but unlike `IORef`, I want the storage space to behave like a persistent, first-class data structure, as appropriate for a purely functional language.
src/Data/Unique/Really.hs view
@@ -3,14 +3,12 @@ Unique, newUnique, hashUnique, ) where -import Control.Applicative ((<$>))-import Data.Hashable+import Data.Hashable #if UseGHC--import Control.Exception (evaluate)+import Control.Exception (evaluate) import qualified Data.Unique-import System.Mem.StableName+import System.Mem.StableName -- | An abstract unique value. -- Values of type 'Unique' may be compared for equality@@ -52,6 +50,8 @@ #endif +instance Hashable Unique where hashWithSalt s = hashWithSalt s . hashUnique+ -- | Creates a new object of type 'Unique'. -- The value returned will not compare equal to any other -- value of type 'Unique' returned by previous calls to 'newUnique'.@@ -62,5 +62,3 @@ -- Two Uniques may hash to the same value, although in practice this is unlikely. -- The 'Int' returned makes a good hash key. hashUnique :: Unique -> Int--instance Hashable Unique where hashWithSalt s = hashWithSalt s . hashUnique
src/Data/Vault/IO.h view
@@ -12,7 +12,6 @@ import Control.Monad.ST import qualified Data.Vault.ST.LAZINESS as ST - {----------------------------------------------------------------------------- Vault ------------------------------------------------------------------------------}
src/Data/Vault/ST/ST.h view
@@ -12,12 +12,9 @@ lock, unlock, ) where -import Data.Monoid (Monoid(..))-import Data.Semigroup (Semigroup((<>))) import Prelude hiding (lookup)-import Control.Applicative ((<$>)) import Control.Monad.ST-import Control.Monad.ST.Unsafe as STUnsafe+import Control.Monad.ST.Unsafe (unsafeIOToST) import Data.Unique.Really @@ -44,7 +41,6 @@ instance Monoid (Vault s) where mempty = empty- mappend = union -- | The empty vault. empty :: Vault s
src/Data/Vault/ST/backends/GHC.h view
@@ -23,7 +23,7 @@ type role Key nominal nominal #endif -newKey = STUnsafe.unsafeIOToST $ Key <$> newUnique+newKey = unsafeIOToST $ Key <$> newUnique lookup (Key k) (Vault m) = fromAny <$> Map.lookup k m
+ src/Data/Vault/ST/backends/IORef.hs view
@@ -0,0 +1,40 @@+import Data.IORef+import System.IO.Unsafe (unsafePerformIO)++import qualified Data.Map.LAZINESS as Map+type Map = Map.Map++{-----------------------------------------------------------------------------+ Locker+------------------------------------------------------------------------------}+data Key s a = Key !Unique (IORef (Maybe a))+data Locker s = Locker !Unique (IO ())++#if IsStrict+lock (Key u ref) x = x `seq` (Locker u $ writeIORef ref $ Just x)+#else+lock (Key u ref) x = Locker u $ writeIORef ref $ Just x+#endif++unlock (Key k ref) (Locker k' m)+ | k == k' = unsafePerformIO $ do+ m+ readIORef ref -- FIXME: race condition!+ | otherwise = Nothing++{-----------------------------------------------------------------------------+ Vault+------------------------------------------------------------------------------}+-- implemented as a collection of lockers+newtype Vault s = Vault (Map Unique (Locker s))++newKey = unsafeIOToST $ Key <$> newUnique <*> newIORef Nothing++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 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
vault.cabal view
@@ -1,7 +1,8 @@-Name: vault-Version: 0.3.1.5-Synopsis: a persistent store for values of arbitrary types-Description:+cabal-version: 3.4+name: vault+version: 0.3.1.6+synopsis: a persistent store for values of arbitrary types+description: A /vault/ is a persistent store for values of arbitrary types. It's like having first-class access to the storage space behind IORefs. .@@ -11,61 +12,64 @@ . Also provided is a /locker/ type, representing a store for a single element. -Category: Data-License: BSD3-License-file: LICENSE-Author: Heinrich Apfelmus, Elliott Hird-Maintainer: Heinrich Apfelmus <apfelmus at quantentunnel de>-Homepage: https://github.com/HeinrichApfelmus/vault-Copyright: (c) Heinrich Apfelmus 2011-2013--build-type: Simple-cabal-version: >= 1.10-Tested-With: GHC == 7.6.3- ,GHC == 7.8.4- ,GHC == 7.10.3- ,GHC == 8.0.2- ,GHC == 8.2.2- ,GHC == 8.4.4- ,GHC == 8.6.5- ,GHC == 8.8.3- ,GHC == 8.10.1+category: Data+license: BSD-3-Clause+license-file: LICENSE+author: Heinrich Apfelmus, Elliott Hird+maintainer: Heinrich Apfelmus <apfelmus at quantentunnel de>+homepage: https://github.com/HeinrichApfelmus/vault+copyright: (c) Heinrich Apfelmus 2011-2026+tested-with:+ GHC ==8.4.4+ || ==8.6.5+ || ==8.8.4+ || ==8.10.7+ || ==9.0.2+ || ==9.2.8+ || ==9.4.8+ || ==9.6.7+ || ==9.8.4+ || ==9.10.2+ || ==9.12.2 extra-source-files:- CHANGELOG.md- README.md- src/Data/Vault/IO.h- src/Data/Vault/ST/ST.h- src/Data/Vault/ST/backends/GHC.h+ src/Data/Vault/IO.h+ src/Data/Vault/ST/backends/GHC.h+ src/Data/Vault/ST/backends/IORef.hs+ src/Data/Vault/ST/ST.h+extra-doc-files:+ CHANGELOG.md+ README.md source-repository head- type: git- location: git://github.com/HeinrichApfelmus/vault.git+ type: git+ location: https://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.5 && < 4.16,- containers >= 0.4 && < 0.7,- unordered-containers >= 0.2.3.0 && < 0.3,- hashable >= 1.1.2.5 && < 1.4+ description: Use GHC-specific packages and extensions.+ default: True - if impl(ghc < 8.0)- build-depends: semigroups >= 0.1 && < 1.0+library+ default-language: Haskell2010+ default-extensions: CPP+ build-depends:+ , base >=4.11 && <4.23+ , containers >=0.5 && <0.9+ , hashable >=1.1.2.5 && <1.6+ , unordered-containers >=0.2.3.0 && <0.3 - default-language: Haskell2010- default-extensions: CPP- ghc-options: -Wall -fno-warn-missing-signatures+ ghc-options: -Wall -fno-warn-missing-signatures+ hs-source-dirs: src+ exposed-modules:+ Data.Unique.Really+ Data.Vault.Lazy+ Data.Vault.ST.Lazy+ Data.Vault.ST.Strict+ Data.Vault.Strict - exposed-modules:- Data.Vault.Lazy,- Data.Vault.Strict,- Data.Vault.ST.Lazy,- Data.Vault.ST.Strict,- Data.Unique.Really+ if (impl(ghc) && flag(useghc))+ cpp-options: -DUseGHC - if impl(ghc) && flag(UseGHC)- CPP-options: -DUseGHC+ if impl(mhs)+ build-depends:+ , unordered-containers >= 0.2.21