packages feed

b-tree 0.1.3 → 0.1.4

raw patch · 4 files changed

+36/−28 lines, 4 filesdep +vector-binary-instancesdep ~basedep ~bytestringdep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies added: vector-binary-instances

Dependency ranges changed: base, bytestring, containers, lens, transformers, vector

API changes (from Hackage documentation)

Files

b-tree.cabal view
@@ -1,5 +1,5 @@ name:                b-tree-version:             0.1.3+version:             0.1.4 synopsis:            Immutable disk-based B* trees description:         Immutable disk-based B* trees homepage:            http://github.com/bgamari/b-tree@@ -36,18 +36,19 @@                        GeneralizedNewtypeDeriving    hs-source-dirs:      src-  build-depends:       base >=4.6 && <4.11,+  build-depends:       base >=4.6 && <4.13,                        mtl >=2.0 && <3.0,                        pipes >=4.1 && <4.4,                        pipes-interleave >= 1.0 && <2.2,                        bytestring >=0.10 && <0.11,-                       binary >=0.8.4 && <0.10,+                       binary >=0.8.4 && <0.11,                        transformers >=0.3 && <0.6,-                       lens >=3.10 && <4.16,-                       containers >=0.5 && <0.6,+                       lens >=3.10 && <4.18,+                       containers >=0.5 && <0.7,                        vector >=0.10 && <0.13,-                       errors >=2.0 && <2.3,-                       exceptions >= 0.8 && < 0.9,+                       vector-binary-instances >= 0.2 && < 0.3,+                       errors >=2.0 && <2.4,+                       exceptions >= 0.8 && < 0.11,                        filepath >=1.3 && <1.5,                        directory >=1.2 && <1.4,                        mmap >=0.5 && <0.6@@ -77,5 +78,4 @@                        b-tree,                        pipes,                        criterion >=0.8 && <2.0-  default-language:    Haskell2010 
src/BTree/Builder.hs view
@@ -24,6 +24,7 @@ import qualified Data.Binary as B import           Data.Binary (Binary) import qualified Data.ByteString.Lazy as LBS+import qualified Data.Vector as V  import Pipes import Pipes.Core@@ -115,12 +116,14 @@     isFilled :: BuildM k e m Bool     isFilled = zoom (singular _head) $ do         nodeCount <- use dNodeCount-        minFill:_ <- use dMinFill-        return $ nodeCount >= minFill+        minFills <- use dMinFill+        return $ case minFills of+                   minFill:_ -> nodeCount >= minFill+                   _ -> error "BTree.Builder.isFilled: minFills empty"      emitNode :: BuildM k e m (OnDisk (BTree k OnDisk e))     emitNode = do-        (k0,node0):nodes <- zoom (singular _head) $ do+        nodes <- zoom (singular _head) $ do             nodes <- uses dNodes F.toList             dNodes .= Seq.empty             dNodeCount .= 0@@ -131,7 +134,8 @@         -- is wrong. nodes may be empty, for instance, when we are call from         -- the [_] branch of flushAll. -        let newNode = Node node0 nodes+        let (k0,node0):nodes' = nodes+            newNode = Node node0 (V.fromList nodes')         s <- get         case s of             [_] -> lift $ respond newNode
src/BTree/Lookup.hs view
@@ -9,6 +9,7 @@ import Control.Error import Control.Lens hiding (children) import qualified Data.ByteString as BS+import qualified Data.Vector as V import qualified Data.ByteString.Lazy as LBS import Data.Binary import System.IO.MMap@@ -42,13 +43,15 @@     go (Leaf (BLeaf k' e))       | k' == k     = Just e       | otherwise   = Nothing-    go (Node c0 []) = go $ fetch lt c0 -- is this case necessary?-    go (Node c0 children@((k0,_):_))-      | k < k0      = go $ fetch lt c0+    go (Node c0 children)+      | V.null children = go $ fetch lt c0 -- is this case necessary?+      | let (k0,_) = V.head children+      , k < k0      = go $ fetch lt c0       | otherwise   =-          case takeWhile (\(k',_)->k' <= k) children of-            []  -> Nothing-            xs  -> go $ fetch lt $ snd $ last xs+          case V.takeWhile (\(k',_)->k' <= k) children of+            rest+              | V.null rest -> Nothing+              | otherwise   -> go $ fetch lt $ snd $ V.last rest  -- | How many keys are in a 'LookupTree'. size :: LookupTree k e -> Size
src/BTree/Types.hs view
@@ -11,7 +11,7 @@ import Control.Applicative import Data.Maybe (fromMaybe) import GHC.Generics-import Control.Monad (when, replicateM)+import Control.Monad (when) import Data.Int import Prelude @@ -19,6 +19,8 @@ import Data.Binary.Get import Data.Binary.Put import Control.Lens+import qualified Data.Vector as V+import Data.Vector.Binary import qualified Data.ByteString as BS  -- | An offset within the stream@@ -68,7 +70,7 @@ -- -- The 'Node' constructor contains a left child, and a list of key/child pairs -- where each child's keys are greater than or equal to the given key.-data BTree k f e = Node (f (BTree k f e)) [(k, f (BTree k f e))]+data BTree k f e = Node (f (BTree k f e)) (V.Vector (k, f (BTree k f e)))                  | Leaf !(BLeaf k e)                  deriving (Generic) @@ -83,18 +85,17 @@                1 -> bleaf <$> get <*> get                _ -> fail "BTree.Types/get: Unknown node type"       where bleaf k v = Leaf (BLeaf k v)-            getChildren = do-                len <- getWord32be-                replicateM (fromIntegral len) $ (,) <$> get <*> get+            getChildren =+                genericGetVectorWith (fromIntegral <$> getWord32be) ((,) <$> get <*> get)     {-# INLINE get #-}      -- some versions of binary don't inline the Binary (,) instance, pitiful     -- performance ensues-    put (Node e0 es)         = do putWord8 0-                                  put e0-                                  putWord32be (fromIntegral $ length es)-                                  mapM_ (\(a,b) -> put a >> put b) es-    put (Leaf (BLeaf k0 e))  =    putWord8 1 >> put k0 >> put e+    put (Node e0 es) = do+        putWord8 0+        put e0+        genericPutVectorWith (putWord32be . fromIntegral) (\(a,b) -> put a >> put b) es+    put (Leaf (BLeaf k0 e)) = putWord8 1 >> put k0 >> put e     {-# INLINE put #-}  magic :: Word64