popkey 0.0.0.1 → 0.1.0.0

raw patch · 5 files changed

+141/−90 lines, 5 filesdep −profunctorsdep ~storePVP ok

version bump matches the API change (PVP)

Dependencies removed: profunctors

Dependency ranges changed: store

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• popkey.cabal +2/−2
• src/PopKey.hs +18/−48
• src/PopKey/Internal3.hs +108/−35
• test/Spec.hs +9/−5

@@ -1,5 +1,9 @@ # Revision history for popkey +## 0.1.0.0+- Drop profunctor instance in exchange for keyed folding+- Add Store instance+ ## 0.0.0.1  - Initial release

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                popkey-version:             0.0.0.1+version:             0.1.0.0 synopsis:            Static key-value storage backed by poppy description:         Static key-value storage backed by poppy. homepage:            https://github.com/identicalsnowflake/popkey@@ -33,7 +33,6 @@                , hw-prim >= 0.6.3.0                , hw-rankselect >= 0.13.4.0 && < 0.14                , hw-rankselect-base >= 0.3.4.0-               , profunctors >= 5.5.2 && < 5.6                , store >= 0.7.2 && < 0.8                , text >= 1.2.4.0 && < 1.3                , vector >= 0.12.1.2 && < 0.13@@ -69,6 +68,7 @@                , containers                , hspec >= 2 && < 3                , popkey+               , store                , QuickCheck >= 2.13.2 && < 2.14   build-tool-depends: hspec-discover:hspec-discover   default-language: Haskell2010

