{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_HADDOCK prune not-home #-}

{- |
Copyright   : (c) 2018-2022 Tim Emiola
SPDX-License-Identifier: BSD3
Maintainer  : Tim Emiola <tim@emio.la>

Provides an in-memory 'Handle' implementation.
-}
module KeyedVals.Handle.Mem (
  -- * functions
  new,

  -- * module re-exports
  module KeyedVals.Handle,
) where

import Control.Monad.IO.Unlift (MonadIO, MonadUnliftIO, liftIO)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import KeyedVals.Handle
import KeyedVals.Handle.Internal (Handle (..))
import Numeric.Natural (Natural)
import UnliftIO.STM (
  STM,
  TVar,
  atomically,
  newTVarIO,
  readTVar,
  writeTVar,
 )


-- | Create a new 'Handle'.
new :: MonadUnliftIO m => m (Handle m)
new :: forall (m :: * -> *). MonadUnliftIO m => m (Handle m)
new = do
  TVar (InMem, Bool)
v <- IO (TVar (InMem, Bool)) -> m (TVar (InMem, Bool))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TVar (InMem, Bool)) -> m (TVar (InMem, Bool)))
-> IO (TVar (InMem, Bool)) -> m (TVar (InMem, Bool))
forall a b. (a -> b) -> a -> b
$ (InMem, Bool) -> IO (TVar (InMem, Bool))
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO (InMem
forall a. Monoid a => a
mempty, Bool
False)
  Handle m -> m (Handle m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Handle m -> m (Handle m)) -> Handle m -> m (Handle m)
forall a b. (a -> b) -> a -> b
$
    Handle
      { hLoadVal :: ByteString -> m (Either HandleErr (Maybe ByteString))
hLoadVal = TVar (InMem, Bool)
-> ByteString -> m (Either HandleErr (Maybe ByteString))
forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString -> m (Either HandleErr (Maybe ByteString))
hLoadVal' TVar (InMem, Bool)
v
      , hSaveVal :: ByteString -> ByteString -> m (Either HandleErr ())
hSaveVal = TVar (InMem, Bool)
-> ByteString -> ByteString -> m (Either HandleErr ())
forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString -> ByteString -> m (Either HandleErr ())
hSaveVal' TVar (InMem, Bool)
v
      , hCountKVs :: ByteString -> m (Either HandleErr Natural)
hCountKVs = TVar (InMem, Bool) -> ByteString -> m (Either HandleErr Natural)
forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool) -> ByteString -> m (Either HandleErr Natural)
hCountKVs' TVar (InMem, Bool)
v
      , hLoadKVs :: ByteString -> m (Either HandleErr ValsByKey)
hLoadKVs = TVar (InMem, Bool) -> ByteString -> m (Either HandleErr ValsByKey)
forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool) -> ByteString -> m (Either HandleErr ValsByKey)
hLoadKVs' TVar (InMem, Bool)
v
      , hSaveKVs :: ByteString -> ValsByKey -> m (Either HandleErr ())
hSaveKVs = TVar (InMem, Bool)
-> ByteString -> ValsByKey -> m (Either HandleErr ())
forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString -> ValsByKey -> m (Either HandleErr ())
hSaveKVs' TVar (InMem, Bool)
v
      , hUpdateKVs :: ByteString -> ValsByKey -> m (Either HandleErr ())
hUpdateKVs = TVar (InMem, Bool)
-> ByteString -> ValsByKey -> m (Either HandleErr ())
forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString -> ValsByKey -> m (Either HandleErr ())
hUpdateKVs' TVar (InMem, Bool)
v
      , hLoadFrom :: ByteString -> ByteString -> m (Either HandleErr (Maybe ByteString))
hLoadFrom = TVar (InMem, Bool)
-> ByteString
-> ByteString
-> m (Either HandleErr (Maybe ByteString))
forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString
-> ByteString
-> m (Either HandleErr (Maybe ByteString))
hLoadFrom' TVar (InMem, Bool)
v
      , hSaveTo :: ByteString -> ByteString -> ByteString -> m (Either HandleErr ())
