packages feed

keyvaluehash 0.1.0.0 → 0.2.0.0

raw patch · 2 files changed

+41/−10 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Database.KeyValueHash: closeDatabase :: Database -> IO ()
+ Database.KeyValueHash: withCreateDatabase :: FilePath -> HashFunction -> Size -> (Database -> IO a) -> IO a
+ Database.KeyValueHash: withOpenDatabase :: FilePath -> HashFunction -> Size -> (Database -> IO a) -> IO a

Files

keyvaluehash.cabal view
@@ -1,5 +1,5 @@ name:                keyvaluehash-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Pure Haskell key/value store implementation -- description:          license:             BSD3
src/Database/KeyValueHash.hs view
@@ -3,7 +3,8 @@   ( Key, Value   , Size, mkSize, sizeLinear   , HashFunction, stdHash, mkHashFunc-  , Database, createDatabase, openDatabase+  , Database, createDatabase, openDatabase, closeDatabase+  , withCreateDatabase, withOpenDatabase   , readKey, writeKey, deleteKey   ) where @@ -81,6 +82,8 @@  data ValueHeader = ValueHeader   { vhNextCollision :: ValuePtr+    -- if value is re-written multiple times, we can do it in-place as long as it fits+  , vhAllocSize :: Word32   , vhKeySize :: Word32   , vhValueSize :: Word32   }@@ -104,7 +107,7 @@ keyRecordSize = binaryPutSize (0 :: KeyRecord)  valueHeaderSize :: Word64-valueHeaderSize = binaryPutSize $ ValueHeader 0 0 0+valueHeaderSize = binaryPutSize $ ValueHeader 0 0 0 0  makeFileName :: String -> FilePath -> HashFunction -> Size -> FilePath makeFileName prefix path func size =@@ -145,6 +148,19 @@   where     mkHandle f = IO.openFile (f path func size) IO.ReadWriteMode +closeDatabase :: Database -> IO ()+closeDatabase db = do+  IO.hClose $ dbKeysHandle db+  IO.hClose $ dbValuesHandle db++withCreateDatabase :: FilePath -> HashFunction -> Size -> (Database -> IO a) -> IO a+withCreateDatabase path func size =+  Exc.bracket (createDatabase path func size) closeDatabase++withOpenDatabase :: FilePath -> HashFunction -> Size -> (Database -> IO a) -> IO a+withOpenDatabase path func size =+  Exc.bracket (openDatabase path func size) closeDatabase+ hashKey :: Database -> Key -> KeyPtr hashKey db key = hfHash (dbHashFunc db) key (dbSize db) @@ -234,29 +250,44 @@       readFileRange (dbValuesHandle db)       (valueDataRange (vprVal valuePtrRef) valueHeader) +pairLengths :: Key -> Value -> (Word32, Word32)+pairLengths key value = (keyLen, valueLen)+  where+    keyLen = fromIntegral $ SBS.length key+    valueLen = fromIntegral $ SBS.length value+ appendNewValue :: Database -> ValuePtr -> Key -> Value -> IO ValuePtr-appendNewValue db nextCollision key val = do+appendNewValue db nextCollision key value = do   valuePtr <- fromIntegral <$> IO.hFileSize (dbValuesHandle db)   let     headerStr = encode ValueHeader-      { vhKeySize = fromIntegral $ SBS.length key-      , vhValueSize = fromIntegral $ SBS.length val-      , vhNextCollision = nextCollision+      { vhNextCollision = nextCollision+      , vhAllocSize = keyLen + valueLen+      , vhKeySize = keyLen+      , vhValueSize = valueLen       }-  writeFileRange (dbValuesHandle db) valuePtr $ mconcat [headerStr, key, val]+  writeFileRange (dbValuesHandle db) valuePtr $ mconcat [headerStr, key, value]   return valuePtr+  where+    (keyLen, valueLen) = pairLengths key value  writeKey :: Database -> Key -> Value -> IO () writeKey db key value = do   mResult <- findKey db key   case mResult of     Just (valuePtrRef, valueHeader) ->-      -- The old value now becomes unreachable-      setValue valuePtrRef $ vhNextCollision valueHeader+      if vhAllocSize valueHeader >= keyLen + valueLen then+        -- re-use existing storage:+        let headerStr = encode valueHeader { vhKeySize = keyLen, vhValueSize = valueLen }+        in writeFileRange (dbValuesHandle db) (vprVal valuePtrRef) $ mconcat [headerStr, key, value]+      else+        -- The old value now becomes unreachable+        setValue valuePtrRef $ vhNextCollision valueHeader     Nothing -> do       hashAnchor <- hashValuePtrRef db key       setValue hashAnchor $ vprVal hashAnchor   where+    (keyLen, valueLen) = pairLengths key value     setValue ref nextCollision =       vprSet ref =<< appendNewValue db nextCollision key value