keyvaluehash 0.3.0.2 → 0.3.1

raw patch · 7 files changed

+119/−7 lines, 7 files

Files

• cbits/posix.c +21/−0
• cbits/win32.c +7/−0
• keyvaluehash.cabal +23/−4
• src/Database/FileArray.hs +12/−1
• src/Database/GrowingFile.hs +9/−0
• src/Database/KeyValueHash.hs +8/−2
• src/System/IO/MMap/Sync.hs +39/−0

@@ -0,0 +1,21 @@+#include "HsMsync.h"++#define _LARGEFILE64_SOURCE 1+#define _FILE_OFFSET_BITS 64++#include <sys/mman.h>++int system_io_msync(void *ptr, size_t size, int hs_flags)+{+    int flags = 0;+    if (hs_flags & 1) {+        flags |= MS_SYNC;+    }+    if (hs_flags & 2) {+        flags |= MS_ASYNC;+    }+    if (hs_flags & 4) {+        flags |= MS_INVALIDATE;+    }+    return msync(ptr, size, flags);+}

@@ -0,0 +1,7 @@+#include "HsMsync.h"++#include <sys/mman.h>++int system_io_msync(void *ptr, size_t size, int hs_flags)+{+}

@@ -1,12 +1,22 @@ name:                keyvaluehash-version:             0.3.0.2+version:             0.3.1 synopsis:            Pure Haskell key/value store implementation--- description:         +description:         A simple bytestring key/value store implemented+                     in terms of hash table over a file.++                     It cannot yet grow/shrink the hash table as+                     needed, nor does it free old unused (key,value)+                     pair storage.++                     Mostly useful for applications that need not+                     worry about the size of their persistent store.++                     Reduces dependency hell. license:             BSD3 license-file:        LICENSE author:              Eyal Lotem maintainer:          eyal.lotem@gmail.com--- copyright:           +copyright:           Eyal Lotem category:            Database build-type:          Simple cabal-version:       >=1.8@@ -14,8 +24,17 @@ library   hs-Source-Dirs:      src   exposed-modules:     Database.KeyValueHash-  other-modules:       Database.GrowingFile, Database.FileArray+  other-modules:       Database.GrowingFile, Database.FileArray, System.IO.MMap.Sync   build-depends:       base >= 3 && <10, filepath, directory, bytestring, hashable,                        binary, derive, mmap, array, storable-record+  Include-dirs:        cbits   ghc-options:         -O2 -Wall   ghc-prof-options:    -Wall -auto-all -caf-all -rtsopts+  if os(mingw32)+      C-sources:       cbits/win32.c+  else+      C-sources:       cbits/posix.c++source-repository head+  type: git+  location: https://github.com/Peaker/keyvaluehash.git

@@ -4,6 +4,7 @@   , create, open, close   , Element(..)   , unsafeElement -- no index checks+  , msync   ) where  import Control.Monad (when)@@ -17,9 +18,10 @@ import qualified Foreign.Storable as Storable import qualified System.IO as IO import qualified System.IO.MMap as MMap+import qualified System.IO.MMap.Sync as MMapSync  data FileArray a = FileArray-  { _faCount :: Word64+  { faCount :: Word64   , faPtr :: ForeignPtr a   } @@ -69,3 +71,12 @@   withForeignPtr (faPtr fileArray) $ \keysPtr -> do     let ptr = keysPtr `plusPtr` fromIntegral (ix * elementSize fileArray)     return $ Element (Storable.peek ptr) (Storable.poke ptr)++msync :: Storable a => FileArray a -> IO ()+msync fileArray =+  withForeignPtr (faPtr fileArray) $+  \ptr ->+  MMapSync.msync ptr (fromIntegral fileSize)+  (Just MMapSync.Async) MMapSync.NoInvalidate+  where+    fileSize = faCount fileArray * elementSize fileArray

@@ -4,6 +4,7 @@   , create, open, close   , readRange, writeRange   , append+  , msync   ) where  import Control.Applicative (liftA2)@@ -22,6 +23,7 @@ import qualified Foreign.Storable as Storable import qualified System.IO as IO import qualified System.IO.MMap as MMap+import qualified System.IO.MMap.Sync as MMapSync  data Header = Header   { hAllocated :: Word64@@ -152,3 +154,10 @@   resize gfile header newUsed   writeRange gfile curUsed bs   return curUsed++msync :: GrowingFile -> IO ()+msync gfile = do+  header <- readHeader gfile+  fptr <- readIORef (gfPtr gfile)+  withForeignPtr fptr $ \ptr ->+    MMapSync.msync ptr (fromIntegral (hUsed header)) (Just MMapSync.Async) MMapSync.NoInvalidate

@@ -6,6 +6,7 @@   , Database, createDatabase, openDatabase, closeDatabase   , withCreateDatabase, withOpenDatabase   , readKey, writeKey, deleteKey+  , msync   ) where  import Control.Applicative ((<$>), (<*>))@@ -15,7 +16,7 @@ import Data.Binary.Put (runPut) import Data.Derive.Binary(makeBinary) import Data.DeriveTH(derive)-import Data.Hashable (Hashable, hash)+import Data.Hashable (hashWithSalt) import Data.List (intercalate) import Data.Monoid (mconcat) import Data.Typeable (Typeable)@@ -66,7 +67,7 @@   }  stdHash :: HashFunction-stdHash = mkHashFunc "Hashable" (fromIntegral . hash)+stdHash = mkHashFunc "Hashable" (fromIntegral . hashWithSalt 0xDEADBEEF)  type ValuePtr = Word64 -- offset in values file type KeyPtr = Word64 -- index in key file@@ -280,3 +281,8 @@     Nothing ->       -- TODO: Throw exception?       return ()++msync :: Database -> IO ()+msync db = do+  FileArray.msync $ dbKeysArray db+  GrowingFile.msync $ dbValues db

@@ -0,0 +1,39 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module System.IO.MMap.Sync (msync, SyncFlag(..), InvalidateFlag(..)) where++import Control.Monad (when)+import Data.Int (Int64)+import Foreign.C.Error (throwErrno)+import Foreign.C.Types (CInt(..), CSize(..))+import Foreign.Ptr (Ptr)++-- TODO: This should be in the mmap package++data SyncFlag = Async | Sync+  deriving (Eq, Ord, Read, Show)+data InvalidateFlag = Invalidate | NoInvalidate+  deriving (Eq, Ord, Read, Show)++foreign import ccall unsafe "HsMsync.h system_io_msync"+    c_system_io_msync :: Ptr a -> CSize -> CInt -> IO CInt++mkMSyncFlag :: Maybe SyncFlag -> CInt+mkMSyncFlag Nothing = 0+mkMSyncFlag (Just Sync) = 1+mkMSyncFlag (Just Async) = 2++mkInvalidateFlag :: InvalidateFlag -> CInt+mkInvalidateFlag NoInvalidate = 0+mkInvalidateFlag Invalidate = 4++mkFlags :: Maybe SyncFlag -> InvalidateFlag -> CInt+mkFlags mSyncFlag invalidateFlag =+  mkMSyncFlag mSyncFlag ++  mkInvalidateFlag invalidateFlag++msync :: Ptr a -> Int64 -> Maybe SyncFlag -> InvalidateFlag -> IO ()+msync ptr size mSyncFlag invalidateFlag = do+  res <-+    c_system_io_msync ptr (fromIntegral size) $+    mkFlags mSyncFlag invalidateFlag+  when (res == -1) $ throwErrno "msync failed"