packages feed

pure-cdb (empty) → 0.1

raw patch · 9 files changed

+345/−0 lines, 9 filesdep +Unixutilsdep +basedep +binarysetup-changedbinary-added

Dependencies added: Unixutils, base, binary, bytestring, containers, directory, mtl, pure-cdb, test-simple, vector

Files

+ COPYING view
@@ -0,0 +1,25 @@+Copyright (c) 2013 Boris Sukholitko+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. The names of the authors may not be used to endorse or promote products+   derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Database/PureCDB.hs view
@@ -0,0 +1,154 @@+-- |+-- Module      : Database.CDB+-- Copyright   : (c) Boris Sukholitko 2013+--+-- License     : BSD3+--+-- A library for reading and writing CDB (Constant Database) files.+--+-- CDB files are immutable key-value stores, designed for extremely fast and+-- memory-efficient construction and lookup. They can be as large as 4GB, and+-- at no point in their construction or use must all data be loaded into+-- memory. CDB files can contain multiple values for a given key.+--+-- For more information on the CDB file format, please see:+--     <http://cr.yp.to/cdb.html>+--+-- Here's how you make new CDB file:+--  +-- > import qualified Data.ByteString.Char8 as B+-- > import Database.PureCDB+-- >+-- > makeIt :: IO ()+-- > makeIt = makeCDB (do+-- >       addBS (B.pack "foo") (B.pack "bar")+-- >       addBS (B.pack "foo") (B.pack "baz")) "foo.cdb"+--+-- You can later use it as in:+--+-- > getIt :: IO [ByteString]+-- > getIt = do+-- >       f <- openCDB "foo.cdb"+-- >       getBS f (B.pack "foo")+-- >       closeCDB "foo.cdb"+-- >+--+-- @getIt@ returns [ \"bar\", \"baz\" ] in unspecified order.+--+-- Note that @pure-cdb@ works on strict 'ByteString''s only for now.++{-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving #-}+module Database.PureCDB (+    -- * Writing interface+    WriteCDB, makeCDB, addBS+    +    -- * Reading interface+    , ReadCDB, openCDB, closeCDB, getBS) where++import Data.Word+import System.IO+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString as B+import Data.Binary.Get+import Data.Binary.Put+import qualified Data.Vector as V+import qualified Data.Vector.Generic.Mutable as MV+import Control.Applicative+import Control.Monad.State+import System.Directory+import Control.Monad.ST+import Database.PureCDB.Internal++data HashState = HashState { hsCount :: !Word32, hsPairs :: ![(Word32, Word32)] }+data WriteState = WriteState { wsHandle :: Handle, wsTOC :: !(V.Vector HashState) }++-- | Write context monad transformer.+newtype WriteCDB m a = WriteCDB (StateT WriteState m a)+                            deriving (Functor, Monad, Applicative, MonadTrans, MonadIO)++readWordPairs :: Handle -> Int -> IO [(Word32, Word32)]+readWordPairs ioh sz = do+    bs <- BL.hGet ioh sz+    return $ runGet (mapM (const go) [ 1 .. sz `div` 8 ]) bs+    where go = (,) <$> getWord32le <*> getWord32le++-- | Opens CDB database.+openCDB :: FilePath -> IO ReadCDB+openCDB fp = do+    ioh <- openBinaryFile fp ReadMode+    hSetBuffering ioh NoBuffering+    wps <- readWordPairs ioh 2048+    let v = V.fromList $ map (uncurry TOCHash) wps+    return $ ReadCDB ioh v++-- | Closes the database.+closeCDB :: ReadCDB -> IO ()+closeCDB (ReadCDB ioh _) = hClose ioh++getRecord :: Handle -> Word32 -> IO (B.ByteString, B.ByteString)+getRecord ioh sk = do+    hSeek ioh AbsoluteSeek (fromIntegral sk)+    [(ksz, vsz)] <- readWordPairs ioh 8+    k <- B.hGet ioh $ fromIntegral ksz+    v <- B.hGet ioh $ fromIntegral vsz+    return (k, v)++-- | Fetches key from the database.+getBS :: ReadCDB -> B.ByteString -> IO [B.ByteString]+getBS r@(ReadCDB ioh _) bs = do+    hSeek ioh AbsoluteSeek (fromIntegral $ hpos + slot * 8)+    wps <- readWordPairs ioh (fromIntegral $ (hlen - slot) * 8)+    let pairs = filter ((== h) . fst) $ takeWhile ((/= 0) . snd) wps+    kvs <- mapM (getRecord ioh . snd) pairs+    return $ map snd $ filter ((bs ==) . fst) kvs+    where (TOCHash hpos hlen, h) = tocFind r bs+          slot = hashSlot h hlen++updateTOC :: V.Vector HashState -> B.ByteString -> Word32 -> V.Vector HashState+updateTOC vec key cur = runST $ do+    v <- V.unsafeThaw vec+    hs <- MV.read v i+    MV.write v i (HashState (cnt hs) (pairs hs))+    V.unsafeFreeze v+    where hsh = cdbHash key+          cnt hs = hsCount hs + 1+          i = tocIndex hsh+          pairs hs = (hsh, cur):hsPairs hs++-- | Adds key and value to the CDB database.+addBS :: MonadIO m => B.ByteString -> B.ByteString -> WriteCDB m ()+addBS key val = WriteCDB $ do+    st <- get+    cur <- liftIO $ hTell (wsHandle st)+    liftIO $ BL.hPut (wsHandle st) buf+    put $ st { wsTOC = updateTOC (wsTOC st) key (fromIntegral cur) }+    where buf = runPut $ do+                putWord32le $ fromIntegral $ B.length key+                putWord32le $ fromIntegral $ B.length val+                putByteString key+                putByteString val++writePairs :: Handle -> [(Word32, Word32)] -> IO ()+writePairs ioh pairs = BL.hPut ioh buf where+    buf = runPut $ mapM_ one pairs+    one (a, b) = putWord32le a >> putWord32le b++writeOneHash :: Handle -> HashState -> IO (Word32, Word32)+writeOneHash ioh (HashState cnt pairs) = do+    cur <- hTell ioh+    writePairs ioh $ V.toList vec+    return (fromIntegral cur, fromIntegral $ V.length vec)+    where vec = createHashVector (1 + cnt * 2) (0, 0) pairs++-- | Runs WriteCDB monad transformer to make the database.+makeCDB :: MonadIO m => WriteCDB m a -> FilePath -> m a+makeCDB (WriteCDB m) fp = do+    ioh <- liftIO $ openBinaryFile (fp ++ ".tmp") WriteMode+    liftIO $ hSeek ioh AbsoluteSeek 2048+    (res, st) <- runStateT m $ WriteState ioh $ V.replicate 256 (HashState 0 [])+    tocs <- liftIO $ mapM (writeOneHash ioh) $ V.toList $ wsTOC st+    liftIO $ hSeek ioh AbsoluteSeek 0+    liftIO $ writePairs ioh tocs+    liftIO $ hClose ioh+    liftIO $ renameFile (fp ++ ".tmp") fp+    return res
+ Database/PureCDB/Internal.hs view
@@ -0,0 +1,46 @@+module Database.PureCDB.Internal where++import System.IO+import qualified Data.Vector as V+import Data.Word+import qualified Data.ByteString as B+import Data.Bits+import qualified Data.IntMap as I+import Data.List (foldl')++data TOCHash = TOCHash { hPosition :: Word32, hLength :: Word32 } deriving (Show)++-- | Read handle for the database.+data ReadCDB = ReadCDB { rHandle :: Handle, rTOC :: V.Vector TOCHash }++cdbHash :: B.ByteString -> Word32+cdbHash = B.foldl' go 5381 where go h c = ((h `shiftL` 5) + h) `xor` (fromIntegral c)++tocIndex :: Integral a => a -> Int+tocIndex h = fromIntegral $ h `mod` 256++tocFind :: ReadCDB -> B.ByteString -> (TOCHash, Word32)+tocFind (ReadCDB _ vec) bs = (vec V.! tocIndex h, h) where h = cdbHash bs ++layoutHash :: Int -> I.IntMap [a] -> Maybe [(Int, a)]+layoutHash sz = test . concat . foldl' go [] . I.toList where+    go l@(((li, _):_):_) p = (one li p):l+    go [] p = [one (-1) p]+    go ([]:_) _ = error "layoutHash: found empty list"+    one lastIdx (idx, as) = reverse $ zip [ (max idx $ lastIdx + 1) .. ] as+    test [] = Just []+    test l@(x:_) = if fst x >= sz then Nothing else Just l++coalesceHash :: Integral a => a -> [(a, b)] -> I.IntMap [(a, b)]+coalesceHash hlen = foldl' go I.empty where+    go im (a, b) = I.insertWith (++) (fromIntegral $ hashSlot a hlen) [(a, b)] im++createHashVector :: Integral a => a -> (a, b) -> [(a, b)] -> V.Vector (a, b)+createHashVector sz start l = maybe (createHashVector next start l) vec hsh+    where vec ups = V.replicate (fromIntegral sz) start V.// ups+          hsh = layoutHash (fromIntegral sz) $ coalesceHash sz l+          next = 1 + sz + (sz `div` 3)++hashSlot :: Integral a => a -> a -> a+hashSlot h hlen = (h `div` 256) `mod` hlen+
+ README view
@@ -0,0 +1,7 @@+pure-cdb is another (first being hs-cdb) Haskell library to read and write CDB files.++For more information on the CDB file format, please consult:+http://cr.yp.to/cdb.html++For more documentation please see:+http://hackage.haskell.org/package/pure-cdb
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ pure-cdb.cabal view
@@ -0,0 +1,54 @@+Name:           pure-cdb+Version:        0.1+License:        BSD3+License-File:   COPYING+Category:       Database+Synopsis:       Another pure-haskell CDB (Constant Database) implementation+Description:+    A library for reading and writing CDB (Constant Database) files.+    .+    CDB files are immutable key-value stores, designed for extremely fast and memory-efficient+    construction and lookup. They can be as large as 4GB, and at no point in their construction+    or use must all data be loaded into memory. CDB files can contain multiple values for a+    given key. +    .+    For more information on the CDB file format, please see: <http://cr.yp.to/cdb.html>+    .+    Please note, that there is another pure Haskell CDB library on Hackage:+    <http://hackage.haskell.org/package/hs-cdb>, using memory mapped bytestrings for IO.+    It served as an inspiration for this package.++Cabal-Version:  >= 1.10+Build-Type:     Simple+Author:         Boris Sukholitko <boriss@gmail.com>+Copyright:      Boris Sukholitko <boriss@gmail.com>+Maintainer:     Boris Sukholitko <boriss@gmail.com>+homepage:       https://github.com/bosu/pure-cdb+Stability:      Experimental++Extra-Source-Files:+    t/foo.cdb+    README++Library+    GHC-Options: -Wall+    Build-Depends: base (< 5), vector, binary, bytestring, containers, mtl, directory+    Default-Language: Haskell2010+    exposed-modules:  Database.PureCDB, Database.PureCDB.Internal++test-suite Test+    type:            exitcode-stdio-1.0+    build-depends:   base, test-simple, pure-cdb, vector, mtl, bytestring, containers, Unixutils+    ghc-options:     -Wall+    hs-source-dirs:  t+    main-is:         Test.hs+    Default-Language: Haskell2010++test-suite Words+    type:            exitcode-stdio-1.0+    build-depends:   base, pure-cdb, Unixutils, bytestring+    ghc-options:     -Wall+    hs-source-dirs:  t+    main-is:         Words.hs+    Default-Language: Haskell2010+
+ t/Test.hs view
@@ -0,0 +1,47 @@+{-# OPTIONS -fno-warn-unused-do-bind #-}+module Main(main) where++import Test.Simple+import Database.PureCDB+import qualified Data.Vector as V+import Control.Monad.Trans (liftIO)+import qualified Data.ByteString.Char8 as B+import qualified Data.IntMap as I+import System.Unix.Directory (withTemporaryDirectory)+import Database.PureCDB.Internal++main :: IO ()+main = withTemporaryDirectory "/tmp/pure_cdb_XXXXXXX" $ \td -> testSimpleMain $ do+    plan 13+    r <- liftIO $ openCDB "t/foo.cdb"+    is (V.findIndex ((> 0) . hLength) $ rTOC r) (Just 163)+    is ((cdbHash foo) `mod` 256) 163+    is (hPosition $ fst $ tocFind r foo) (hPosition $ rTOC r V.! 163)++    v <- liftIO $ getBS r foo+    is (map B.unpack v) [ "bar" ]++    is (layoutHash 2 $ I.fromList [ (1, [ 'a', 'b' ]) ]) Nothing+    is (layoutHash 2 $ I.fromList [ (0, [ 'a', 'b' ]) ])+        $ Just $ reverse [ (0, 'a'), (1, 'b') ]+    is (layoutHash 4 $ I.fromList [ (1, [ 'a', 'b' ]), (2, ['c']) ])+        $ Just $ reverse [ (1, 'a'), (2, 'b'), (3, 'c') ]+    is (layoutHash 4 $ I.fromList [ (1, [ 'a', 'b' ]), (2, ['c', 'd']) ]) Nothing++    is (coalesceHash (4 :: Int) [(259, 'a'), (263, 'b')])+        $ I.fromList [ (1, [ (263, 'b'), (259, 'a') ]) ]+    is (createHashVector 4 (0 :: Int, 'O') [(259, 'a'), (263, 'b')])+        $ V.fromList [(0,'O'),(263,'b'),(259,'a'),(0,'O')]+    is (createHashVector 2 (0 :: Int, 'O') [(259, 'a'), (263, 'b')])+        $ V.fromList [(0,'O'),(263,'b'),(259,'a')]+    is (createHashVector 1 (0 :: Int, 'O') [(259, 'a'), (263, 'b')])+        $ V.fromList [(0,'O'),(263,'b'),(259,'a')]++    liftIO $ makeCDB (addBS foo (B.pack "baz")) (td ++ "/j.out")+    r2 <- liftIO $ openCDB $ td ++ "/j.out"++    v2 <- liftIO $ getBS r2 foo+    is (map B.unpack v2) [ "baz" ]+    liftIO $ closeCDB r2+    liftIO $ closeCDB r+    where foo = B.pack "foo"
+ t/Words.hs view
@@ -0,0 +1,10 @@+module Main (main) where++import Database.PureCDB+import qualified Data.ByteString.Char8 as B+import System.Unix.Directory (withTemporaryDirectory)++main :: IO ()+main = withTemporaryDirectory "/tmp/pure_cdb_XXXXXXX" $ \td -> do+    ls <- B.lines `fmap` B.readFile "/usr/share/dict/words"+    makeCDB (mapM_ (\s -> addBS s s) ls) (td ++ "/j.out")
+ t/foo.cdb view

binary file changed (absent → 2078 bytes)