indexation 0.4.3 → 0.4.4

raw patch · 12 files changed

+166/−90 lines, 12 filesdep +contravariantdep ~deferred-foldsdep ~stm-containersPVP ok

version bump matches the API change (PVP)

Dependencies added: contravariant

Dependency ranges changed: deferred-folds, stm-containers

API changes (from Hackage documentation)

Files

• indexation.cabal +9/−4
• library/Indexation/Constructors/EntityTable.hs +1/−1
• library/Indexation/Data.hs +3/−19
• library/Indexation/Functions.hs +27/−0
• library/Indexation/IO.hs +1/−1
• library/Indexation/Predicate.hs +16/−0
• library/Indexation/Prelude.hs +8/−2
• library/Indexation/Types.hs +9/−2
• library/Indexation/Utils/UnboxedVector.hs +14/−0
• library/Indexation/Utils/Unfoldr.hs +17/−0
• library/Indexation/Utils/Vector.hs +61/−0
• library/Indexation/Vector.hs +0/−61

@@ -1,5 +1,5 @@ name: indexation-version: 0.4.3+version: 0.4.4 category: Data synopsis: Tools for entity indexation description: A set of tools for indexing entities@@ -20,6 +20,7 @@   exposed-modules:     Indexation.Data     Indexation.IO+    Indexation.Predicate     Indexation.Potoki.Produce     Indexation.Potoki.Transform   other-modules:@@ -30,12 +31,16 @@     Indexation.Instances.Cereal     Indexation.Prelude     Indexation.Types-    Indexation.Vector+    Indexation.Functions+    Indexation.Utils.Vector+    Indexation.Utils.UnboxedVector+    Indexation.Utils.Unfoldr   build-depends:     base >=4.11 && <5,     bytestring >=0.10.8 && <0.11,     cereal >=0.5.5 && <0.6,-    deferred-folds >=0.6 && <0.7,+    contravariant >=1.4 && <2,+    deferred-folds >=0.7 && <0.8,     focus >=1.0.1 && <1.1,     hashable >=1 && <2,     list-t >=1 && <1.1,@@ -43,7 +48,7 @@     potoki >=2 && <2.1,     potoki-cereal >=0.3 && <0.4,     profunctors >=5.2 && <6,-    stm-containers >=1.0.1 && <1.1,+    stm-containers >=1.1 && <1.2,     text >=1 && <2,     transformers >=0.5 && <0.6,     unordered-containers >=0.2.9 && <0.3,

@@ -3,7 +3,7 @@  import Indexation.Prelude hiding (lookup) import Indexation.Types-import qualified Indexation.Vector as A+import qualified Indexation.Utils.Vector as A   indexTable :: IndexTable entity -> EntityTable entity

@@ -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, Indexer, IndexSet) 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,27 @@+module Indexation.Functions+where++import Indexation.Prelude+import Indexation.Types+import Indexation.Instances ()+import qualified Data.Vector as Vector+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Vector.Unboxed as UnboxedVector+import qualified Indexation.Utils.UnboxedVector as UnboxedVector+import qualified Indexation.Utils.Unfoldr as Unfoldr+++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 (UnboxedVector.filledIndicesFoldable size (Unfoldr.hashMapValuesByKeys entities map))++lookupInIndexSet :: Index entity -> IndexSet entity -> Bool+lookupInIndexSet (Index indexInt) (IndexSet vec) = vec UnboxedVector.!? indexInt & fromMaybe False

@@ -22,7 +22,7 @@ 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 Indexation.Utils.Vector as Vector import qualified StmContainers.Map as StmMap import qualified Data.Serialize as Cereal import qualified Data.ByteString as ByteString

@@ -0,0 +1,16 @@+module Indexation.Predicate+where++import Indexation.Prelude hiding (not)+import Indexation.Types+import Indexation.Instances ()+import qualified Indexation.Prelude as Prelude+import qualified Indexation.Utils.UnboxedVector as UnboxedVector+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)

@@ -82,8 +82,14 @@  -- 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 -------------------------

@@ -2,13 +2,20 @@ where  import Indexation.Prelude-import qualified StmContainers.Map as A+import qualified StmContainers.Map as StmMap+import qualified Data.Vector.Unboxed as UnboxedVector  -data Indexer entity = Indexer {-# UNPACK #-} !(TVar Int) {-# UNPACK #-} !(A.Map entity Int)+data Indexer entity = Indexer {-# UNPACK #-} !(TVar Int) {-# UNPACK #-} !(StmMap.Map entity Int)  data IndexTable entity = IndexTable {-# UNPACK #-} !Int {-# UNPACK #-} !(HashMap entity 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 (UnboxedVector.Vector Bool)

@@ -0,0 +1,14 @@+module Indexation.Utils.UnboxedVector+where++import Indexation.Prelude hiding (Vector)+import Data.Vector.Unboxed hiding (forM_)+import qualified Data.Vector.Unboxed.Mutable as MutableUnboxedVector+++filledIndicesFoldable :: Foldable foldable => Int -> foldable Int -> Vector Bool+filledIndicesFoldable size foldable = runST $ do+  mv <- MutableUnboxedVector.new size+  forM_ foldable $ \ index -> do+    MutableUnboxedVector.unsafeWrite mv index True+  unsafeFreeze mv

@@ -0,0 +1,17 @@+module Indexation.Utils.Unfoldr+where++import Indexation.Prelude+import Indexation.Types+import Indexation.Instances+import DeferredFolds.Unfoldr+import qualified Data.HashMap.Strict as HashMap+++hashMapAt :: (Hashable a, Eq a) => a -> HashMap a b -> Unfoldr b+hashMapAt a = foldable . HashMap.lookup a++hashMapValuesByKeys :: (Hashable a, Eq a, Foldable foldable) => foldable a -> HashMap a b -> Unfoldr b+hashMapValuesByKeys keys hashMap = do+  key <- foldable keys+  hashMapAt key hashMap

@@ -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,61 +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 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 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--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