indexation 0.5.0.1 → 0.6.0.1

raw patch · 18 files changed

+292/−131 lines, 18 filesdep +cereal-vectordep +contravariantdep +dense-int-setdep −hashtablesdep ~basedep ~deferred-foldsdep ~potokiPVP ok

version bump matches the API change (PVP)

Dependencies added: cereal-vector, contravariant, dense-int-set, foldl, list-t, stm-containers

Dependencies removed: hashtables

Dependency ranges changed: base, deferred-folds, potoki

API changes (from Hackage documentation)

Files

• indexation.cabal +16/−7
• library/Indexation/Cereal/Get.hs +3/−2
• library/Indexation/Cereal/Put.hs +4/−3
• library/Indexation/Constructors/EntityTable.hs +0/−14
• library/Indexation/Data.hs +3/−19
• library/Indexation/FoldM/Basic.hs +14/−0
• library/Indexation/FoldM/Index.hs +12/−0
• library/Indexation/Functions.hs +56/−0
• library/Indexation/IO.hs +9/−9
• library/Indexation/Instances.hs +4/−0
• library/Indexation/Instances/Cereal.hs +6/−2
• library/Indexation/Potoki/Produce.hs +28/−0
• library/Indexation/Potoki/Transform.hs +17/−9
• library/Indexation/Predicate.hs +15/−0
• library/Indexation/Prelude.hs +28/−2
• library/Indexation/Types.hs +16/−2
• library/Indexation/Utils/Vector.hs +61/−0
• library/Indexation/Vector.hs +0/−62

@@ -1,5 +1,5 @@ name: indexation-version: 0.5.0.1+version: 0.6.0.1 category: Data synopsis: Tools for entity indexation description: A set of tools for indexing entities@@ -20,28 +20,37 @@   exposed-modules:     Indexation.Data     Indexation.IO+    Indexation.Predicate+    Indexation.Potoki.Produce     Indexation.Potoki.Transform+    Indexation.FoldM.Index   other-modules:     Indexation.Cereal.Get     Indexation.Cereal.Put-    Indexation.Constructors.EntityTable     Indexation.Instances     Indexation.Instances.Cereal     Indexation.Prelude     Indexation.Types-    Indexation.Vector+    Indexation.Functions+    Indexation.FoldM.Basic+    Indexation.Utils.Vector   build-depends:-    base >=4.7 && <5,+    base >=4.11 && <5,     bytestring >=0.10.8 && <0.11,     cereal >=0.5.5 && <0.6,-    deferred-folds >=0.6 && <0.7,+    cereal-vector >=0.2.0.1 && <0.3,+    contravariant >=1.4 && <2,+    deferred-folds >=0.9.6 && <0.10,+    dense-int-set >=0.1.5 && <0.2,     focus >=1.0.1 && <1.1,+    foldl >=1 && <2,     hashable >=1 && <2,-    hashtables >=1.2.3.1 && <1.3,+    list-t >=1 && <1.1,     mmorph >=1 && <2,-    potoki >=2 && <2.1,+    potoki >=2.0.15 && <2.1,     potoki-cereal >=0.3 && <0.4,     profunctors >=5.2 && <6,+    stm-containers >=1.1 && <1.2,     text >=1 && <2,     transformers >=0.5 && <0.6,     unordered-containers >=0.2.9 && <0.3,

