packages feed

keyed-vals-mem (empty) → 0.1.0.0

raw patch · 7 files changed

+408/−0 lines, 7 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, hspec, keyed-vals, keyed-vals-hspec-tests, keyed-vals-mem, text, unliftio, unliftio-core

Files

+ ChangeLog.md view
@@ -0,0 +1,9 @@+# Revision history for keyed-vals++`keyed-vals-mem` uses [PVP Versioning][1].++## 0.1.0.0 -- 2022-11-28++* Initial version.++[1]: https://pvp.haskell.org
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2022, Tim Emiola++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Tim Emiola nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,20 @@+# keyed-vals-mem++[![GitHub CI](https://github.com/adetokunbo/keyed-vals/actions/workflows/ci.yml/badge.svg)](https://github.com/adetokunbo/keyed-vals/actions)+[![Stackage Nightly](http://stackage.org/package/keyed-vals-mem/badge/nightly)](http://stackage.org/nightly/package/keyed-vals-mem)+[![Hackage][hackage-badge]][hackage]+[![Hackage Dependencies][hackage-deps-badge]][hackage-deps]+[![BSD3](https://img.shields.io/badge/license-BSD3-green.svg?dummy)](https://github.com/adetokunbo/keyed-vals-mem/blob/master/LICENSE)++`keyed-vals` aims to provide a narrow client for storing key-value collections+in storage services like [Redis] via an abstract [Handle] interface.++This package, `keyed-vals-mem`, provides an in-memory implementation of the [Handle]+suitable for use in testing and prototyping.++[hackage-deps-badge]: <https://img.shields.io/hackage-deps/v/keyed-vals-mem.svg>+[hackage-deps]:       <http://packdeps.haskellers.com/feed?needle=keyed-vals-mem>+[hackage-badge]:      <https://img.shields.io/hackage/v/keyed-vals-mem.svg>+[hackage]:            <https://hackage.haskell.org/package/keyed-vals-mem>+[Handle]:             <https://hackage.haskell.org/package/keyed-vals>+[Redis]:              <https://redis.io>
+ Setup.hs view
@@ -0,0 +1,4 @@+import Distribution.Simple+++main = defaultMain
+ keyed-vals-mem.cabal view
@@ -0,0 +1,56 @@+cabal-version:      3.0+name:               keyed-vals-mem+version:            0.1.0.0+license:            BSD-3-Clause+license-file:       LICENSE+maintainer:         adetokunbo@emio.la+author:             Tim Emiola+tested-with:        GHC ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.1+homepage:           https://github.com/adetokunbo/keyed-vals#readme+bug-reports:        https://github.com/adetokunbo/keyed-vals/issues+synopsis:+  Implements a keyed-vals Handle using in-process memory++description:+  While the goal of [keyed-vals](https://hackage.haskell.org/package/keyed-vals) is+  to provide access to storage services like [Redis](https://redis.io), the+  abstract definition of __Handle__ also enables this in-process implementation.++  It is intended be used as a drop-in replacement for use in testing and rapid+  prototyping.++category:           Data, Redis+build-type:         Simple+extra-source-files:+  ChangeLog.md+  README.md++source-repository head+  type:     git+  location: https://github.com/adetokunbo/keyed-vals.git++library+  exposed-modules:  KeyedVals.Handle.Mem+  hs-source-dirs:   src+  default-language: Haskell2010+  ghc-options:      -Wall -Wincomplete-uni-patterns -fwarn-tabs+  build-depends:+    , base           >=4.11     && <5.0+    , bytestring     >=0.10.8.2 && <0.11 || >=0.11.3.1 && <0.12+    , containers     >=0.6.5    && <0.7+    , keyed-vals     >=0.1      && <0.2+    , text           >=1.2.4    && <1.3  || >=2.0+    , unliftio       >=0.2.22   && <0.3+    , unliftio-core  >=0.2.0    && <0.3+++test-suite integration-test+  type:             exitcode-stdio-1.0+  main-is:          Spec.hs+  hs-source-dirs:   test+  build-depends:    base+                  , keyed-vals-mem+                  , keyed-vals-hspec-tests+                  , hspec+  default-language: Haskell2010+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs
+ src/KeyedVals/Handle/Mem.hs view
@@ -0,0 +1,248 @@+{-# 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 = do+  v <- liftIO $ newTVarIO (mempty, False)+  pure $+    Handle+      { hLoadVal = hLoadVal' v+      , hSaveVal = hSaveVal' v+      , hCountKVs = hCountKVs' v+      , hLoadKVs = hLoadKVs' v+      , hSaveKVs = hSaveKVs' v+      , hUpdateKVs = hUpdateKVs' v+      , hLoadFrom = hLoadFrom' v+      , hSaveTo = hSaveTo' v+      , hLoadSlice = hLoadSlice' v+      , hDeleteSelected = hDeleteSelected' v+      , hDeleteSelectedKVs = hDeleteSelectedKVs' v+      , hClose = hClose' 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' var = liftIO $+  atomically $ do+    (fh, _) <- readTVar var+    writeTVar var (fh, True)+++hLoadVal' ::+  MonadUnliftIO m =>+  InMemVar ->+  Key ->+  m (Either HandleErr (Maybe Val))+hLoadVal' var key = withInMemKey var key $ \case+  Nothing -> pure $ Right Nothing+  Just (Dict _) -> pure $ Left BadKey+  Just (Simple v) -> pure $ Right $ Just v+++hSaveVal' ::+  MonadUnliftIO m =>+  InMemVar ->+  Key ->+  Val ->+  m (Either HandleErr ())+hSaveVal' var key value = withInMem' var $ \values -> do+  updateInMem var $ Map.insert key (Simple value) values+++hLoadKVs' ::+  MonadUnliftIO m =>+  InMemVar ->+  Key ->+  m (Either HandleErr ValsByKey)+hLoadKVs' var key = withInMemKey var key $ \case+  Nothing -> pure $ Right Map.empty+  Just (Dict v) -> pure $ Right v+  Just (Simple _) -> pure $ Left BadKey+++hLoadSlice' ::+  MonadUnliftIO m =>+  InMemVar ->+  Key ->+  Selection ->+  m (Either HandleErr ValsByKey)+hLoadSlice' var key sel = withInMemKey var key $ \case+  Nothing -> pure $ Right Map.empty+  Just (Dict v) -> pure $ Right $ Map.filterWithKey (predOf sel) v+  Just (Simple _) -> pure $ Left BadKey+++hCountKVs' ::+  MonadUnliftIO m =>+  InMemVar ->+  Key ->+  m (Either HandleErr Natural)+hCountKVs' var key = withInMemKey var key $ \case+  Nothing -> pure $ Right 0+  Just (Dict v) -> pure $ Right $ fromInteger $ toInteger $ Map.size v+  Just (Simple _) -> pure $ Left BadKey+++hSaveKVs' ::+  MonadUnliftIO m =>+  InMemVar ->+  Key ->+  ValsByKey ->+  m (Either HandleErr ())+hSaveKVs' var key d = withInMem' var $ \values -> do+  updateInMem var $ Map.insert key (Dict d) values+++hUpdateKVs' ::+  MonadUnliftIO m =>+  InMemVar ->+  Key ->+  ValsByKey ->+  m (Either HandleErr ())+hUpdateKVs' var key d = withInMem' var $ \values ->+  case Map.lookup key values of+    Nothing -> do+      updateInMem var $ Map.insert key (Dict d) values+    Just (Dict d') -> do+      updateInMem var $ Map.insert key (Dict $ Map.union d d') values+    Just (Simple _) -> pure $ Left BadKey+++updateInMem :: TVar (a, Bool) -> a -> STM (Either err ())+updateInMem var newMap = do+  writeTVar var (newMap, False)+  pure $ Right ()+++hSaveTo' ::+  MonadUnliftIO m =>+  InMemVar ->+  Key ->+  Key ->+  Val ->+  m (Either HandleErr ())+hSaveTo' var key dictKey value = withInMem' var $ \values ->+  case Map.lookup key values of+    Nothing -> do+      updateInMem var $ Map.insert key (Dict $ Map.singleton dictKey value) values+    Just (Dict d) -> do+      updateInMem var $ Map.insert key (Dict $ Map.insert dictKey value d) values+    Just (Simple _) -> pure $ Left BadKey+++hLoadFrom' ::+  MonadUnliftIO m =>+  InMemVar ->+  Key ->+  Key ->+  m (Either HandleErr (Maybe Val))+hLoadFrom' var key dictKey = withInMemKey var key $ \case+  Nothing -> pure $ Right Nothing+  Just (Dict d) -> pure $ Right $ Map.lookup dictKey d+  Just (Simple _) -> pure $ Left BadKey+++hDeleteSelectedKVs' ::+  MonadUnliftIO m =>+  InMemVar ->+  Key ->+  Selection ->+  m (Either HandleErr ())+hDeleteSelectedKVs' var key sel = withInMem' var $ \values ->+  case Map.lookup key values of+    Nothing -> pure $ Right ()+    Just (Dict d) -> do+      writeTVar var (Map.insert key (Dict (Map.filterWithKey (notSel sel) d)) values, False)+      pure $ Right ()+    Just (Simple _) -> pure $ Left BadKey+++hDeleteSelected' ::+  MonadUnliftIO m =>+  InMemVar ->+  Selection ->+  m (Either HandleErr ())+hDeleteSelected' var sel = withInMem' var $ \values -> do+  writeTVar var (Map.filterWithKey (notSel sel) values, False)+  pure $ Right ()+++notSel :: Selection -> Key -> p -> Bool+notSel s k _ = not $ k `isIn` s+++predOf :: Selection -> Key -> p -> Bool+predOf s k _ = k `isIn` s+++withInMem :: MonadIO m => TVar t -> (t -> STM a) -> m a+withInMem v f = liftIO $ atomically $ readTVar v >>= f+++withInMem' ::+  MonadUnliftIO m =>+  InMemVar ->+  (InMem -> STM (Either HandleErr a)) ->+  m (Either HandleErr a)+withInMem' var f = withInMem var $ \case+  (_, True) -> pure $ Left ConnectionClosed+  (values, _) -> f values+++withInMemKey ::+  MonadUnliftIO m =>+  InMemVar ->+  Key ->+  (Maybe InMemValue -> STM (Either HandleErr a)) ->+  m (Either HandleErr a)+withInMemKey var key f = withInMem var $ \case+  (_, True) -> pure $ Left ConnectionClosed+  (values, _) -> f (Map.lookup key values)
+ test/Spec.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK prune not-home #-}++{- |+Copyright   : (c) 2022 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3+-}+module Main where++import KeyedVals.Handle.Mem (new)+import System.IO (+  BufferMode (..),+  hSetBuffering,+  stderr,+  stdout,+ )+import Test.Hspec (hspec)+import Test.KeyedVals.Hspec (+  Spec,+  afterAll,+  beforeAll,+  checkHandle,+  closeFixture,+  describe,+  setupFixture,+ )+++main :: IO ()+main = do+  hSetBuffering stdout NoBuffering+  hSetBuffering stderr NoBuffering+  hspec spec+++spec :: Spec+spec =+  describe "Using the Mem handle" $+    beforeAll (new >>= setupFixture) $+      afterAll closeFixture checkHandle