@@ -36,10 +36,19 @@ -- @ -- -- Poppy natively supports array-style indexing, so if your "key" set is simply the dense set of integers  @[ 0 .. n - 1 ]@ where @n@ is the number of items in your data set, key storage may be left implicit and elided entirely. In this API, when the distinction is necessary, working with such an implicit index is signified by a trailing ', e.g., @storage@ vs @storage'@.+--+-- Note that constant-factor space & time overhead is fairly high, so unless you have at least a couple thousand items, it is recommended to avoid PopKey. Once you have 10k+ items, the asymptotics should win out, and PopKey should perform well.  module PopKey        ( type PopKey-       , module PopKey+       , (!)+       , PopKey.lookup+       , makePopKey+       , makePopKey'+       , foldrWithKey+       , foldlWithKey'+       , storage+       , storage'        , StoreBlob(..)        , PopKeyEncoding        , PopKeyStore@@ -47,9 +56,7 @@        , StorePopKey(..)        ) where -import Data.Bifunctor import qualified Data.ByteString as BS-import Data.List (sortOn) import Data.Store (encode , decodeEx) import GHC.Word import HaskellWorks.Data.FromForeignRegion@@ -62,60 +69,23 @@  {-# INLINE (!) #-} -- | Lookup by a key known to be in the structure.-(!) :: PopKey k v -> k -> v-(!) (PopKeyInt p vd ke) k = vd do rawq (ke k) p-(!) (PopKeyAny pv vd ke pk) k =-  vd do rawq (bin_search2 pk (ke k) 0 (flength pk - 1)) pv+(!) :: PopKeyEncoding k => PopKey k v -> k -> v+(!) (PopKeyInt _ p vd) k = vd do rawq k p+(!) (PopKeyAny _ pv vd pk) k =+  vd do rawq (bin_search2 pk (pkEncode k) 0 (flength pk - 1)) pv  {-# INLINE lookup #-} -- | Lookup by a key which may or may not be in the structure.-lookup :: PopKey k v -> k -> Maybe v-lookup s@(PopKeyInt p vd ke) (ke -> i) = if i >= 0 && i < length s+lookup :: PopKeyEncoding k => PopKey k v -> k -> Maybe v+lookup s@(PopKeyInt _ p vd) i = if i >= 0 && i < length s   then Just (vd do rawq i p)   else Nothing-lookup (PopKeyAny pv vd ke pk) k = do-  let i = bin_search2 pk (ke k) 0 (flength pk - 1)+lookup (PopKeyAny _ pv vd pk) k = do+  let i = bin_search2 pk (pkEncode k) 0 (flength pk - 1)   if i == -1      then Nothing      else Just (vd do rawq i pv) -{-# INLINE makePopKey #-}--- | Create a poppy-backed key-value storage structure.-makePopKey :: forall f k v . (Foldable f , PopKeyEncoding k , PopKeyEncoding v) => f (k , v) -> PopKey k v-makePopKey =-  makePopKeyWithEncoding (shape @k) (pkEncode @k) (shape @v) (pkEncode @v) (pkDecode @v)-  where-    makePopKeyWithEncoding :: Foldable f-                           => I s1 -> (k -> F' s1 BS.ByteString)-                           -> I s2 -> (v -> F' s2 BS.ByteString) -> (F' s2 BS.ByteString -> v)-                           -> f (k , v)-                           -> PopKey k v-    makePopKeyWithEncoding ik ek iv ev dv xs = do-      let (ks , vs) = unzip (lastv $ sortOn fst (foldr ((:) . first ek) [] xs))-      PopKeyAny do construct iv ev vs-                do dv-                do ek-                do construct ik id ks-      where-        -- for duplicate keys, use the last value-        lastv :: forall a b . Ord a => [(a,b)] -> [(a,b)]-        lastv [] = []-        lastv [ x ] = [ x ]-        lastv (x : ys@(y : _)) =-          if fst x == fst y-             then lastv ys-             else x : lastv ys---- | Create a poppy-backed structure with elements implicitly indexed by their position.-{-# INLINE makePopKey' #-}-makePopKey' :: forall f v . (Foldable f , PopKeyEncoding v) => f v -> PopKey Int v-makePopKey' = go (shape @v) (pkEncode @v) (pkDecode @v) . foldr (:) []-  where-    go :: I s -> (a -> F' s BS.ByteString) -> (F' s BS.ByteString -> a) -> [ a ] -> PopKey Int a-    go i e d xs =-      PopKeyInt do construct i e xs-                do d-                do id  -- | You may use @storage@ to gain a pair of operations to serialize and read your structure from disk. This will be more efficient than if you naively serialize and store the data, as it strictly reads index metadata into memory while leaving the larger raw chunks to be backed by mmap. storage :: (PopKeyEncoding k , PopKeyEncoding v)

@@ -4,12 +4,15 @@  module PopKey.Internal3 where +import Data.Bifunctor import qualified Data.ByteString as BS+import Data.Functor.Contravariant import HaskellWorks.Data.RankSelect.CsPoppy import qualified HaskellWorks.Data.RankSelect.CsPoppy.Internal.Alpha0 as A0 import qualified HaskellWorks.Data.RankSelect.CsPoppy.Internal.Alpha1 as A1-import Data.Profunctor-import Data.Store (encode , decodeEx)+import Data.Foldable+import Data.List (sortOn)+import Data.Store import GHC.Generics hiding (R) import GHC.Word import Unsafe.Coerce@@ -19,29 +22,50 @@ import PopKey.Encoding  -data PopKey k v =-    forall s . PopKeyInt !(F s PKPrim) (F' s BS.ByteString -> v) (k -> Int)-  | forall s1 s2 . PopKeyAny !(F s1 PKPrim) (F' s1 BS.ByteString -> v) (k -> F' s2 BS.ByteString) !(F s2 PKPrim)+-- Bool here is whether the decoding function is the canonical decoding function from when+-- the index was first built. it allows the Store instance to skip re-building the structure+-- before serialization. the Functor instance should still be observably-valid from the safe public API,+-- at least modulo bottoms and the fact that mapping the identity will cause performance artefacts.+data PopKey k v where+  PopKeyInt :: forall s v . Bool -> F s PKPrim -> (F' s BS.ByteString -> v) -> PopKey Int v+  PopKeyAny :: forall s k v . Bool -> F s PKPrim -> (F' s BS.ByteString -> v) -> F (Shape k) PKPrim -> PopKey k v  instance Functor (PopKey k) where   {-# INLINE fmap #-}-  fmap f (PopKeyInt p d e) = PopKeyInt p (f . d) e-  fmap f (PopKeyAny pv d e pk) = PopKeyAny pv (f . d) e pk--instance Profunctor PopKey where-  {-# INLINE dimap #-}-  dimap f g (PopKeyInt p d e) = PopKeyInt p (g . d) (e . f)-  dimap f g (PopKeyAny pv d e pk) = PopKeyAny pv (g . d) (e . f) pk+  fmap f (PopKeyInt _ p d) = PopKeyInt False p (f . d)+  fmap f (PopKeyAny _ pv d pk) = PopKeyAny False pv (f . d) pk  instance Foldable (PopKey k) where   {-# INLINE foldr #-}-  foldr f z p@(PopKeyInt pr vd _) = foldr (\i -> f (vd do rawq i pr)) z [ 0 .. (length p - 1) ]-  foldr f z p@(PopKeyAny pr vd _ _) = foldr (\i -> f (vd do rawq i pr)) z [ 0 .. (length p - 1) ]+  foldr f z p@(PopKeyInt _ pr vd) = foldr (\i -> f (vd do rawq i pr)) z [ 0 .. (length p - 1) ]+  foldr f z p@(PopKeyAny _ pr vd _) = foldr (\i -> f (vd do rawq i pr)) z [ 0 .. (length p - 1) ]    {-# INLINE length #-}-  length (PopKeyInt p _ _) = flength p+  length (PopKeyInt _ p _) = flength p   length (PopKeyAny _ _ _ p) = flength p +{-# INLINABLE foldrWithKey #-}+foldrWithKey :: PopKeyEncoding k => (k -> v -> b -> b) -> b -> PopKey k v -> b+foldrWithKey f z p@(PopKeyInt _ pr vd) =+  foldr do \i -> f i (vd do rawq i pr)+        do z+        do [ 0 .. (length p - 1) ]+foldrWithKey f z p@(PopKeyAny _ pr vd pk) =+  foldr do \i -> f (pkDecode $ rawq i pk) (vd do rawq i pr)+        do z+        do [ 0 .. (length p - 1) ]++{-# INLINABLE foldlWithKey' #-}+foldlWithKey' :: PopKeyEncoding k => (a -> k -> v -> a) -> a -> PopKey k v -> a+foldlWithKey' f z p@(PopKeyInt _ pr vd) =+  foldl' do \a i -> f a i (vd do rawq i pr)+         do z+         do [ 0 .. (length p - 1) ]+foldlWithKey' f z p@(PopKeyAny _ pr vd pk) =+  foldl' do \a i -> f a (pkDecode $ rawq i pk) (vd do rawq i pr)+         do z+         do [ 0 .. (length p - 1) ]  + ------------------------------------------- -- PopKey serialization for mmap loading -- -------------------------------------------@@ -109,21 +133,6 @@     let (a01 , a02 , a11 , a12) = decodeEx bs     CsPoppy (decodeEx bv) (A0.CsPoppyIndex a01 a02) (A1.CsPoppyIndex a11 a12) --- newtype L a = L a deriving (Generic)--- newtype R a = R a deriving (Generic)---- instance Store a => BiSerialize (L a) where---   {-# INLINE bencode #-}---   bencode (L x) = (encode x , mempty)---   {-# INLINE bdecode #-}---   bdecode (b , _) = L do decodeEx b---- instance Store a => BiSerialize (R a) where---   {-# INLINE bencode #-}---   bencode (R x) = (mempty , encode x)---   {-# INLINE bdecode #-}---   bdecode (_ , b) = R do decodeEx b- instance BiSerialize BS.ByteString where   {-# INLINE bencode #-}   bencode x = (mempty , x)@@ -178,16 +187,80 @@   deriving (Generic,BiSerialize)  toSPopKey :: PopKey k v -> SPopKey k v-toSPopKey (PopKeyInt p _ _) = SPopKeyInt (fromF p)-toSPopKey (PopKeyAny p1 _ _ p2) = SPopKeyAny (fromF p1) (fromF p2)+toSPopKey (PopKeyInt _ p _) = SPopKeyInt (fromF p)+toSPopKey (PopKeyAny _ p1 _ p2) = SPopKeyAny (fromF p1) (fromF p2)  fromSPopKey :: forall k v . (PopKeyEncoding k , PopKeyEncoding v) => SPopKey k v -> PopKey k v-fromSPopKey (SPopKeyInt p) = PopKeyInt (toF p) (pkDecode @v) (unsafeCoerce id)-fromSPopKey (SPopKeyAny pv pk) = PopKeyAny (toF pv) (pkDecode @v) (pkEncode @k) (toF pk)+fromSPopKey (SPopKeyInt p) = unsafeCoerce (PopKeyInt True (toF p) (pkDecode @v))+fromSPopKey (SPopKeyAny pv pk) = PopKeyAny True (toF pv) (pkDecode @v) (toF pk)  fromSPopKey' :: PopKeyEncoding v => SPopKey Int v -> PopKey Int v-fromSPopKey' (SPopKeyInt p) = PopKeyInt (toF p) pkDecode (unsafeCoerce id)+fromSPopKey' (SPopKeyInt p) = PopKeyInt True (toF p) pkDecode fromSPopKey' _ = error "Incorrect PopKey type: expected Int."++-- re-encode using whatever the current value encoding is+{-# INLINABLE normalise #-}+normalise :: (PopKeyEncoding k , PopKeyEncoding v) => PopKey k v -> PopKey k v+normalise p@(PopKeyInt True _ _) = p+normalise p@(PopKeyInt _ _ _) =+  makePopKey' (toList p)+normalise p@(PopKeyAny True _ _ _) = p+normalise p@(PopKeyAny _ _ _ _) =+  makePopKey (foldrWithKey (\k v -> (:) (k,v)) [] p)++toStoreEnc :: (PopKeyEncoding k , PopKeyEncoding v) => PopKey k v -> (Bool , BS.ByteString , BS.ByteString)+toStoreEnc (normalise -> p) = do+  let (b1 , b2) = bencode (toSPopKey p)+  case p of+    PopKeyInt _ _ _ -> (True , b1 , b2)+    PopKeyAny _ _ _ _ -> (False , b1 , b2)++fromStoreEnc :: forall k v . (PopKeyEncoding k , PopKeyEncoding v) => (Bool , BS.ByteString , BS.ByteString) -> PopKey k v+fromStoreEnc (True , b1 , b2) = unsafeCoerce (fromSPopKey' (bdecode (b1 , b2) :: SPopKey Int v))+fromStoreEnc (False , b1 , b2) = fromSPopKey (bdecode (b1 , b2))++instance (PopKeyEncoding k , PopKeyEncoding v) => Store (PopKey k v) where+  size = contramap toStoreEnc size+  peek = fmap fromStoreEnc peek+  poke = poke . toStoreEnc++{-# INLINE makePopKey #-}+-- | Create a poppy-backed key-value storage structure.+makePopKey :: forall f k v . (Foldable f , PopKeyEncoding k , PopKeyEncoding v) => f (k , v) -> PopKey k v+makePopKey =+  makePopKeyWithEncoding (shape @k) (shape @v) (pkEncode @v) (pkDecode @v)+  where+    makePopKeyWithEncoding :: Foldable f+                           => I (Shape k)+                           -> I s -> (v -> F' s BS.ByteString) -> (F' s BS.ByteString -> v)+                           -> f (k , v)+                           -> PopKey k v+    makePopKeyWithEncoding ik iv ev dv xs = do+      let (ks , vs) = unzip (lastv $ sortOn fst (foldr ((:) . first pkEncode) [] xs))+      PopKeyAny do True+                do construct iv ev vs+                do dv+                do construct ik id ks+      where+        -- for duplicate keys, use the last value+        lastv :: forall a b . Ord a => [(a,b)] -> [(a,b)]+        lastv [] = []+        lastv [ x ] = [ x ]+        lastv (x : ys@(y : _)) =+          if fst x == fst y+             then lastv ys+             else x : lastv ys++-- | Create a poppy-backed structure with elements implicitly indexed by their position.+{-# INLINE makePopKey' #-}+makePopKey' :: forall f v . (Foldable f , PopKeyEncoding v) => f v -> PopKey Int v+makePopKey' = go (shape @v) (pkEncode @v) (pkDecode @v) . foldr (:) []+  where+    go :: I s -> (a -> F' s BS.ByteString) -> (F' s BS.ByteString -> a) -> [ a ] -> PopKey Int a+    go i e d xs =+      PopKeyInt do True+                do construct i e xs+                do d  data PopKeyStore k v =   PopKeyStore (forall f . Foldable f => f (k , v) -> IO ())

@@ -2,6 +2,7 @@  import Data.Foldable import qualified Data.Map as M+import qualified Data.Store as S import GHC.Word import Test.Hspec import Test.QuickCheck@@ -9,22 +10,25 @@ import PopKey  +scode :: S.Store a => a -> a+scode = S.decodeEx . S.encode+ main :: IO () main = hspec $ do   describe "PopKey" $ do     it "sanity checks for fixed-size data" $ property \(xs :: [ Int ]) ->-      toList (makePopKey' xs) == xs+      toList (scode $ fmap (+1) $ makePopKey' xs) == fmap (+1) xs      it "sanity checks for fixed-size data" $ property \(xs :: [ (Int , Word8) ]) ->-      toList (makePopKey' xs) == xs+      toList (scode $ makePopKey' xs) == xs      it "sanity checks for var-size data" $ property \(xs :: [ [ Int ] ]) ->-      toList (makePopKey' xs) == xs+      toList (scode $ makePopKey' xs) == xs      it "sanity checks for var-size data" $ property \(xs :: [ String ]) ->-      toList (makePopKey' xs) == xs+      toList (scode $ makePopKey' xs) == xs -    it "sanity checks for key data" $ property \(xs :: [ (Int , Word8) ]) -> do+    it "sanity checks for key data" $ property \(xs :: [ (String , Int) ]) -> do       let m = M.fromList xs           pk = makePopKey xs           ks = fst <$> xs