summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorhverr <>2017-09-13 14:30:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-09-13 14:30:00 (GMT)
commita87324299208ff71edb2011186c7ddf61cb366f8 (patch)
tree9f69f38a0004ad4fb1fe185cf7338c0f1a5c0971
parentc10867b035215976486f0773ca39e1524f07299d (diff)
version 0.2.0.0HEAD0.2.0.0master
-rw-r--r--haskey-btree.cabal6
-rw-r--r--src/Data/BTree/Impure.hs3
-rw-r--r--src/Data/BTree/Impure/Lookup.hs26
-rw-r--r--src/Data/BTree/Primitives/Index.hs14
-rw-r--r--src/Data/BTree/Primitives/Key.hs2
-rw-r--r--src/Data/BTree/Primitives/Value.hs2
6 files changed, 48 insertions, 5 deletions
diff --git a/haskey-btree.cabal b/haskey-btree.cabal
index 2dd93f5..e91bdcf 100644
--- a/haskey-btree.cabal
+++ b/haskey-btree.cabal
@@ -1,5 +1,5 @@
name: haskey-btree
-version: 0.1.0.0
+version: 0.2.0.0
synopsis: B+-tree implementation in Haskell.
description:
This package provides two B+-tree implementations. The first one is a pure
@@ -68,12 +68,10 @@ library
binary >=0.6 && <0.9 || >0.9 && <1,
bytestring >=0.10 && <1,
containers >=0.5 && <1,
- focus >=0.1.2 && <0.2,
hashable >=1.2 && <1.3,
- list-t >=0.2 && <2,
mtl >=2.1 && <3,
semigroups >=0.12 && <1,
- stm >=2.1 && <3,
+ text >=1.2 && <2,
transformers >=0.3 && <1,
vector >=0.10 && <1
diff --git a/src/Data/BTree/Impure.hs b/src/Data/BTree/Impure.hs
index 2e36d1a..6b55dcb 100644
--- a/src/Data/BTree/Impure.hs
+++ b/src/Data/BTree/Impure.hs
@@ -20,6 +20,7 @@ module Data.BTree.Impure (
-- * Lookup
, lookupTree
, lookupMinTree
+, lookupMaxTree
-- * Folds
, foldr
@@ -40,7 +41,7 @@ import Data.BTree.Impure.Delete (deleteTree)
import Data.BTree.Impure.Structures (Tree(..), Node(..))
import Data.BTree.Impure.Fold (foldr, foldrM, foldrWithKey, foldrWithKeyM, foldMap, toList)
import Data.BTree.Impure.Insert (insertTree, insertTreeMany)
-import Data.BTree.Impure.Lookup (lookupTree, lookupMinTree)
+import Data.BTree.Impure.Lookup (lookupTree, lookupMinTree, lookupMaxTree)
import Data.BTree.Primitives
diff --git a/src/Data/BTree/Impure/Lookup.hs b/src/Data/BTree/Impure/Lookup.hs
index a5d7d0e..9fc11b0 100644
--- a/src/Data/BTree/Impure/Lookup.hs
+++ b/src/Data/BTree/Impure/Lookup.hs
@@ -85,4 +85,30 @@ lookupMinTree tree
lookupMin m | M.null m = Nothing
| otherwise = Just $! M.findMin m
+-- | The maximal key of the map, returns 'Nothing' if the map is empty.
+lookupMaxTree :: (AllocReaderM m, Key key, Value val)
+ => Tree key val
+ -> m (Maybe (key, val))
+lookupMaxTree tree
+ | Tree { treeRootId = Nothing } <- tree = return Nothing
+ | Tree { treeHeight = height
+ , treeRootId = Just rootId } <- tree
+ = lookupMaxRec height rootId
+ where
+ lookupMaxRec :: (AllocReaderM m, Key key, Value val)
+ => Height height
+ -> NodeId height key val
+ -> m (Maybe (key, val))
+ lookupMaxRec h nid = readNode h nid >>= \case
+ Idx children -> let (_, childId) = valViewMax children in
+ lookupMaxRec (decrHeight h) childId
+ Leaf items -> case lookupMax items of
+ Nothing -> return Nothing
+ Just (k, v) -> do
+ v' <- fromLeafValue v
+ return $ Just (k, v')
+
+ lookupMax m | M.null m = Nothing
+ | otherwise = Just $! M.findMax m
+
--------------------------------------------------------------------------------
diff --git a/src/Data/BTree/Primitives/Index.hs b/src/Data/BTree/Primitives/Index.hs
index 6e218f1..1c207ab 100644
--- a/src/Data/BTree/Primitives/Index.hs
+++ b/src/Data/BTree/Primitives/Index.hs
@@ -265,6 +265,20 @@ valViewMin (Index keys vals)
| otherwise
= throw $ TreeAlgorithmError "valViewMin" "cannot split an empty index"
+valViewMax :: Index key val -> (IndexCtx key val, val)
+valViewMax (Index keys vals)
+ | Just (leftVals, val) <- vecUnsnoc vals
+ = ( IndexCtx
+ { indexCtxLeftKeys = keys
+ , indexCtxRightKeys = V.empty
+ , indexCtxLeftVals = leftVals
+ , indexCtxRightVals = V.empty
+ },
+ val
+ )
+ | otherwise
+ = throw $ TreeAlgorithmError "valViewMax" "cannot split an empty index"
+
-- | Distribute a map of key-value pairs over an index.
distribute :: Ord k => M.Map k v -> Index k node -> Index k (M.Map k v, node)
distribute kvs (Index keys nodes)
diff --git a/src/Data/BTree/Primitives/Key.hs b/src/Data/BTree/Primitives/Key.hs
index c6c91f6..168f7f0 100644
--- a/src/Data/BTree/Primitives/Key.hs
+++ b/src/Data/BTree/Primitives/Key.hs
@@ -3,6 +3,7 @@ module Data.BTree.Primitives.Key where
import Data.ByteString (ByteString)
import Data.Int
+import Data.Text (Text)
import Data.Word
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
@@ -29,6 +30,7 @@ instance Key Int16
instance Key Int32
instance Key Int64
instance Key Integer
+instance Key Text
instance Key Word8
instance Key Word16
instance Key Word32
diff --git a/src/Data/BTree/Primitives/Value.hs b/src/Data/BTree/Primitives/Value.hs
index dcf026e..d437fe5 100644
--- a/src/Data/BTree/Primitives/Value.hs
+++ b/src/Data/BTree/Primitives/Value.hs
@@ -7,6 +7,7 @@ import Data.Binary (Binary)
import Data.ByteString (ByteString)
import Data.Int
import Data.Proxy (Proxy (..))
+import Data.Text
import Data.Typeable
import Data.Word
@@ -34,6 +35,7 @@ instance Value Word64 where fixedSize _ = Just 8
instance Value ByteString
instance Value Integer
+instance Value Text
instance (Value k1, Value k2) => Value (k1,k2) where
fixedSize _ =