hSaveTo = TVar (InMem, Bool)
-> ByteString
-> ByteString
-> ByteString
-> m (Either HandleErr ())
forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString
-> ByteString
-> ByteString
-> m (Either HandleErr ())
hSaveTo' TVar (InMem, Bool)
v
      , hLoadSlice :: ByteString -> Selection -> m (Either HandleErr ValsByKey)
hLoadSlice = TVar (InMem, Bool)
-> ByteString -> Selection -> m (Either HandleErr ValsByKey)
forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString -> Selection -> m (Either HandleErr ValsByKey)
hLoadSlice' TVar (InMem, Bool)
v
      , hDeleteSelected :: Selection -> m (Either HandleErr ())
hDeleteSelected = TVar (InMem, Bool) -> Selection -> m (Either HandleErr ())
forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool) -> Selection -> m (Either HandleErr ())
hDeleteSelected' TVar (InMem, Bool)
v
      , hDeleteSelectedKVs :: ByteString -> Selection -> m (Either HandleErr ())
hDeleteSelectedKVs = TVar (InMem, Bool)
-> ByteString -> Selection -> m (Either HandleErr ())
forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString -> Selection -> m (Either HandleErr ())
hDeleteSelectedKVs' TVar (InMem, Bool)
v
      , hClose :: m ()
hClose = TVar (InMem, Bool) -> m ()
forall (m :: * -> *). MonadUnliftIO m => TVar (InMem, Bool) -> m ()
hClose' TVar (InMem, Bool)
v
      }


-- | Implement an in-memory 'Handle'.
type InMem = Map Key InMemValue


-- | Store an in-memory 'Handle'.
type InMemVar = TVar (InMem, Bool)


-- | InMemValue represents a value to be stored in an in-memory 'Handle'.
data InMemValue
  = Dict !ValsByKey
  | Simple !Val


hClose' :: MonadUnliftIO m => InMemVar -> m ()
hClose' :: forall (m :: * -> *). MonadUnliftIO m => TVar (InMem, Bool) -> m ()
hClose' TVar (InMem, Bool)
var = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
  STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    (InMem
fh, Bool
_) <- TVar (InMem, Bool) -> STM (InMem, Bool)
forall a. TVar a -> STM a
readTVar TVar (InMem, Bool)
var
    TVar (InMem, Bool) -> (InMem, Bool) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (InMem, Bool)
var (InMem
fh, Bool
True)


hLoadVal' ::
  MonadUnliftIO m =>
  InMemVar ->
  Key ->
  m (Either HandleErr (Maybe Val))
hLoadVal' :: forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString -> m (Either HandleErr (Maybe ByteString))
hLoadVal' TVar (InMem, Bool)
var ByteString
key = TVar (InMem, Bool)
-> ByteString
-> (Maybe InMemValue -> STM (Either HandleErr (Maybe ByteString)))
-> m (Either HandleErr (Maybe ByteString))
forall (m :: * -> *) a.
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString
-> (Maybe InMemValue -> STM (Either HandleErr a))
-> m (Either HandleErr a)
withInMemKey TVar (InMem, Bool)
var ByteString
key ((Maybe InMemValue -> STM (Either HandleErr (Maybe ByteString)))
 -> m (Either HandleErr (Maybe ByteString)))
