packages feed

indexation 0.1 → 0.2

raw patch · 15 files changed

+66/−136 lines, 15 filesdep +textdep ~potoki-cereal

Dependencies added: text

Dependency ranges changed: potoki-cereal

Files

indexation.cabal view
@@ -1,7 +1,7 @@ name:   indexation version:-  0.1+  0.2 category:   Data synopsis:@@ -41,21 +41,20 @@   default-language:     Haskell2010   exposed-modules:+    Indexation.EntityTable     Indexation.Index     Indexation.IndexTable-    Indexation.EntityTable     Indexation.IO-    Indexation.Folds   other-modules:-    Indexation.Instances.Cereal-    Indexation.Potoki.Fetch-    Indexation.Potoki.Transform-    Indexation.Types     Indexation.Cereal.Get     Indexation.Cereal.Put+    Indexation.Constructors.EntityTable+    Indexation.Folds+    Indexation.Instances.Cereal+    Indexation.Potoki.Transform     Indexation.Prelude+    Indexation.Types     Indexation.Vector-    Indexation.HashMap   build-depends:     base >=4.7 && <5,     bytestring >=0.10.8 && <0.11,@@ -65,10 +64,11 @@     foldl >=1 && <2,     hashable >=1 && <2,     list-t >=1 && <1.1,-    potoki-cereal >=0.2.1.1 && <0.3,+    potoki-cereal >=0.3 && <0.4,     potoki-core >=2.2 && <2.3,     profunctors >=5.2 && <6,     stm-containers >=0.2.16 && <0.3,     transformers >=0.4 && <0.6,+    text >=1 && <2,     unordered-containers >=0.2.9 && <0.3,     vector >=0.12 && <0.13
library/Indexation/Cereal/Get.hs view
@@ -5,7 +5,6 @@ import Indexation.Types import Data.Serialize.Get import qualified Data.HashMap.Strict as A-import qualified Indexation.HashMap as A import qualified Data.Vector as B
library/Indexation/Cereal/Put.hs view
@@ -4,38 +4,15 @@ import Indexation.Prelude import Indexation.Types import Data.Serialize.Put-import qualified Data.HashMap.Strict as A-import qualified Indexation.HashMap as A import qualified Data.Vector as B  -putHashMapWithSize :: Putter k -> Putter v -> Putter (HashMap k v)-putHashMapWithSize keyPutter valuePutter hashMap =-  size *> associations-  where-    size = putInt64le (fromIntegral (A.size hashMap))-    associations = A.traverse_ association hashMap-    association key value = keyPutter key *> valuePutter value- putVector :: Putter element -> Putter (Vector element) putVector putElement vector =   putSize *> putElements   where     putSize = putInt64le (fromIntegral (B.length vector))     putElements = traverse_ putElement vector--{-|-It's recommended to use 'putIndexTableAsEntityTable' instead.-The hashmap traversal implementation is inefficient and-the representation of 'EntityTable' is more compact.--}-putIndexTableDirectly :: Putter entity -> Putter (IndexTable entity)-putIndexTableDirectly putEntity (IndexTable size hashMap) =-  putSize *> putAssociations-  where-    putSize = putInt64le (fromIntegral size)-    putAssociations = A.traverse_ putAssociation hashMap-    putAssociation key entity = putEntity key *> putInt64le (fromIntegral entity)  putEntityTable :: Putter entity -> Putter (EntityTable entity) putEntityTable putEntity (EntityTable vector) =
+ library/Indexation/Constructors/EntityTable.hs view
@@ -0,0 +1,14 @@+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
library/Indexation/EntityTable.hs view
@@ -8,23 +8,10 @@  import Indexation.Prelude hiding (lookup) import Indexation.Types-import qualified Indexation.Vector as A+import Indexation.Instances.Cereal ()+import Indexation.Constructors.EntityTable import qualified Data.Vector as B-import qualified Indexation.Cereal.Put as C-import qualified Indexation.Cereal.Get as D-import qualified Data.Serialize as E --instance E.Serialize entity => E.Serialize (EntityTable entity) where-  put = C.putEntityTable E.put-  get = D.getEntityTable E.get--indexTable :: IndexTable entity -> EntityTable entity-indexTable (IndexTable size table) =-  EntityTable vector-  where-    vector =-      A.indexHashMapWithSize size table  lookup :: Index entity -> EntityTable entity -> Maybe entity lookup (Index indexPrim) (EntityTable vector) =
library/Indexation/Folds.hs view
@@ -5,8 +5,6 @@ import Indexation.Types import Control.Foldl import qualified Data.HashMap.Strict as B-import qualified Data.Serialize as C-import qualified Data.ByteString as D   indexTable :: (Eq entity, Hashable entity) => Fold entity (IndexTable entity)@@ -22,25 +20,3 @@           newIndex = succ index           in IndexTable newIndex newMap     extract = id--serializeToFile :: Serialize entity => FilePath -> FoldM IO entity (Either IOException ())-serializeToFile filePath =-  lmap C.encode (writeBytesToFile filePath)--writeBytesToFile :: FilePath -> FoldM IO ByteString (Either IOException ())-writeBytesToFile filePath =-  FoldM step init exit-  where-    step :: Either IOException Handle -> ByteString -> IO (Either IOException Handle)-    step errorOrFileHandle bytes =-      case errorOrFileHandle of-        Right fileHandle -> try (D.hPut fileHandle bytes $> fileHandle)-        Left exception -> return (Left exception)-    init :: IO (Either IOException Handle)-    init =-      try (openFile filePath WriteMode)-    exit :: Either IOException Handle -> IO (Either IOException ())-    exit errorOrFileHandle =-      case errorOrFileHandle of-        Right fileHandle -> try (hClose fileHandle)-        Left exception -> return (Left exception)
− library/Indexation/HashMap.hs 
@@ -1,13 +0,0 @@-module Indexation.HashMap-where--import Indexation.Prelude-import Data.HashMap.Strict---traverse_ :: Applicative effect => (k -> v -> effect ()) -> HashMap k v -> effect ()-traverse_ effect =-  foldrWithKey step init-  where-    init = pure ()-    step k v acc = effect k v *> acc
library/Indexation/IO.hs view
@@ -2,6 +2,8 @@ (   indexProduceToFiles,   readEntitiesAmountFromEntityTableFile,+  readEntityTableFromFile,+  readIndexTableFromFile, ) where @@ -9,6 +11,7 @@ import Indexation.Types import Indexation.Instances.Cereal () import qualified Potoki.Core.IO as PotokiIo+import qualified Potoki.Core.Produce as PotokiProduce import qualified Potoki.Core.Consume as PotokiConsume import qualified Potoki.Cereal.Consume as PotokiConsume import qualified Potoki.Cereal.Produce as PotokiProduce@@ -63,3 +66,15 @@     Cereal.runGet Cereal.getInt64le bytes & \ case       Right x -> return (fromIntegral x)       Left x -> error ("Unexpected binary parsing error: " <> x)++readEntityTableFromFile :: Serialize entity => FilePath -> IO (Either IOException (Either Text (EntityTable entity)))+readEntityTableFromFile filePath =+  PotokiIo.produceAndConsume+    (PotokiProduce.fileBytes filePath)+    (right' (PotokiConsume.get Cereal.get))++readIndexTableFromFile :: (Serialize entity, Eq entity, Hashable entity) => FilePath -> IO (Either IOException (Either Text (IndexTable entity)))+readIndexTableFromFile filePath =+  PotokiIo.produceAndConsume+    (PotokiProduce.fileBytes filePath)+    (right' (PotokiConsume.get Cereal.get))
library/Indexation/Index.hs view
@@ -6,4 +6,4 @@  import Indexation.Prelude import Indexation.Types-import Indexation.Instances.Cereal+import Indexation.Instances.Cereal ()
library/Indexation/IndexTable.hs view
@@ -9,16 +9,9 @@  import Indexation.Prelude hiding (lookup, empty) import Indexation.Types+import Indexation.Instances.Cereal () import qualified Data.HashMap.Strict as A-import qualified Indexation.Cereal.Get as B-import qualified Indexation.Cereal.Put as C-import qualified Indexation.EntityTable as D-import qualified Data.Serialize as E --instance (E.Serialize entity, Eq entity, Hashable entity) => E.Serialize (IndexTable entity) where-  put = C.putEntityTable E.put . D.indexTable-  get = B.getIndexTableAsEntityTable E.get  lookup :: (Eq entity, Hashable entity) => entity -> IndexTable entity -> Maybe (Index entity) lookup entity (IndexTable size hashMap) =
library/Indexation/Instances/Cereal.hs view
@@ -6,8 +6,17 @@ import Data.Serialize import qualified Indexation.Cereal.Get as Get import qualified Indexation.Cereal.Put as Put+import qualified Indexation.Constructors.EntityTable as EntityTable   instance Serialize (Index a) where   get = Get.getIndex   put = Put.putIndex++instance Serialize entity => Serialize (EntityTable entity) where+  get = Get.getEntityTable get+  put = Put.putEntityTable put++instance (Serialize entity, Eq entity, Hashable entity) => Serialize (IndexTable entity) where+  get = Get.getIndexTableAsEntityTable get+  put = Put.putEntityTable put . EntityTable.indexTable
− library/Indexation/Potoki/Fetch.hs 
@@ -1,36 +0,0 @@-module Indexation.Potoki.Fetch where--import Indexation.Prelude-import Indexation.Types-import Potoki.Core.Fetch-import qualified Indexation.IndexTable as A-import qualified STMContainers.Map as B-import qualified Focus as C---index :: (Eq entity, Hashable entity) => IORef (IndexTable entity) -> Fetch entity -> Fetch (Index entity)-index indexTableRef (Fetch entityMaybeIO) =-  Fetch $ do-    entityMaybe <- entityMaybeIO-    case entityMaybe of-      Just entity -> do-        indexTable <- readIORef indexTableRef-        A.register entity indexTable & \ (!index, !newIndexTable) -> do-          writeIORef indexTableRef newIndexTable-          return (Just index)-      Nothing -> return Nothing--indexConcurrently :: (Eq entity, Hashable entity) => Indexer entity -> Fetch entity -> Fetch (Index entity)-indexConcurrently (Indexer sizeVar map) (Fetch entityMaybeIO) =-  Fetch $ do-    entityMaybe <- entityMaybeIO-    case entityMaybe of-      Just entity -> fmap Just $ atomically $ B.focus strategy entity map-      Nothing -> return Nothing-  where-    strategy = \ case-      Just indexInt -> return (Index indexInt, C.Keep)-      Nothing -> do-        size <- readTVar sizeVar-        writeTVar sizeVar $! succ size-        return (Index size, C.Replace size)
library/Indexation/Potoki/Transform.hs view
@@ -3,10 +3,17 @@ import Indexation.Prelude hiding (runState) import Indexation.Types import Potoki.Core.Transform-import qualified Indexation.Potoki.Fetch as A-import qualified Indexation.IndexTable as B-import qualified STMContainers.Map as C+import qualified Focus+import qualified STMContainers.Map as StmMap   indexConcurrently :: (Eq entity, Hashable entity) => Indexer entity -> Transform entity (Index entity)-indexConcurrently indexer = Transform (return . A.indexConcurrently indexer)+indexConcurrently (Indexer sizeVar map) =+  mapInIO $ \ entity -> atomically $ StmMap.focus strategy entity map+  where+    strategy = \ case+      Just indexInt -> return (Index indexInt, Focus.Keep)+      Nothing -> do+        size <- readTVar sizeVar+        writeTVar sizeVar $! succ size+        return (Index size, Focus.Replace size)
library/Indexation/Prelude.hs view
@@ -108,6 +108,10 @@ ------------------------- import Data.ByteString as Exports (ByteString) +-- text+-------------------------+import Data.Text as Exports (Text)+ -- profunctors ------------------------- import Data.Profunctor as Exports hiding (WrappedArrow(..))
library/Indexation/Vector.hs view
@@ -2,12 +2,10 @@ where  import Indexation.Prelude-import Indexation.Types import Data.Vector import qualified Data.Vector.Mutable as A import qualified Data.HashMap.Strict as B import qualified ListT-import qualified STMContainers.Map as StmMap   {-|