indexation-0.1: library/Indexation/Potoki/Fetch.hs

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)