-> (Maybe InMemValue -> STM (Either HandleErr (Maybe ByteString)))
-> m (Either HandleErr (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ \case
  Maybe InMemValue
Nothing -> Either HandleErr (Maybe ByteString)
-> STM (Either HandleErr (Maybe ByteString))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr (Maybe ByteString)
 -> STM (Either HandleErr (Maybe ByteString)))
-> Either HandleErr (Maybe ByteString)
-> STM (Either HandleErr (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> Either HandleErr (Maybe ByteString)
forall a b. b -> Either a b
Right Maybe ByteString
forall a. Maybe a
Nothing
  Just (Dict ValsByKey
_) -> Either HandleErr (Maybe ByteString)
-> STM (Either HandleErr (Maybe ByteString))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr (Maybe ByteString)
 -> STM (Either HandleErr (Maybe ByteString)))
-> Either HandleErr (Maybe ByteString)
-> STM (Either HandleErr (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ HandleErr -> Either HandleErr (Maybe ByteString)
forall a b. a -> Either a b
Left HandleErr
BadKey
  Just (Simple ByteString
v) -> Either HandleErr (Maybe ByteString)
-> STM (Either HandleErr (Maybe ByteString))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr (Maybe ByteString)
 -> STM (Either HandleErr (Maybe ByteString)))
-> Either HandleErr (Maybe ByteString)
-> STM (Either HandleErr (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> Either HandleErr (Maybe ByteString)
forall a b. b -> Either a b
Right (Maybe ByteString -> Either HandleErr (Maybe ByteString))
-> Maybe ByteString -> Either HandleErr (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v


hSaveVal' ::
  MonadUnliftIO m =>
  InMemVar ->
  Key ->
  Val ->
  m (Either HandleErr ())
hSaveVal' :: forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString -> ByteString -> m (Either HandleErr ())
hSaveVal' TVar (InMem, Bool)
var ByteString
key ByteString
value = TVar (InMem, Bool)
-> (InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
TVar (InMem, Bool)
-> (InMem -> STM (Either HandleErr a)) -> m (Either HandleErr a)
withInMem' TVar (InMem, Bool)
var ((InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ()))
-> (InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ \InMem
values -> do
  TVar (InMem, Bool) -> InMem -> STM (Either HandleErr ())
forall a err. TVar (a, Bool) -> a -> STM (Either err ())
updateInMem TVar (InMem, Bool)
var (InMem -> STM (Either HandleErr ()))
-> InMem -> STM (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ ByteString -> InMemValue -> InMem -> InMem
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ByteString
key (ByteString -> InMemValue
Simple ByteString
value) InMem
values


hLoadKVs' ::
  MonadUnliftIO m =>
  InMemVar ->
  Key ->
  m (Either HandleErr ValsByKey)
hLoadKVs' :: forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool) -> ByteString -> m (Either HandleErr ValsByKey)
hLoadKVs' TVar (InMem, Bool)
var ByteString
key = TVar (InMem, Bool)
-> ByteString
-> (Maybe InMemValue -> STM (Either HandleErr ValsByKey))
-> m (Either HandleErr ValsByKey)
forall (m :: * -> *) a.
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString
-> (Maybe InMemValue -> STM (Either HandleErr a))
-> m (Either HandleErr a)
withInMemKey TVar (InMem, Bool)
var ByteString
key ((Maybe InMemValue -> STM (Either HandleErr ValsByKey))
 -> m (Either HandleErr ValsByKey))
-> (Maybe InMemValue -> STM (Either HandleErr ValsByKey))
-> m (Either HandleErr ValsByKey)
forall a b. (a -> b) -> a -> b
$ \case
  Maybe InMemValue
Nothing -> Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey))
-> Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey)
forall a b. (a -> b) -> a -> b
$ ValsByKey -> Either HandleErr ValsByKey
forall a b. b -> Either a b
Right ValsByKey
forall k a. Map k a
Map.empty
  Just (Dict ValsByKey
v) -> Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey))
-> Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey)
forall a b. (a -> b) -> a -> b
$ ValsByKey -> Either HandleErr ValsByKey
forall a b. b -> Either a b
Right ValsByKey
v
  Just (Simple ByteString
_) -> Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey))
-> Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey)
forall a b. (a -> b) -> a -> b
$ HandleErr -> Either HandleErr ValsByKey
forall a b. a -> Either a b
Left HandleErr
BadKey


hLoadSlice' ::
  MonadUnliftIO m =>
  InMemVar ->
  Key ->
  Selection ->
  m (Either HandleErr ValsByKey)