@@ -5,7 +5,7 @@ import Indexation.Types import Data.Serialize.Get import qualified Data.HashMap.Strict as A-import qualified Data.Vector as B+import qualified Data.Vector.Generic as B   getIndexHashMap :: (Eq k, Hashable k) => Get k -> Get (HashMap k Int)@@ -33,7 +33,8 @@           entity <- getEntity           return (A.insert entity index hashMap) -getVector :: Get element -> Get (Vector element)+{-# INLINE getVector #-}+getVector :: B.Vector vector element => Get element -> Get (vector element) getVector getElement =   getSize >>= getElements   where

@@ -4,15 +4,16 @@ import Indexation.Prelude import Indexation.Types import Data.Serialize.Put-import qualified Data.Vector as B+import qualified Data.Vector.Generic as B  -putVector :: Putter element -> Putter (Vector element)+{-# INLINE putVector #-}+putVector :: (B.Vector vector element) => Putter element -> Putter (vector element) putVector putElement vector =   putSize *> putElements   where     putSize = putInt64le (fromIntegral (B.length vector))-    putElements = traverse_ putElement vector+    putElements = B.foldM'_ (const putElement) () vector  putEntityTable :: Putter entity -> Putter (EntityTable entity) putEntityTable putEntity (EntityTable vector) =

@@ -1,14 +0,0 @@-module Indexation.Constructors.EntityTable-where--import Indexation.Prelude hiding (lookup)-import Indexation.Types-import qualified Indexation.Vector as A---indexTable :: IndexTable entity -> EntityTable entity-indexTable (IndexTable size table) =-  EntityTable vector-  where-    vector =-      A.indexHashMapWithSize size table

@@ -1,25 +1,9 @@ module Indexation.Data (-  Index(..),-  EntityTable,-  IndexTable,-  Indexer,-  lookupEntity,-  lookupIndex,+  module Exports, ) where -import Indexation.Prelude-import Indexation.Types+import Indexation.Types as Exports (Index(..), EntityTable, IndexTable, ReindexTable, Indexer, IndexSet, IndexCounts) import Indexation.Instances ()-import qualified Data.Vector as Vector-import qualified Data.HashMap.Strict as HashMap---lookupEntity :: Index entity -> EntityTable entity -> Maybe entity-lookupEntity (Index indexPrim) (EntityTable vector) =-  vector Vector.!? indexPrim--lookupIndex :: (Eq entity, Hashable entity) => entity -> IndexTable entity -> Maybe (Index entity)-lookupIndex entity (IndexTable _ hashMap) =-  fmap Index (HashMap.lookup entity hashMap)+import Indexation.Functions as Exports

@@ -0,0 +1,14 @@+module Indexation.FoldM.Basic+where++import Indexation.Prelude+import Control.Foldl+import qualified Data.Vector.Unboxed as UnboxedVector+import qualified Data.Vector.Unboxed.Mutable as MutableUnboxedVector+++countIndices :: Int -> FoldM IO Int (UnboxedVector.Vector Word32)+countIndices amount = FoldM step init extract where+  init = MutableUnboxedVector.new amount+  step mv index = MutableUnboxedVector.modify mv succ index $> mv+  extract = UnboxedVector.unsafeFreeze

@@ -0,0 +1,12 @@+module Indexation.FoldM.Index+where++import Indexation.Prelude+import Indexation.Types+import Indexation.Data+import Control.Foldl+import qualified Indexation.FoldM.Basic as Basic+++indexCounts :: Int -> FoldM IO (Index a) (IndexCounts a)+indexCounts amount = dimap (\ (Index x) -> x) IndexCounts (Basic.countIndices amount)

@@ -0,0 +1,56 @@+module Indexation.Functions+where++import Indexation.Prelude+import Indexation.Types+import qualified Data.Vector as Vector+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Vector.Unboxed as UnboxedVector+import qualified Data.Vector.Unboxed.Mutable as MutableUnboxedVector+import qualified DeferredFolds.Unfoldr as Unfoldr+import qualified DenseIntSet+import qualified Indexation.Utils.Vector as Vector+++indexTableEntityTable :: IndexTable entity -> EntityTable entity+indexTableEntityTable (IndexTable size table) =+  EntityTable (Vector.indexHashMapWithSize size table)++lookupEntity :: Index entity -> EntityTable entity -> Maybe entity+lookupEntity (Index indexPrim) (EntityTable vector) =+  vector Vector.!? indexPrim++lookupIndex :: (Eq entity, Hashable entity) => entity -> IndexTable entity -> Maybe (Index entity)+lookupIndex entity (IndexTable _ hashMap) =+  fmap Index (HashMap.lookup entity hashMap)++createIndexSet :: (Eq entity, Hashable entity, Foldable foldable) => IndexTable entity -> foldable entity -> IndexSet entity+createIndexSet (IndexTable size map) entities =+  IndexSet (DenseIntSet.foldable size (Unfoldr.hashMapValues map (Unfoldr.foldable entities)))++lookupInIndexSet :: Index entity -> IndexSet entity -> Bool+lookupInIndexSet (Index indexInt) (IndexSet set) = DenseIntSet.lookup indexInt set++lookupNewIndex :: Index entity -> ReindexTable entity -> Maybe (Index entity)+lookupNewIndex (Index oldIndexInt) (ReindexTable mapVector) = fmap Index (join (mapVector Vector.!? oldIndexInt))++mergeIndexSets :: IndexSet entity -> IndexSet entity -> IndexSet entity+mergeIndexSets (IndexSet a) (IndexSet b) = IndexSet (DenseIntSet.intersection (DenseIntSet.compose a <> DenseIntSet.compose b))++topCountedIndexSet :: Int -> IndexCounts a -> IndexSet a+topCountedIndexSet amount (IndexCounts countVec) = IndexSet (DenseIntSet.topValueIndices compare amount countVec)++indexSetByMinCount :: Word32 -> IndexCounts a -> IndexSet a+indexSetByMinCount min (IndexCounts countVec) = IndexSet (DenseIntSet.filteredIndices (>= min) countVec)++countIndexSet :: IndexSet a -> Int+countIndexSet (IndexSet set) = DenseIntSet.size set++newIndexToOldIndexTable :: IndexSet a -> EntityTable (Index a)+newIndexToOldIndexTable (IndexSet set) = EntityTable (coerce (DenseIntSet.presentElementsVector set :: Vector Int))++oldIndexToNewIndexTable :: IndexSet a -> ReindexTable a+oldIndexToNewIndexTable (IndexSet set) = ReindexTable (DenseIntSet.indexVector set)++filterEntityTable :: IndexSet a -> EntityTable a -> EntityTable a+filterEntityTable (IndexSet set) (EntityTable vec) = EntityTable (DenseIntSet.filterVector set vec)

@@ -22,26 +22,26 @@ import qualified Potoki.Cereal.Consume as PotokiConsume import qualified Potoki.Cereal.Produce as PotokiProduce import qualified Indexation.Potoki.Transform as PotokiTransform-import qualified Indexation.Vector as Vector-import qualified Data.HashTable.IO as HashtablesIO+import qualified Indexation.Utils.Vector as Vector+import qualified StmContainers.Map as StmMap import qualified Data.Serialize as Cereal import qualified Data.ByteString as ByteString   createIndexer :: IO (Indexer entity) createIndexer = do-  sizeRef <- newIORef 0-  map <- HashtablesIO.new-  return (Indexer sizeRef map)+  sizeVar <- newTVarIO 0+  map <- StmMap.newIO+  return (Indexer sizeVar map)  getIndexerSize :: Indexer entity -> IO Int-getIndexerSize (Indexer sizeRef _) = readIORef sizeRef+getIndexerSize (Indexer sizeVar _) = atomically (readTVar sizeVar)  freezeIndexerAsVector :: Indexer entity -> IO (Vector entity)-freezeIndexerAsVector (Indexer sizeRef map) =+freezeIndexerAsVector (Indexer sizeVar map) =   do-    size <- readIORef sizeRef-    Vector.hashTable size map+    size <- atomically (readTVar sizeVar)+    Vector.listTInIO size (hoist atomically (fmap swap (StmMap.listT map)))  freezeIndexerAsEntityTable :: Indexer entity -> IO (EntityTable entity) freezeIndexerAsEntityTable = fmap EntityTable . freezeIndexerAsVector

@@ -4,9 +4,13 @@ import Indexation.Prelude import Indexation.Types import Indexation.Instances.Cereal ()+import Indexation.Functions   instance Show (Index a) where show (Index int) = show int deriving instance Eq (Index a) deriving instance Ord (Index a) deriving instance Hashable (Index a)++instance Show (IndexSet a) where+  show = show . (\ (IndexSet x) -> x)

@@ -6,7 +6,7 @@ import Data.Serialize import qualified Indexation.Cereal.Get as Get import qualified Indexation.Cereal.Put as Put-import qualified Indexation.Constructors.EntityTable as EntityTable+import qualified Indexation.Functions as Functions   instance Serialize (Index a) where@@ -19,4 +19,8 @@  instance (Serialize entity, Eq entity, Hashable entity) => Serialize (IndexTable entity) where   get = Get.getIndexTableAsEntityTable get-  put = Put.putEntityTable put . EntityTable.indexTable+  put = Put.putEntityTable put . Functions.indexTableEntityTable++deriving instance Serialize (IndexSet a)++deriving instance Serialize (IndexCounts a)

@@ -0,0 +1,28 @@+module Indexation.Potoki.Produce+(+  entities,+  counts,+  indexedCounts,+)+where++import Indexation.Prelude+import Indexation.Types+import qualified Potoki.Produce as Produce+import qualified Data.Vector.Generic as GenericVector+++entities :: EntityTable a -> Produce a+entities (EntityTable vector) = Produce.vector vector++{-|+Counts in the index-order.+-}+counts :: IndexCounts a -> Produce Word32+counts (IndexCounts vector) = Produce.vector vector++{-|+Counts in the index-order paired with their indices.+-}+indexedCounts :: IndexCounts a -> Produce (Int, Word32)+indexedCounts (IndexCounts vector) = Produce.vectorWithIndices vector

@@ -4,7 +4,9 @@   Index(..),   Indexer,   EntityTable,+  ReindexTable,   index,+  reindex,   lookup, ) where@@ -14,23 +16,29 @@ import Indexation.Instances () import Potoki.Transform import qualified Focus-import qualified Data.HashTable.IO as HashtablesIO+import qualified StmContainers.Map as StmMap import qualified Data.Vector as Vector+import qualified Indexation.Functions as Functions   index :: (Eq entity, Hashable entity) => Indexer entity -> Transform entity (Index entity)-index (Indexer sizeRef map) =-  mapInIO $ \ entity -> HashtablesIO.mutateIO map entity mutation+index (Indexer sizeVar map) =+  {-# SCC "index" #-} +  mapInIO $ \ entity -> atomically $ StmMap.focus focus entity map   where-    mutation = \ case-      Just indexInt -> return (Just indexInt, Index indexInt) -      Nothing -> do-        size <- readIORef sizeRef-        writeIORef sizeRef $! succ size-        return (Just size, Index size)+    focus = Focus.Focus conceal reveal where+      conceal = do+        size <- readTVar sizeVar+        writeTVar sizeVar $! succ size+        return (Index size, Focus.Set size)+      reveal indexInt = return (Index indexInt, Focus.Leave) +reindex :: ReindexTable entity -> Transform (Index entity) (Index entity)+reindex table = mapFilter (\ oldIndex -> Functions.lookupNewIndex oldIndex table)+ lookup :: EntityTable entity -> Transform (Index entity) (Maybe entity) lookup (EntityTable entityTableVector) =+  {-# SCC "lookup" #-}    arr $ \ (Index indexInt) -> if Vector.length entityTableVector > indexInt     then Just $! Vector.unsafeIndex entityTableVector indexInt     else Nothing

@@ -0,0 +1,15 @@+module Indexation.Predicate+where++import Indexation.Prelude hiding (not)+import Indexation.Types+import Indexation.Instances ()+import qualified Indexation.Prelude as Prelude+import qualified Indexation.Functions as Functions+++negated :: Predicate a -> Predicate a+negated (Predicate fn) = Predicate (Prelude.not . fn)++inIndexSet :: IndexSet a -> Predicate (Index a)+inIndexSet indexSet = Predicate (\ index -> Functions.lookupInIndexSet index indexSet)

@@ -1,6 +1,7 @@ module Indexation.Prelude (   module Exports,+  UnboxedVector, ) where @@ -82,9 +83,15 @@  -- deferred-folds --------------------------import DeferredFolds.Unfold as Exports (Unfold(..))-import DeferredFolds.UnfoldM as Exports (UnfoldM(..))+import DeferredFolds.Unfoldl as Exports (Unfoldl(..))+import DeferredFolds.UnfoldlM as Exports (UnfoldlM(..))+import DeferredFolds.Unfoldr as Exports (Unfoldr(..)) +-- contravariant+-------------------------+import Data.Functor.Contravariant as Exports+import Data.Functor.Contravariant.Divisible as Exports+ -- hashable ------------------------- import Data.Hashable as Exports (Hashable(..))@@ -101,6 +108,10 @@ ------------------------- import Data.Serialize as Exports (Serialize) +-- cereal-vector+-------------------------+import Data.Vector.Serialize ()+ -- bytestring ------------------------- import Data.ByteString as Exports (ByteString)@@ -122,3 +133,18 @@ -- mmorph ------------------------- import Control.Monad.Morph as Exports hiding (MonadTrans(..))++-- list-t+-------------------------+import ListT as Exports (ListT(..))++-- dense-int-set+-------------------------+import DenseIntSet as Exports (DenseIntSet)++-- +-------------------------+import qualified Data.Vector.Unboxed as UnboxedVector+++type UnboxedVector = UnboxedVector.Vector

@@ -2,13 +2,27 @@ where  import Indexation.Prelude-import qualified Data.HashTable.IO as HashtablesIO+import qualified StmContainers.Map as StmMap+import qualified Data.Vector.Unboxed as UnboxedVector  -data Indexer entity = Indexer {-# UNPACK #-} !(IORef Int) {-# UNPACK #-} !(HashtablesIO.BasicHashTable entity Int)+data Indexer entity = Indexer {-# UNPACK #-} !(TVar Int) {-# UNPACK #-} !(StmMap.Map entity Int)  data IndexTable entity = IndexTable {-# UNPACK #-} !Int {-# UNPACK #-} !(HashMap entity Int) +{-|+Map from old to new indices.+-}+newtype ReindexTable entity = ReindexTable (Vector (Maybe Int))+ newtype EntityTable entity = EntityTable (Vector entity)  newtype Index entity = Index Int++{-|+Set of indices.+A more efficient alternative to @HashSet (Index entity)@.+-}+newtype IndexSet entity = IndexSet DenseIntSet++newtype IndexCounts entity = IndexCounts (UnboxedVector.Vector Word32)

@@ -0,0 +1,61 @@+module Indexation.Utils.Vector+where++import Indexation.Prelude+import Data.Vector+import qualified Data.Vector.Mutable as MutableVector+import qualified Data.HashMap.Strict as HashMap+import qualified DeferredFolds.UnfoldlM as UnfoldlM+import qualified ListT+++{-|+This function is not tested.+-}+{-# NOINLINE populate #-}+populate :: Monad effect => Int -> effect (Int, element) -> effect (Vector element)+populate size effect =+  do+    mv <- return (unsafeDupablePerformIO (MutableVector.unsafeNew size))+    let+      loop stepsRemaining =+        if stepsRemaining > 0+          then do+            (index, element) <- effect+            () <- return (unsafeDupablePerformIO (MutableVector.write mv index element))+            loop (pred stepsRemaining)+          else do+            !v <- return (unsafeDupablePerformIO (freeze mv))+            return v+      in loop size++{-|+This function is partial. It doesn't check the size or indices.+-}+{-# INLINE indexHashMapWithSize #-}+indexHashMapWithSize :: Int -> HashMap element Int -> Vector element+indexHashMapWithSize size hashMap =+  runST $ do+    mv <- MutableVector.new size+    HashMap.foldrWithKey+      (\ element index action -> MutableVector.write mv index element >> action)+      (return ())+      hashMap+    freeze mv++{-# NOINLINE unfoldlM #-}+unfoldlM :: Monad m => Int -> UnfoldlM m (Int, element) -> m (Vector element)+unfoldlM size unfoldlM =+  let+    step mv (index, element) = return (unsafeDupablePerformIO (MutableVector.write mv index element $> mv))+    in do+      !mv <- return (unsafeDupablePerformIO (MutableVector.unsafeNew size))+      UnfoldlM.foldlM' step mv unfoldlM+      !iv <- return (unsafeDupablePerformIO (unsafeFreeze mv))+      return iv++listTInIO :: Int -> ListT IO (Int, element) -> IO (Vector element)+listTInIO size listT = do+  mv <- MutableVector.unsafeNew size+  flip ListT.traverse_ listT $ \ (index, element) -> MutableVector.write mv index element+  unsafeFreeze mv

@@ -1,62 +0,0 @@-module Indexation.Vector-where--import Indexation.Prelude-import Data.Vector-import qualified Data.Vector.Mutable as MutableVector-import qualified Data.HashMap.Strict as HashMap-import qualified DeferredFolds.UnfoldM as UnfoldM-import qualified Data.HashTable.IO as HashtablesIO-import qualified Data.HashTable.Class as HashtablesClass---{-|-This function is not tested.--}-{-# NOINLINE populate #-}-populate :: Monad effect => Int -> effect (Int, element) -> effect (Vector element)-populate size effect =-  do-    mv <- return (unsafeDupablePerformIO (MutableVector.unsafeNew size))-    let-      loop stepsRemaining =-        if stepsRemaining > 0-          then do-            (index, element) <- effect-            () <- return (unsafeDupablePerformIO (MutableVector.write mv index element))-            loop (pred stepsRemaining)-          else do-            !v <- return (unsafeDupablePerformIO (freeze mv))-            return v-      in loop size--{-|-This function is partial. It doesn't check the size or indices.--}-{-# INLINE indexHashMapWithSize #-}-indexHashMapWithSize :: Int -> HashMap element Int -> Vector element-indexHashMapWithSize size hashMap =-  runST $ do-    mv <- MutableVector.new size-    HashMap.foldrWithKey-      (\ element index action -> MutableVector.write mv index element >> action)-      (return ())-      hashMap-    freeze mv--{-# NOINLINE unfoldM #-}-unfoldM :: Monad m => Int -> UnfoldM m (Int, element) -> m (Vector element)-unfoldM size unfoldM =-  let-    step mv (index, element) = return (unsafeDupablePerformIO (MutableVector.write mv index element $> mv))-    in do-      !mv <- return (unsafeDupablePerformIO (MutableVector.unsafeNew size))-      UnfoldM.foldlM' step mv unfoldM-      !iv <- return (unsafeDupablePerformIO (unsafeFreeze mv))-      return iv--hashTable :: HashtablesClass.HashTable t => Int -> HashtablesIO.IOHashTable t element Int -> IO (Vector element)-hashTable size hashTable = do-  mv <- MutableVector.unsafeNew size-  flip HashtablesIO.mapM_ hashTable $ \ (element, index) -> MutableVector.write mv index element-  unsafeFreeze mv