packages feed

sstable (empty) → 1.0

raw patch · 10 files changed

+476/−0 lines, 10 filesdep +QuickCheckdep +arraydep +basesetup-changed

Dependencies added: QuickCheck, array, base, binary, bytestring, cmdargs, containers, deepseq, directory, iteratee, test-framework, test-framework-quickcheck2

Files

+ LICENSE view
@@ -0,0 +1,25 @@+Copyright (c) 2010 marius a. eriksen (marius@monkey.org) +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.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ src/Data/SSTable.hs view
@@ -0,0 +1,17 @@+module Data.SSTable+  ( version+  , IndexEntry+  , Index+  ) where++import Data.Word++import qualified Data.ByteString as B+import Data.Int+import Data.Array (Array)++type IndexEntry = (B.ByteString, Int64, Int32)+type Index      = Array Int IndexEntry++version :: Word32+version = 2
+ src/Data/SSTable/Packing.hs view
@@ -0,0 +1,64 @@+module Data.SSTable.Packing+  ( -- * big-endian packs.+    pack32+  , pack64+  , unpack32+  , unpack64++    -- ** convenience functions for @Handle@s+  , hPut32+  , hPut64+  , hGet32+  , hGet64+  ) where++import Data.Bits+import Data.Word+import System.IO (Handle)+import qualified Data.ByteString as B++pack32 :: Word32 -> [Word8]+pack32 w =+  [ fromIntegral $ w `shiftR` 24 :: Word8+  , fromIntegral $ w `shiftR` 16 :: Word8+  , fromIntegral $ w `shiftR`  8 :: Word8+  , fromIntegral $ w             :: Word8 ]++pack64 :: Word64 -> [Word8]+pack64 w =+  pack32 high ++ pack32 low+  where+    high = fromIntegral $ w `shiftR` 32 :: Word32+    low  = fromIntegral $ w             :: Word32++unpack32 :: [Word8] -> Word32+unpack32 ws =+      w0 `shiftL` 24 +  .|. w1 `shiftL` 16+  .|. w2 `shiftL` 8+  .|. w3+  where+    w0 : w1 : w2 : w3 : [] = map fromIntegral $ take 4 ws+    +unpack64 :: [Word8] -> Word64+unpack64 ws =+  high `shiftL` 32 .|. low+  where+    high = fromIntegral . unpack32 $ take 4 ws+    low  = fromIntegral . unpack32 $ take 4 . drop 4 $ ws++hPut32 :: Handle -> Word32 -> IO ()+hPut32 h w = B.hPut h bytes+  where+    bytes = B.pack (pack32 w)++hPut64 :: Handle -> Word64 -> IO ()+hPut64 h w = B.hPut h bytes+  where+    bytes = B.pack (pack64 w)++hGet32 :: Handle -> IO Word32+hGet32 h = B.hGet h 4 >>= return . unpack32 . B.unpack++hGet64 :: Handle -> IO Word64+hGet64 h = B.hGet h 8 >>= return . unpack64 . B.unpack
+ src/Data/SSTable/Writer.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}++-- The data layout is described in the README.md accompanying this+-- project.++module Data.SSTable.Writer+  ( openWriter+  , closeWriter+  , withWriter+  , writeEntry+  ) where++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import System.IO (openFile, hSeek, hClose, Handle, SeekMode(..), IOMode(..))+import Control.Monad (unless, when, forM_, liftM)+import Data.Binary (Binary, encode)+import Data.IORef+import Data.Int (Int32, Int64)+import Data.Word (Word32, Word64)+import Text.Printf (printf)++import qualified Data.SSTable+import Data.SSTable.Packing++data Writer = Writer +  { offset    :: IORef Int64+  , blockLeft :: IORef Int32+  , index     :: IORef [IndexEntry]+  , handle    :: Handle+  , lastKey   :: IORef B.ByteString }++data IndexEntry = IndexEntry+  { key         :: B.ByteString+  , blockOffset :: Int64+  , blockLength :: Int32 }++blockSize = 64 * 1024++openWriter :: String -> IO Writer+openWriter path = do+  offset    <- newIORef $ 4{-VERSION-} + 4{-NUM-ENTRIES-} + 8{-INDEX-OFFSET-}+  blockLeft <- newIORef 0+  index     <- newIORef []+  lastKey   <- newIORef B.empty+  h         <- openFile path WriteMode++  -- Write out the header, filling in for values we do not yet have.+  hPut32 h Data.SSTable.version  -- VERSION+  hPut32 h 0                     -- NUM-ENTRIES    [ to be filled ]+  hPut64 h 0                     -- INDEX-OFFSET   [ to be filled ]++  return $! Writer {+      offset    = offset+    , blockLeft = blockLeft+    , index     = index+    , handle    = h+    , lastKey   = lastKey+  }++closeWriter :: Writer -> IO ()+closeWriter w@(Writer offset _ index h _) = do+  -- Ensure that the last block length is always filled in.+  fillLastBlockLen w++  index' <- liftM reverse $ readIORef index +  when (null index') $ error "no entries were defined"++  -- Write out the block count & index offset.+  hSeek h AbsoluteSeek 4+  hPut32 h $ fromIntegral $ length index'+  readIORef offset >>= hPut64 h . fromIntegral++  -- Write out the index at the end.+  hSeek h SeekFromEnd 0+  forM_ index' $ \(IndexEntry key blockOffset blockLength) -> do+    hPut32 h $ fromIntegral $ B.length key+    hPut64 h $ fromIntegral blockOffset+    hPut32 h $ fromIntegral blockLength+    B.hPut h key++  hClose h++fillLastBlockLen :: Writer -> IO ()+fillLastBlockLen (Writer _ blockLeft index _ _) = do+  blockLeftVal <- readIORef blockLeft+  modifyIORef index $ \index ->+    case index of+      e : es -> e { blockLength = blockSize - blockLeftVal } : es+      [] -> []++writeEntry :: Writer -> (B.ByteString, B.ByteString) -> IO ()+writeEntry w@(Writer offset blockLeft index h lastKey) (key, value) = do+  keyGreaterThanLast <- readIORef lastKey >>= return . (> key)+  when keyGreaterThanLast $ error "entry keys out of order"++  newBlock <- readIORef blockLeft >>= return . (<= 0)+  when newBlock $ do+    -- Write an index entry with a placeholder length value (we'll+    -- fill that in).  It's a new block!+    fillLastBlockLen w++    blockOffset <- readIORef offset+    let entry = IndexEntry key blockOffset 0+    modifyIORef index ((:) entry)+    writeIORef blockLeft blockSize++  B.hPut h keyLen32+  B.hPut h valueLen32  +  B.hPut h key+  B.hPut h value++  writeIORef  lastKey   key+  modifyIORef blockLeft (+ (- entryLen))+  modifyIORef offset    (+ fromIntegral entryLen)++  where+    keyLen32   = B.pack $ pack32 $ fromIntegral keyLen+    valueLen32 = B.pack $ pack32 $ fromIntegral valueLen+    entryLen   = 4 + 4 + (fromIntegral keyLen) + (fromIntegral valueLen)+    valueLen   = B.length value+    keyLen     = B.length key++withWriter :: String -> (Writer -> IO a) -> IO a+withWriter path f = do+  writer <- openWriter path+  a <- f writer+  closeWriter writer+  return a
+ src/sstable.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Main where++import System.Console.CmdArgs+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import System.IO (isEOF)+import Data.Char (isSpace)+import Control.Monad (forM_, unless)++import Data.SSTable.Writer+import Data.SSTable.Reader++data Args +  = Write { path :: FilePath }+  | Read  { path :: FilePath }+  deriving (Show, Data, Typeable)++writeMode = mode $ Write { path = def &= argPos 0 & typFile }+readMode  = mode $ Read  { path = def &= argPos 0 & typFile }++main = doit =<< cmdArgs "sstable" [writeMode, readMode]++doit (Write path) = withWriter path go+  where+    go writer = do+      eof <- isEOF+      unless eof $ parseLine writer >> go writer++    strip :: B.ByteString -> B.ByteString+    strip = B8.dropWhile isSpace+    keyValue line = let (k, v) = B8.break isSpace line in (strip k, strip v)++    parseLine writer = writeEntry writer . keyValue =<< B.getLine++doit (Read path) = withReader path enum+  where +    enum reader = do+      entries <- scan reader B.empty+      forM_ entries $ \(key, value) -> do+        B.putStr key+        putStr " => "+        B.putStrLn value
+ sstable.cabal view
@@ -0,0 +1,58 @@+cabal-version: >= 1.6+name:          sstable+version:       1.0+build-type:    Simple+license:       BSD3+license-file:  LICENSE+author:        marius a. eriksen+category:      Data+synopsis:      SSTables in Haskell+description:+    .+    This library implements SSTables as described in the Bigtable+    paper: <http://labs.google.com/papers/bigtable.html>+    .+maintainer:    marius a. eriksen+copyright:     (c) 2010 marius a. eriksen++flag tests+  description: Build test executables.+  default:     False++library+  hs-source-dirs: src+  build-depends: +    base == 4.*, containers >= 0.2, +    bytestring >= 0.9, binary >= 0.5, +    deepseq >= 1.1, array >= 0.2, +    iteratee >= 0.3.4, directory >= 1.0+  exposed-modules:+    Data.SSTable, Data.SSTable.Writer, Data.SSTable.Packing++  ghc-options: -Wall -fwarn-tabs -funbox-strict-fields++executable sstable+  hs-source-dirs: src++  main-is: sstable.hs++  build-depends:+    cmdargs >= 0.1++  ghc-options: -Wall -fwarn-tabs -funbox-strict-fields++executable testSSTable+  hs-source-dirs:+    test+    src++  main-is: Test.hs+  other-modules: PackingTest, BinarySearchTest++  if flag(tests)+    build-depends:+      QuickCheck >= 2 && < 3, test-framework >= 0.2,+      test-framework-quickcheck2 >= 0.2+  else+    executable: False+    buildable:  False
+ test/BinarySearchTest.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE FlexibleInstances #-}++module BinarySearchTest where++import Test.QuickCheck+import Test.QuickCheck.Gen+import Test.QuickCheck.Arbitrary++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as C8+import Data.List+import Data.Array+import Data.SSTable.Reader+import Data.Maybe+import Data.Int++import System.IO.Unsafe++import Debug.Trace+import Text.Printf++-- Create a newtype so we can have our own arbitrary instance.+newtype IndexList+ = IA { unIA :: [(B.ByteString, Int64, Int32)] }+   deriving (Show)++instance Arbitrary B.ByteString where+  arbitrary = arbitrary >>= return . C8.pack++instance Arbitrary Int64 where+  arbitrary = (arbitrary :: Gen Integer) >>= return . fromIntegral++instance Arbitrary Int32 where+  arbitrary = (arbitrary :: Gen Integer) >>= return . fromIntegral++instance Arbitrary IndexList where+  -- Creates an indexlist of sizes between 5 and 200.+  arbitrary = arbitrary >>= return . min 200 . max 5 >>= vector >>= return . IA++fst3 (x, _, _) = x++-- Filter out adjacent keys.+makeSearchList l = nubBy (\(a, _, _) (b, _, _) -> a == b) (sort l)+toArray l        = listArray (0, (length l) - 1) l+makeSearchIndex  = toArray . makeSearchList++-- Make sure we find each item.+prop_binary_search_works :: IndexList -> Bool+prop_binary_search_works (IA l) = go ((snd . bounds) index)+  where+    index = makeSearchIndex l++    go (-1) = True+    go n = leastUpperBound index (fst3 $ index!n) == Just n && (go $ n - 1)++prop_arbitrary_lookups_work :: IndexList -> B.ByteString -> Bool+prop_arbitrary_lookups_work (IA l) key =+  case leastUpperBound index key of+    Just n  -> key <= (fst3 $ index!n)+    Nothing ->+      let (l, u) = bounds index in+      l > u || key > (fst3 $ index!u)+  where+    index = makeSearchIndex l++prop_querying_outside_range_works :: IndexList -> B.ByteString -> Property+prop_querying_outside_range_works (IA l) key =+  len > 0 ==>+    -- strings longer by suffix are always bigger (at least in+    -- whatever collation i'm using(!))+    leastUpperBound index (B.concat [biggestKey, C8.singleton 'a']) == Nothing+  where+    l' = makeSearchList l+    index = toArray l'+    len = length l'+    (biggestKey, _, _) = index!(len - 1)++prop_ensure_boundedness :: IndexList -> Int -> Property+prop_ensure_boundedness (IA l) which =+  length l' > 2 ==>+    leastUpperBound index pickVal == Just pick+  where+    l'              = makeSearchList l+    pick            = (abs which) `mod` (((length l') - 2) + 1)+    l''             = take pick l' ++ drop (pick + 1) l'+    index           = toArray l''+    (pickVal, _, _) = l'!!pick
+ test/PackingTest.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE ScopedTypeVariables #-}+module PackingTest where++import Test.QuickCheck+import Test.QuickCheck.Gen+import Test.QuickCheck.Arbitrary++import Data.Bits+import Data.Word+import Data.Int+import Data.SSTable.Packing++instance Arbitrary Word32 where+  arbitrary = (arbitrary :: Gen Integer) >>= return . fromIntegral++instance Arbitrary Word64 where+  arbitrary = do +    -- Generate from low & high word32s so we make sure we cover+    -- enough bits to test meaningfully.+    low  :: Word32 <- arbitrary+    high :: Word32 <- arbitrary+    return $ (fromIntegral high) `shiftL` 32 .|. (fromIntegral low)++prop_pack32_id :: Word32 -> Bool +prop_pack32_id w = (unpack32 . pack32) w == w++prop_pack64_id :: Word64 -> Bool +prop_pack64_id w = (unpack64 . pack64) w == w+
+ test/Test.hs view
@@ -0,0 +1,20 @@+module Main where++import Test.Framework (defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import PackingTest+import BinarySearchTest++main = defaultMain tests+  where+    tests = [packing, binarySearch]+    packing = testGroup "Packing"+      [ testProperty "32-bit packing" prop_pack32_id+      , testProperty "64-bit packing" prop_pack64_id ]++    binarySearch = testGroup "Binary search"+      [ testProperty "querying" prop_binary_search_works+      , testProperty "arbitrary lookups" prop_arbitrary_lookups_work+      , testProperty "querying outside range" prop_querying_outside_range_works+      , testProperty "ensure boundedness" prop_ensure_boundedness ]