hLoadSlice' :: forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString -> Selection -> m (Either HandleErr ValsByKey)
hLoadSlice' TVar (InMem, Bool)
var ByteString
key Selection
sel = TVar (InMem, Bool)
-> ByteString
-> (Maybe InMemValue -> STM (Either HandleErr ValsByKey))
-> m (Either HandleErr ValsByKey)
forall (m :: * -> *) a.
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString
-> (Maybe InMemValue -> STM (Either HandleErr a))
-> m (Either HandleErr a)
withInMemKey TVar (InMem, Bool)
var ByteString
key ((Maybe InMemValue -> STM (Either HandleErr ValsByKey))
 -> m (Either HandleErr ValsByKey))
-> (Maybe InMemValue -> STM (Either HandleErr ValsByKey))
-> m (Either HandleErr ValsByKey)
forall a b. (a -> b) -> a -> b
$ \case
  Maybe InMemValue
Nothing -> Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey))
-> Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey)
forall a b. (a -> b) -> a -> b
$ ValsByKey -> Either HandleErr ValsByKey
forall a b. b -> Either a b
Right ValsByKey
forall k a. Map k a
Map.empty
  Just (Dict ValsByKey
v) -> Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey))
-> Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey)
forall a b. (a -> b) -> a -> b
$ ValsByKey -> Either HandleErr ValsByKey
forall a b. b -> Either a b
Right (ValsByKey -> Either HandleErr ValsByKey)
-> ValsByKey -> Either HandleErr ValsByKey
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString -> Bool) -> ValsByKey -> ValsByKey
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (Selection -> ByteString -> ByteString -> Bool
forall p. Selection -> ByteString -> p -> Bool
predOf Selection
sel) ValsByKey
v
  Just (Simple ByteString
_) -> Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey))
-> Either HandleErr ValsByKey -> STM (Either HandleErr ValsByKey)
forall a b. (a -> b) -> a -> b
$ HandleErr -> Either HandleErr ValsByKey
forall a b. a -> Either a b
Left HandleErr
BadKey


hCountKVs' ::
  MonadUnliftIO m =>
  InMemVar ->
  Key ->
  m (Either HandleErr Natural)
hCountKVs' :: forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool) -> ByteString -> m (Either HandleErr Natural)
hCountKVs' TVar (InMem, Bool)
var ByteString
key = TVar (InMem, Bool)
-> ByteString
-> (Maybe InMemValue -> STM (Either HandleErr Natural))
-> m (Either HandleErr Natural)
forall (m :: * -> *) a.
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString
-> (Maybe InMemValue -> STM (Either HandleErr a))
-> m (Either HandleErr a)
withInMemKey TVar (InMem, Bool)
var ByteString
key ((Maybe InMemValue -> STM (Either HandleErr Natural))
 -> m (Either HandleErr Natural))
-> (Maybe InMemValue -> STM (Either HandleErr Natural))
-> m (Either HandleErr Natural)
forall a b. (a -> b) -> a -> b
$ \case
  Maybe InMemValue
Nothing -> Either HandleErr Natural -> STM (Either HandleErr Natural)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr Natural -> STM (Either HandleErr Natural))
-> Either HandleErr Natural -> STM (Either HandleErr Natural)
forall a b. (a -> b) -> a -> b
$ Natural -> Either HandleErr Natural
forall a b. b -> Either a b
Right Natural
0
  Just (Dict ValsByKey
v) -> Either HandleErr Natural -> STM (Either HandleErr Natural)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr Natural -> STM (Either HandleErr Natural))
-> Either HandleErr Natural -> STM (Either HandleErr Natural)
forall a b. (a -> b) -> a -> b
$ Natural -> Either HandleErr Natural
forall a b. b -> Either a b
Right (Natural -> Either HandleErr Natural)
-> Natural -> Either HandleErr Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a. Num a => Integer -> a
fromInteger (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ ValsByKey -> Int
forall k a. Map k a -> Int
Map.size ValsByKey
v
  Just (Simple ByteString
_) -> Either HandleErr Natural -> STM (Either HandleErr Natural)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr Natural -> STM (Either HandleErr Natural))
-> Either HandleErr Natural -> STM (Either HandleErr Natural)
forall a b. (a -> b) -> a -> b
$ HandleErr -> Either HandleErr Natural
forall a b. a -> Either a b
Left HandleErr
BadKey


