packages feed

keyed-vals (empty) → 0.1.0.0

raw patch · 8 files changed

+615/−0 lines, 8 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, containers, http-api-data, redis-glob, text

Files

+ ChangeLog.md view
@@ -0,0 +1,9 @@+# Revision history for keyed-vals++`keyed-vals` 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,27 @@+# keyed-vals++[![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/badge/nightly)](http://stackage.org/nightly/package/keyed-vals)+[![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/blob/master/LICENSE)++[keyed-vals](https://hackage.haskell.org/package/keyed-vals) aims to provide a+narrow client for storing key-value collections in storage services like+[Redis].++E.g,++  - [Redis] supports many other features+  - the abstract [Handle] declared in `keyed-vals` just provides combinators that operate on key-value collections stored in some backend+  - so the redis implementation of [Handle] accesses collections in Redis *without* exposing its other features.+++[hackage-deps-badge]: <https://img.shields.io/hackage-deps/v/keyed-vals.svg>+[hackage-deps]:       <http://packdeps.haskellers.com/feed?needle=keyed-vals>+[hackage-badge]:      <https://img.shields.io/hackage/v/keyed-vals.svg>+[hackage]:            <https://hackage.haskell.org/package/keyed-vals>+[Handle]:             <https://jaspervdj.be/posts/2018-03-08-handle-pattern.html>+[Redis]:              <https://redis.io>
+ Setup.hs view
@@ -0,0 +1,4 @@+import Distribution.Simple+++main = defaultMain
+ keyed-vals.cabal view
@@ -0,0 +1,45 @@+cabal-version:      3.0+name:               keyed-vals+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:           An abstract Handle for accessing collections in stores like Redis+description:+  Provides an abstract [Handle](https://jaspervdj.be/posts/2018-03-08-handle-pattern.html) for+  accessing stored key-value collections, and useful combinators that use Handle.++  E.g, one implementation of Handle accesses collections in+  in [Redis](https://redis.io/); other backends are possible.++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+    KeyedVals.Handle.Aeson+    KeyedVals.Handle.Internal++  hs-source-dirs:   src+  default-language: Haskell2010+  ghc-options:      -Wall -Wincomplete-uni-patterns -fwarn-tabs+  build-depends:+    , aeson          >=1.5.1    && <2.2+    , base           >=4.11     && <5.0+    , bytestring     >=0.10.8.2 && <0.11 || >=0.11.3.1 && <0.12+    , containers     >=0.6.5    && <0.7+    , http-api-data  >=0.5      && <0.6+    , redis-glob     >=0.1      && <0.2+    , text           >=1.2.4    && <1.3  || >=2.0
+ src/KeyedVals/Handle.hs view
@@ -0,0 +1,125 @@+{-# OPTIONS_HADDOCK prune not-home #-}++{- |+Copyright   : (c) 2018-2022 Tim Emiola+SPDX-License-Identifier: BSD3+Maintainer  : Tim Emiola <tim@emio.la>++Declares the abstract @'Handle'@ and combinators used to load and save keyed values.+-}+module KeyedVals.Handle (+  -- * 'Handle' and related types and functions+  Handle (),+  HandleErr (..),+  countKVs,+  loadVal,+  saveVal,+  loadKVs,+  saveKVs,+  updateKVs,+  loadSlice,+  loadFrom,+  saveTo,+  deleteKeys,+  deleteKeysFrom,+  deleteMatches,+  deleteMatchesFrom,+  deleteSelected,+  deleteSelectedFrom,+  close,++  -- * 'Selection' and 'Glob'+  Selection (..),+  Glob,+  mkGlob,+  globPattern,+  isIn,++  -- * aliases used by the 'Handle' functions+  Key,+  Val,+  ValsByKey,+) where++import Data.List.NonEmpty (NonEmpty)+import KeyedVals.Handle.Internal+import Numeric.Natural (Natural)+++-- | Loads the saved 'Val' corresponding to a 'Key'.+loadVal :: Handle m -> Key -> m (Either HandleErr (Maybe Val))+loadVal = hLoadVal+++-- | Saves a 'Val' for 'Key'.+saveVal :: Handle m -> Key -> Val -> m (Either HandleErr ())+saveVal = hSaveVal+++-- | Loads a @'ValsByKey'@.+loadKVs :: Handle m -> Key -> m (Either HandleErr ValsByKey)+loadKVs = hLoadKVs+++-- | Saves a @'ValsByKey'@ .+saveKVs :: Handle m -> Key -> ValsByKey -> m (Either HandleErr ())+saveKVs = hSaveKVs+++-- | Loads a @'Val'@ from a @'ValsByKey'@.+loadFrom :: Handle m -> Key -> Key -> m (Either HandleErr (Maybe Val))+loadFrom = hLoadFrom+++-- | Saves a @'Val'@ in a @'ValsByKey'@.+saveTo :: Handle m -> Key -> Key -> Val -> m (Either HandleErr ())+saveTo = hSaveTo+++-- | Loads a @'ValsByKey'@ that only includes @'Val's@ whose keys match a @Selection@.+loadSlice :: Handle m -> Key -> Selection -> m (Either HandleErr ValsByKey)+loadSlice = hLoadSlice+++-- | Updates the stored @'ValsByKey'@ from the given @'ValsByKey'@.+updateKVs :: Handle m -> Key -> ValsByKey -> m (Either HandleErr ())+updateKVs = hUpdateKVs+++-- | Deletes @'Val's@ stored with the given @'Key's@.+deleteKeys :: Handle m -> NonEmpty Key -> m (Either HandleErr ())+deleteKeys h keys = deleteSelected h $ AllOf keys+++-- | Deletes @'Val's@ that match a @'Selection'@.+deleteSelected :: Handle m -> Selection -> m (Either HandleErr ())+deleteSelected = hDeleteSelected+++-- | Deletes @'Val's@ whose @Keys@ match a @Glob@.+deleteMatches :: Handle m -> Glob -> m (Either HandleErr ())+deleteMatches h g = deleteSelected h $ Match g+++-- | Deletes @'Val's@ for the given @Keys@ from a @'ValsByKey'@.+deleteKeysFrom :: Handle m -> Key -> NonEmpty Key -> m (Either HandleErr ())+deleteKeysFrom h key ks = deleteSelectedFrom h key $ AllOf ks+++-- | Deletes @'Val's@ whose @Keys@  match a @Selection@ from a @'ValsByKey'@+deleteSelectedFrom :: Handle m -> Key -> Selection -> m (Either HandleErr ())+deleteSelectedFrom = hDeleteSelectedKVs+++-- | Deletes @'Val's@ whose @Keys@  match a @Glob@ from a @'ValsByKey'@+deleteMatchesFrom :: Handle m -> Key -> Glob -> m (Either HandleErr ())+deleteMatchesFrom h key g = deleteSelectedFrom h key $ Match g+++-- | Determines the number of @'Vals'@ in a @'ValsByKey'@.+countKVs :: Handle m -> Key -> m (Either HandleErr Natural)+countKVs = hCountKVs+++close :: Handle m -> m ()+close = hClose
+ src/KeyedVals/Handle/Aeson.hs view
@@ -0,0 +1,268 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK prune not-home #-}++{- |+Copyright   : (c) 2018-2022 Tim Emiola+SPDX-License-Identifier: BSD3+Maintainer  : Tim Emiola <tim@emio.la>++Functions that help use Aeson to load and save JSON data using the+dictionary service+-}+module KeyedVals.Handle.Aeson (+  -- * decode/encode support+  decodeOr,+  decodeOr',+  decodeOrGone,+  decodeOrGone',+  jsonVal,+  jsonKey,+  webKey,+  appendWebKey,+  substWebKey,+  prependWebKey,++  -- * decode @ValsByKey@+  decodeJsonKeyKVs,+  decodeWebKeyKVs,++  -- * save @ValsByKey@ using a @Handle@+  saveKVs,+  saveKVs',+  saveJsonKeyKVs,+  saveHttpApiKVs,+  updateHttpApiKVs,+) where++import Data.Aeson (+  FromJSON (..),+  ToJSON (..),+  eitherDecodeStrict',+  encode,+ )+import Data.Bifunctor (bimap)+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as LBS+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as Text+import KeyedVals.Handle.Internal+import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))+++-- | Encode JSON as a remote value.+jsonVal :: ToJSON a => a -> Val+jsonVal = encodeJSON+++webKey :: ToHttpApiData a => a -> Key+webKey = toHeader+++substWebKey :: ToHttpApiData a => a -> Key -> Key+substWebKey x template =+  let (prefix, afterPre) = B.breakSubstring mustache template+      suffix = B.drop (B.length mustache) afterPre+      result = prefix <> webKey x <> suffix+   in if B.isPrefixOf mustache afterPre then result else template+++appendWebKey :: ToHttpApiData a => Key -> a -> Key -> Key+appendWebKey sep x template = template <> sep <> webKey x+++prependWebKey :: ToHttpApiData a => Key -> a -> Key -> Key+prependWebKey sep x template = webKey x <> sep <> template+++mustache :: ByteString+mustache = "{}"+++jsonKey :: ToJSON a => a -> Key+jsonKey = encodeJSON+++decodeOrGone ::+  FromJSON b =>+  Key ->+  Maybe Val ->+  Either HandleErr b+decodeOrGone key x =+  case decodeOr NotDecoded x of+    Left err -> Left err+    Right mb -> maybe (Left $ Gone key) Right mb+++decodeOrGone' ::+  FromJSON b =>+  Key ->+  Either HandleErr (Maybe Val) ->+  Either HandleErr b+decodeOrGone' key = either Left $ decodeOrGone key+++decodeOr' ::+  FromJSON b =>+  Either HandleErr (Maybe Val) ->+  Either HandleErr (Maybe b)+decodeOr' = either Left (decodeOr NotDecoded)+++-- | Decode a JSON value, transforming decode errors to type @err@ if they occur.+decodeOr ::+  (FromJSON a) =>+  (Text -> err) ->+  Maybe Val ->+  Either err (Maybe a)+decodeOr f = maybe (pure Nothing) (firstEither (f . Text.pack) . eitherDecodeStrict')+++{- | Decode a @ValsByKey@ serialized as JSON.++Both the key and value types are valid to deserialize as JSON.+-}+decodeJsonKeyKVs ::+  (Ord a, FromJSON a, FromJSON b) =>+  (Text -> c) ->+  ValsByKey ->+  Either c (Map a b)+decodeJsonKeyKVs f = firstEither f . decodeKVs' decoder+  where+    decoder = firstEither Text.pack . eitherDecodeStrict'+++{- | Decode a @ValsByKey@ serialized as JSON.++- The key type is deserialized as HttpApiData.+- The value type is valid to deserialize as JSON.+-}+decodeWebKeyKVs ::+  (Ord a, FromHttpApiData a, FromJSON b) =>+  (Text -> c) ->+  ValsByKey ->+  Either c (Map a b)+decodeWebKeyKVs f = firstEither f . decodeKVs' parseHeader+++{- | Decode a @ValsByKey@ with values serialized as JSON.++The value type is deserialized as JSON+-}+decodeKVs' ::+  (Ord a, FromJSON b) =>+  (Val -> Either Text a) ->+  ValsByKey ->+  Either Text (Map a b)+decodeKVs' decoder =+  let step _ _ (Left x) = Left x+      step k v (Right m) = case (decoder k, eitherDecodeStrict' v) of+        (Left x, _) -> Left x+        (_, Left y) -> Left $ Text.pack y+        (Right k', Right v') -> Right $ Map.insert k' v' m+   in Map.foldrWithKey step (Right Map.empty)+++{- | Encode a @ValsByKey@ serialized as JSON.++- Both @'Key's@ and @'Val's@ are encoded using 'ToJSON'+-}+saveJsonKeyKVs ::+  (Ord a, ToJSON a, ToJSON b, Monad m) =>+  (HandleErr -> err) ->+  Handle m ->+  Key ->+  Map a b ->+  m (Either err ())+saveJsonKeyKVs f = saveKVs f encodeJSON+++{- | Encode a @ValsByKey@ serialized as JSON, completely replacing the current value if present.++- @'Key's@ encode using 'HttpApiData'+- @'Val's@ encode using 'ToJSON'+-}+saveHttpApiKVs ::+  (Ord a, ToHttpApiData a, ToJSON b, Monad m) =>+  (HandleErr -> err) ->+  Handle m ->+  Key ->+  Map a b ->+  m (Either err ())+saveHttpApiKVs fromHandleErr = saveKVs fromHandleErr toHeader+++-- | Like 'saveHttpApiKVs', but updates the keys rather than completely replacing it.+updateHttpApiKVs ::+  (Ord a, ToHttpApiData a, ToJSON b, Monad m) =>+  (HandleErr -> err) ->+  Handle m ->+  Key ->+  Map a b ->+  m (Either err ())+updateHttpApiKVs fromHandleErr = saveOrUpdateKVs True fromHandleErr toHeader+++-- | Like 'saveKVs', with 'HandleErr' as the error type.+saveKVs' ::+  (Ord a, ToJSON b, Monad m) =>+  (a -> Val) ->+  Handle m ->+  Key ->+  Map a b ->+  m (Either HandleErr ())+saveKVs' = saveKVs id+++{- |  Encode a 'Map' as a 'ValsByKey' with the @'Val's@ encoded as JSON.++- The @Map@ keys is encoded as @'Key's@ using the provided function,+- The @Map@ values are encoded as @'Val's@ by conversion to JSON.+- 'HandleErr' may be transformed to different error type+-}+saveKVs ::+  (Ord a, ToJSON b, Monad m) =>+  (HandleErr -> err) ->+  (a -> Val) ->+  Handle m ->+  Key ->+  Map a b ->+  m (Either err ())+saveKVs = saveOrUpdateKVs False+++{- | Encode a 'Map' as a 'ValsByKey' with the @'Val's@ encoded as JSON.++- The @Map@ keys is encoded as @'Key's@ using the provided function,+- The @Map@ values are encoded as @'Val's@ by conversion to JSON.+- Allows 'HandleErr' to be converted to a different error type.+-}+saveOrUpdateKVs ::+  (Ord a, ToJSON b, Monad m) =>+  -- | when @True@, the dict is updated+  Bool ->+  (HandleErr -> err) ->+  (a -> Val) ->+  Handle m ->+  Key ->+  Map a b ->+  m (Either err ())+saveOrUpdateKVs _ _ _ _ _ dict | Map.size dict == 0 = pure $ Right ()+saveOrUpdateKVs update toErr fromKey h key dict =+  let asRemote =+        Map.fromList+          . fmap (bimap fromKey encodeJSON)+          . Map.toList+      saver = if update then hUpdateKVs else hSaveKVs+   in fmap (firstEither toErr) $ saver h key $ asRemote dict+++firstEither :: (err1 -> err2) -> Either err1 b -> Either err2 b+firstEither f = either (Left . f) Right+++-- | Encode JSON as a remote value.+encodeJSON :: ToJSON a => a -> Val+encodeJSON = LBS.toStrict . encode
+ src/KeyedVals/Handle/Internal.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE StrictData #-}+{-# OPTIONS_HADDOCK prune not-home #-}++{- |+Module      : KeyedVals.Handle.Internal+Copyright   : (c) 2022 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3++Declares the abstract @'Handle'@+-}+module KeyedVals.Handle.Internal (+  -- * types used in the @Handle@ functions+  HandleErr (..),+  Glob,+  mkGlob,+  globPattern,+  isIn,+  Selection (..),++  -- * the abstract @Handle@+  Handle (..),++  -- * aliases used in the 'Handle' functions+  Key,+  Val,+  ValsByKey,+) where++import Control.Exception (Exception)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as LB+import Data.List.NonEmpty (NonEmpty (..))+import Data.Map.Strict (Map)+import Data.Text (Text)+import Numeric.Natural (Natural)+import Redis.Glob (matches, validate)+++-- | A handle for accessing the 'ValsByKey' store.+data Handle m = Handle+  { hLoadVal :: !(Key -> m (Either HandleErr (Maybe Val)))+  , hSaveVal :: !(Key -> Val -> m (Either HandleErr ()))+  , hCountKVs :: !(Key -> m (Either HandleErr Natural))+  , hLoadKVs :: !(Key -> m (Either HandleErr ValsByKey))+  , hSaveKVs :: !(Key -> ValsByKey -> m (Either HandleErr ()))+  , hUpdateKVs :: !(Key -> ValsByKey -> m (Either HandleErr ()))+  , hLoadFrom :: !(Key -> Key -> m (Either HandleErr (Maybe Val)))+  , hSaveTo :: !(Key -> Key -> Val -> m (Either HandleErr ()))+  , hLoadSlice :: !(Key -> Selection -> m (Either HandleErr ValsByKey))+  , hDeleteSelected :: !(Selection -> m (Either HandleErr ()))+  , hDeleteSelectedKVs :: !(Key -> Selection -> m (Either HandleErr ()))+  , hClose :: !(m ())+  }+++-- | Represents the errors that might arise in 'Handle' functions+data HandleErr+  = ConnectionClosed+  | Unanticipated !Text+  | NotDecoded !Text+  | BadKey+  | Gone !Key+  deriving (Eq, Show)+++-- | Represents ways of restricting the keys used in a @'ValsByKey'@+data Selection+  = -- | any keys that match the glob pattern+    Match !Glob+  | -- | any of the specified keys+    AllOf !(NonEmpty Key)+  deriving (Eq, Show)+++-- | Represents a redis glob use to select keys+newtype Glob = Glob {globPattern :: ByteString}+  deriving (Eq, Show)+++{- | constructor for a 'Glob'++returns 'Nothing' if the pattern is invalid+-}+mkGlob :: ByteString -> Maybe Glob+mkGlob = fmap (Glob . LB.toStrict) . validate . LB.fromStrict+++-- | tests if a 'ByteString' matches a Selection+isIn :: ByteString -> Selection -> Bool+isIn b (Match g) = LB.fromStrict b `matches` LB.fromStrict (globPattern g)+isIn b (AllOf (key :| ks)) = key == b || b `elem` ks+++instance Exception HandleErr+++-- | Represents a key used to store a 'Value'.+type Key = ByteString+++-- | Represents a value stored in the service.+type Val = ByteString+++-- | Represents a related group of @'Value'@s stored by @'Key'@.+type ValsByKey = Map Key Val