hSaveKVs' ::
  MonadUnliftIO m =>
  InMemVar ->
  Key ->
  ValsByKey ->
  m (Either HandleErr ())
hSaveKVs' :: forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString -> ValsByKey -> m (Either HandleErr ())
hSaveKVs' TVar (InMem, Bool)
var ByteString
key ValsByKey
d = TVar (InMem, Bool)
-> (InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
TVar (InMem, Bool)
-> (InMem -> STM (Either HandleErr a)) -> m (Either HandleErr a)
withInMem' TVar (InMem, Bool)
var ((InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ()))
-> (InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ \InMem
values -> do
  TVar (InMem, Bool) -> InMem -> STM (Either HandleErr ())
forall a err. TVar (a, Bool) -> a -> STM (Either err ())
updateInMem TVar (InMem, Bool)
var (InMem -> STM (Either HandleErr ()))
-> InMem -> STM (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ ByteString -> InMemValue -> InMem -> InMem
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ByteString
key (ValsByKey -> InMemValue
Dict ValsByKey
d) InMem
values


hUpdateKVs' ::
  MonadUnliftIO m =>
  InMemVar ->
  Key ->
  ValsByKey ->
  m (Either HandleErr ())
hUpdateKVs' :: forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString -> ValsByKey -> m (Either HandleErr ())
hUpdateKVs' TVar (InMem, Bool)
var ByteString
key ValsByKey
d = TVar (InMem, Bool)
-> (InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
TVar (InMem, Bool)
-> (InMem -> STM (Either HandleErr a)) -> m (Either HandleErr a)
withInMem' TVar (InMem, Bool)
var ((InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ()))
-> (InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ \InMem
values ->
  case ByteString -> InMem -> Maybe InMemValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
key InMem
values of
    Maybe InMemValue
Nothing -> do
      TVar (InMem, Bool) -> InMem -> STM (Either HandleErr ())
forall a err. TVar (a, Bool) -> a -> STM (Either err ())
updateInMem TVar (InMem, Bool)
var (InMem -> STM (Either HandleErr ()))
-> InMem -> STM (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ ByteString -> InMemValue -> InMem -> InMem
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ByteString
key (ValsByKey -> InMemValue
Dict ValsByKey
d) InMem
values
    Just (Dict ValsByKey
d') -> do
      TVar (InMem, Bool) -> InMem -> STM (Either HandleErr ())
forall a err. TVar (a, Bool) -> a -> STM (Either err ())
updateInMem TVar (InMem, Bool)
var (InMem -> STM (Either HandleErr ()))
-> InMem -> STM (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ ByteString -> InMemValue -> InMem -> InMem
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ByteString
key (ValsByKey -> InMemValue
Dict (ValsByKey -> InMemValue) -> ValsByKey -> InMemValue
forall a b. (a -> b) -> a -> b
$ ValsByKey -> ValsByKey -> ValsByKey
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ValsByKey
d ValsByKey
d') InMem
values
    Just (Simple ByteString
_) -> Either HandleErr () -> STM (Either HandleErr ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr () -> STM (Either HandleErr ()))
-> Either HandleErr () -> STM (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ HandleErr -> Either HandleErr ()
forall a b. a -> Either a b
Left HandleErr
BadKey


updateInMem :: TVar (a, Bool) -> a -> STM (Either err ())
updateInMem :: forall a err. TVar (a, Bool) -> a -> STM (Either err ())
updateInMem TVar (a, Bool)
var a
newMap = do
  TVar (a, Bool) -> (a, Bool) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (a, Bool)
var (a
newMap, Bool
False)
  Either err () -> STM (Either err ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either err () -> STM (Either err ()))
-> Either err () -> STM (Either err ())
forall a b. (a -> b) -> a -> b
$ () -> Either err ()
forall a b. b -> Either a b
Right ()


hSaveTo' ::
  MonadUnliftIO m =>
  InMemVar ->
  Key ->
  Key ->
  Val ->
  m (Either HandleErr ())
hSaveTo' :: forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString
-> ByteString
-> ByteString
-> m (Either HandleErr ())
hSaveTo' TVar (InMem, Bool)
var ByteString
key ByteString
dictKey ByteString
value = TVar (InMem, Bool)
-> (InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
TVar (InMem, Bool)
-> (InMem -> STM (Either HandleErr a)) -> m (Either HandleErr a)
withInMem' TVar (InMem, Bool)
var ((InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ()))
-> (InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ \InMem
values ->
  case ByteString -> InMem -> Maybe InMemValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
key InMem
values of
    Maybe InMemValue
Nothing -> do
      TVar (InMem, Bool) -> InMem -> STM (Either HandleErr ())
forall a err. TVar (a, Bool) -> a -> STM (Either err ())
updateInMem TVar (InMem, Bool)
var (InMem -> STM (Either HandleErr ()))
-> InMem -> STM (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ ByteString -> InMemValue -> InMem -> InMem
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ByteString
key (ValsByKey -> InMemValue
Dict (ValsByKey -> InMemValue) -> ValsByKey -> InMemValue
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ValsByKey
forall k a. k -> a -> Map k a
Map.singleton ByteString
dictKey ByteString
value) InMem
values
    Just (Dict ValsByKey
d) -> do
      TVar (InMem, Bool) -> InMem -> STM (Either HandleErr ())
forall a err. TVar (a, Bool) -> a -> STM (Either err ())
updateInMem TVar (InMem, Bool)
var (InMem -> STM (Either HandleErr ()))
-> InMem -> STM (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ ByteString -> InMemValue -> InMem -> InMem
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ByteString
key (ValsByKey -> InMemValue
Dict (ValsByKey -> InMemValue) -> ValsByKey -> InMemValue
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ValsByKey -> ValsByKey
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ByteString
dictKey ByteString
value ValsByKey
d) InMem
values
    Just (Simple ByteString
_) -> Either HandleErr () -> STM (Either HandleErr ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr () -> STM (Either HandleErr ()))
-> Either HandleErr () -> STM (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ HandleErr -> Either HandleErr ()
forall a b. a -> Either a b
Left HandleErr
BadKey


hLoadFrom' ::
  MonadUnliftIO m =>
  InMemVar ->
  Key ->
  Key ->
  m (Either HandleErr (Maybe Val))
hLoadFrom' :: forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString
-> ByteString
-> m (Either HandleErr (Maybe ByteString))
hLoadFrom' TVar (InMem, Bool)
var ByteString
key ByteString
dictKey = TVar (InMem, Bool)
-> ByteString
-> (Maybe InMemValue -> STM (Either HandleErr (Maybe ByteString)))
-> m (Either HandleErr (Maybe ByteString))
forall (m :: * -> *) a.
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString
-> (Maybe InMemValue -> STM (Either HandleErr a))
-> m (Either HandleErr a)
withInMemKey TVar (InMem, Bool)
var ByteString
key ((Maybe InMemValue -> STM (Either HandleErr (Maybe ByteString)))
 -> m (Either HandleErr (Maybe ByteString)))
-> (Maybe InMemValue -> STM (Either HandleErr (Maybe ByteString)))
-> m (Either HandleErr (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ \case
  Maybe InMemValue
Nothing -> Either HandleErr (Maybe ByteString)
-> STM (Either HandleErr (Maybe ByteString))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr (Maybe ByteString)
 -> STM (Either HandleErr (Maybe ByteString)))
-> Either HandleErr (Maybe ByteString)
-> STM (Either HandleErr (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> Either HandleErr (Maybe ByteString)
forall a b. b -> Either a b
Right Maybe ByteString
forall a. Maybe a
Nothing
  Just (Dict ValsByKey
d) -> Either HandleErr (Maybe ByteString)
-> STM (Either HandleErr (Maybe ByteString))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr (Maybe ByteString)
 -> STM (Either HandleErr (Maybe ByteString)))
-> Either HandleErr (Maybe ByteString)
-> STM (Either HandleErr (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> Either HandleErr (Maybe ByteString)
forall a b. b -> Either a b
Right (Maybe ByteString -> Either HandleErr (Maybe ByteString))
-> Maybe ByteString -> Either HandleErr (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> ValsByKey -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
dictKey ValsByKey
d
  Just (Simple ByteString
_) -> Either HandleErr (Maybe ByteString)
-> STM (Either HandleErr (Maybe ByteString))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr (Maybe ByteString)
 -> STM (Either HandleErr (Maybe ByteString)))
-> Either HandleErr (Maybe ByteString)
-> STM (Either HandleErr (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ HandleErr -> Either HandleErr (Maybe ByteString)
forall a b. a -> Either a b
Left HandleErr
BadKey


hDeleteSelectedKVs' ::
  MonadUnliftIO m =>
  InMemVar ->
  Key ->
  Selection ->
  m (Either HandleErr ())
hDeleteSelectedKVs' :: forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString -> Selection -> m (Either HandleErr ())
hDeleteSelectedKVs' TVar (InMem, Bool)
var ByteString
key Selection
sel = TVar (InMem, Bool)
-> (InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
TVar (InMem, Bool)
-> (InMem -> STM (Either HandleErr a)) -> m (Either HandleErr a)
withInMem' TVar (InMem, Bool)
var ((InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ()))
-> (InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ \InMem
values ->
  case ByteString -> InMem -> Maybe InMemValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
key InMem
values of
    Maybe InMemValue
Nothing -> Either HandleErr () -> STM (Either HandleErr ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr () -> STM (Either HandleErr ()))
-> Either HandleErr () -> STM (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ () -> Either HandleErr ()
forall a b. b -> Either a b
Right ()
    Just (Dict ValsByKey
d) -> do
      TVar (InMem, Bool) -> (InMem, Bool) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (InMem, Bool)
var (ByteString -> InMemValue -> InMem -> InMem
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ByteString
key (ValsByKey -> InMemValue
Dict ((ByteString -> ByteString -> Bool) -> ValsByKey -> ValsByKey
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (Selection -> ByteString -> ByteString -> Bool
forall p. Selection -> ByteString -> p -> Bool
notSel Selection
sel) ValsByKey
d)) InMem
values, Bool
False)
      Either HandleErr () -> STM (Either HandleErr ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr () -> STM (Either HandleErr ()))
-> Either HandleErr () -> STM (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ () -> Either HandleErr ()
forall a b. b -> Either a b
Right ()
    Just (Simple ByteString
_) -> Either HandleErr () -> STM (Either HandleErr ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr () -> STM (Either HandleErr ()))
-> Either HandleErr () -> STM (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ HandleErr -> Either HandleErr ()
forall a b. a -> Either a b
Left HandleErr
BadKey


hDeleteSelected' ::
  MonadUnliftIO m =>
  InMemVar ->
  Selection ->
  m (Either HandleErr ())
hDeleteSelected' :: forall (m :: * -> *).
MonadUnliftIO m =>
TVar (InMem, Bool) -> Selection -> m (Either HandleErr ())
hDeleteSelected' TVar (InMem, Bool)
var Selection
sel = TVar (InMem, Bool)
-> (InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
TVar (InMem, Bool)
-> (InMem -> STM (Either HandleErr a)) -> m (Either HandleErr a)
withInMem' TVar (InMem, Bool)
var ((InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ()))
-> (InMem -> STM (Either HandleErr ())) -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ \InMem
values -> do
  TVar (InMem, Bool) -> (InMem, Bool) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (InMem, Bool)
var ((ByteString -> InMemValue -> Bool) -> InMem -> InMem
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (Selection -> ByteString -> InMemValue -> Bool
forall p. Selection -> ByteString -> p -> Bool
notSel Selection
sel) InMem
values, Bool
False)
  Either HandleErr () -> STM (Either HandleErr ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr () -> STM (Either HandleErr ()))
-> Either HandleErr () -> STM (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ () -> Either HandleErr ()
forall a b. b -> Either a b
Right ()


notSel :: Selection -> Key -> p -> Bool
notSel :: forall p. Selection -> ByteString -> p -> Bool
notSel Selection
s ByteString
k p
_ = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString
k ByteString -> Selection -> Bool
`isIn` Selection
s


predOf :: Selection -> Key -> p -> Bool
predOf :: forall p. Selection -> ByteString -> p -> Bool
predOf Selection
s ByteString
k p
_ = ByteString
k ByteString -> Selection -> Bool
`isIn` Selection
s


withInMem :: MonadIO m => TVar t -> (t -> STM a) -> m a
withInMem :: forall (m :: * -> *) t a.
MonadIO m =>
TVar t -> (t -> STM a) -> m a
withInMem TVar t
v t -> STM a
f = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ STM a -> IO a
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM a -> IO a) -> STM a -> IO a
forall a b. (a -> b) -> a -> b
$ TVar t -> STM t
forall a. TVar a -> STM a
readTVar TVar t
v STM t -> (t -> STM a) -> STM a
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> STM a
f


withInMem' ::
  MonadUnliftIO m =>
  InMemVar ->
  (InMem -> STM (Either HandleErr a)) ->
  m (Either HandleErr a)
withInMem' :: forall (m :: * -> *) a.
MonadUnliftIO m =>
TVar (InMem, Bool)
-> (InMem -> STM (Either HandleErr a)) -> m (Either HandleErr a)
withInMem' TVar (InMem, Bool)
var InMem -> STM (Either HandleErr a)
f = TVar (InMem, Bool)
-> ((InMem, Bool) -> STM (Either HandleErr a))
-> m (Either HandleErr a)
forall (m :: * -> *) t a.
MonadIO m =>
TVar t -> (t -> STM a) -> m a
withInMem TVar (InMem, Bool)
var (((InMem, Bool) -> STM (Either HandleErr a))
 -> m (Either HandleErr a))
-> ((InMem, Bool) -> STM (Either HandleErr a))
-> m (Either HandleErr a)
forall a b. (a -> b) -> a -> b
$ \case
  (InMem
_, Bool
True) -> Either HandleErr a -> STM (Either HandleErr a)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr a -> STM (Either HandleErr a))
-> Either HandleErr a -> STM (Either HandleErr a)
forall a b. (a -> b) -> a -> b
$ HandleErr -> Either HandleErr a
forall a b. a -> Either a b
Left HandleErr
ConnectionClosed
  (InMem
values, Bool
_) -> InMem -> STM (Either HandleErr a)
f InMem
values


withInMemKey ::
  MonadUnliftIO m =>
  InMemVar ->
  Key ->
  (Maybe InMemValue -> STM (Either HandleErr a)) ->
  m (Either HandleErr a)
withInMemKey :: forall (m :: * -> *) a.
MonadUnliftIO m =>
TVar (InMem, Bool)
-> ByteString
-> (Maybe InMemValue -> STM (Either HandleErr a))
-> m (Either HandleErr a)
withInMemKey TVar (InMem, Bool)
var ByteString
key Maybe InMemValue -> STM (Either HandleErr a)
f = TVar (InMem, Bool)
-> ((InMem, Bool) -> STM (Either HandleErr a))
-> m (Either HandleErr a)
forall (m :: * -> *) t a.
MonadIO m =>
TVar t -> (t -> STM a) -> m a
withInMem TVar (InMem, Bool)
var (((InMem, Bool) -> STM (Either HandleErr a))
 -> m (Either HandleErr a))
-> ((InMem, Bool) -> STM (Either HandleErr a))
-> m (Either HandleErr a)
forall a b. (a -> b) -> a -> b
$ \case
  (InMem
_, Bool
True) -> Either HandleErr a -> STM (Either HandleErr a)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr a -> STM (Either HandleErr a))
-> Either HandleErr a -> STM (Either HandleErr a)
forall a b. (a -> b) -> a -> b
$ HandleErr -> Either HandleErr a
forall a b. a -> Either a b
Left HandleErr
ConnectionClosed
  (InMem
values, Bool
_) -> Maybe InMemValue -> STM (Either HandleErr a)
f (ByteString -> InMem -> Maybe InMemValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
key InMem
values)