keyed-vals 0.1.0.0 → 0.2.0.0

raw patch · 10 files changed

+845/−282 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +15/−0
• README.md +129/−7
• keyed-vals.cabal +13/−4
• src/KeyedVals/Handle.hs +1/−1
• src/KeyedVals/Handle/Aeson.hs +0/−268
• src/KeyedVals/Handle/Codec.hs +165/−0
• src/KeyedVals/Handle/Codec/Aeson.hs +35/−0
• src/KeyedVals/Handle/Codec/HttpApiData.hs +31/−0
• src/KeyedVals/Handle/Internal.hs +2/−2
• src/KeyedVals/Handle/Typed.hs +454/−0

@@ -2,8 +2,23 @@  `keyed-vals` uses [PVP Versioning][1]. +## 0.2.0.0 -- 2022-12-15++Changed++* generalized encoding and decoding using [KeyedVals.Handle.Codec][]; this+  replaces KeyedVals.Handle.Aeson+++Added++* support for encoding and decoding typed keys and values constrained to+  specific paths in the key-value store in [KeyedVals.Handle.Typed][]+ ## 0.1.0.0 -- 2022-11-28  * Initial version.  [1]: https://pvp.haskell.org+[KeyedVals.Handle.Typed]: https://hackage.haskell.org/package/keyed-vals/docs/KeyedVals-Handle.Typed.html+[KeyedVals.Handle.Codec]: https://hackage.haskell.org/package/keyed-vals/docs/KeyedVals-Handle.Codec.html

@@ -16,12 +16,134 @@    - [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.+  - so the [redis implementation] of [Handle] accesses collections in Redis *without* exposing its other features. +## Example -[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>+```haskell+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}++import Data.Aeson (FromJSON, ToJSON)+import Data.Text (Text)+import GHC.Generics (Generic)+import KeyedVals.Handle.Codec.Aeson (AesonOf(..))+import KeyedVals.Handle.Codec.HttpApiData (HttpApiDataOf(..))+import qualified KeyedVals.Handle.Mem as Mem+import KeyedVals.Handle.Typed+import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))++{- Usage is fairly simple:++- Declare 'PathOf' and possibly a 'VaryingPathOf' instance for+  storable data types.++They describe how the data type is encoded and decoded and where in the+key-value store the data should be saved.++For example, given the following data type:+-}+data Person = Person+  { name :: Text+  , age  :: Int+  } deriving (Eq, Show, Generic)++{- Suppose each @Person@ is to be stored as JSON, via the @Generic@+implementation, e.g,+-}+instance FromJSON Person+instance ToJSON Person++{- Also suppose each Person is stored with an @Int@ key. To enable that,+define a @newtype@ of @Int@, e.g,+-}+newtype PersonID = PersonID Int+  deriving stock (Eq, Show)+  deriving (ToHttpApiData, FromHttpApiData, Num, Ord) via Int++{- And then suppose the collection of @Person@s is stored at a specific fixed path+in the key-value store. E.g, it is to be used as a runtime cache to speed up+access to person data, so the path @/runtime/cache/persons@ is used.++To specify all of this, first define @DecodeKV@ and @EncodeKV@ instances for+@Person@:+-}+deriving via (AesonOf Person) instance DecodeKV Person+deriving via (AesonOf Person) instance EncodeKV Person++{- .. and do the same for @PersonID@: -}+deriving via (HttpApiDataOf Int) instance DecodeKV PersonID+deriving via (HttpApiDataOf Int) instance EncodeKV PersonID+++{- Then declare a @PathOf@ instance that binds the types together with the path: -}+instance PathOf Person where+  type KVPath Person = "/runtime/cache/persons"+  type KeyType Person = PersonID++{- Note: the @DecodeKV@ and @EncodeKV@ deriving statements above were+standalone for illustrative purposes. In most cases, they ought to be part+of the deriving clause of the data type. E.g,+-}+newtype FriendID = FriendID Int+  deriving stock (Eq, Show)+  deriving (ToHttpApiData, FromHttpApiData, Num, Ord) via Int+  deriving (DecodeKV, EncodeKV) via (HttpApiDataOf Int)++{- Now save and fetch @Person@s from a storage backend as follows:++>>> handle <- Mem.new+>>> tim = Person { name = "Tim", age = 48 }+>>> saveTo handle (key 1) tim+Right ()+>>> loadFrom handle (key 1)+Right (Person { name = "Tim", age = 48 })++-}++{- Suppose that in addition to the main collection of @Person@s, it's+necessary to store a distinct list of the friends of each @Person@.+I.e, store a small keyed collection of @Person@s per person.++One way to achieve is to store each such collection at a similar path, e.g+suppose the friends for the person with @anID@ are stored at+@/app/person/<anId>/friends@.++This can be implemented using the existing types along with another newtype+that has @PathOf@ and @VaryingPathOf@ instances as follows+-}++newtype Friend = Friend Person+  deriving stock (Eq, Show)+  deriving (FromJSON, ToJSON, EncodeKV, DecodeKV) via Person++instance PathOf Friend where+  type KVPath Friend = "/app/person/{}/friends"+  type KeyType Friend = FriendID -- as defined earlier++instance VaryingPathOf Friend where+  type PathVar Friend = PersonID+  modifyPath _ = expand -- implements modifyPath by expanding the braces to PathVar+++{- This allows @Friends@ to be saved or fetched as follows:++>>> dave = Person { name = "Dave", age = 61 }+>>> saveTo handle (key 2) dave -- save in main person list+Right ()+>>> saveTo handle ( 1 // 2) (Friend dave) -- save as friend of tim (person 1)+Right ()+-}++```++[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://hackage.haskell.org/package/keyed-vals-0.1.0.0/docs/KeyedVals-Handle.html>+[Redis]:                <https://redis.io>++[redis implementation]: <https://hackage.haskell.org/package/keyed-vals-redis>

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               keyed-vals-version:            0.1.0.0+version:            0.2.0.0 license:            BSD-3-Clause license-file:       LICENSE maintainer:         adetokunbo@emio.la@@ -13,9 +13,15 @@   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.+  One implementation of Handle accesses collections in [Redis](https://hackage.haskell.org/package/keyed-vals-redis) other backends are possible. +  keyed-vals also provides a typed interface to the storage backend that allows the+  path in the storage backend to be declaratively linked to the types of data+  stored via a straightforward typeclass declaration.++  Read this [short example](https://github.com/adetokunbo/keyed-vals/tree/main/keyed-vals#example)+  for an introduction its usage.+ category:           Data, Redis build-type:         Simple extra-source-files:@@ -29,8 +35,11 @@ library   exposed-modules:     KeyedVals.Handle-    KeyedVals.Handle.Aeson+    KeyedVals.Handle.Codec+    KeyedVals.Handle.Codec.Aeson+    KeyedVals.Handle.Codec.HttpApiData     KeyedVals.Handle.Internal+    KeyedVals.Handle.Typed    hs-source-dirs:   src   default-language: Haskell2010

@@ -116,7 +116,7 @@ deleteMatchesFrom h key g = deleteSelectedFrom h key $ Match g  --- | Determines the number of @'Vals'@ in a @'ValsByKey'@.+-- | Determines the number of @'Val's@ in a @'ValsByKey'@. countKVs :: Handle m -> Key -> m (Either HandleErr Natural) countKVs = hCountKVs 

@@ -1,268 +0,0 @@-{-# 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

@@ -0,0 +1,165 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK prune not-home #-}++{- |+Copyright   : (c) 2018-2022 Tim Emiola+SPDX-License-Identifier: BSD3+Maintainer  : Tim Emiola <tim@emio.la>++Provides a typeclass that converts types to and from keys or vals and+combinators that help it to encode data using 'Handle'++This serves to decouple the encoding/decoding, making it straightforward to use+the typed interface in 'KeyedVals.Handle.Typed' with a wide set of+encoding/decoding schemes+-}+module KeyedVals.Handle.Codec (+  -- * decode/encode support+  EncodeKV (..),+  DecodeKV (..),+  decodeOr,+  decodeOr',+  decodeOrGone,+  decodeOrGone',++  -- * decode encoded @ValsByKey@+  decodeKVs,++  -- * save encoded @ValsByKey@ using a @Handle@+  saveEncodedKVs,+  updateEncodedKVs,++  -- * error conversion+  FromHandleErr (..),+) where++import Data.Bifunctor (bimap)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import KeyedVals.Handle+++-- | Specifies how type @a@ encodes as a @Key@ or a @Val@.+class EncodeKV a where+  encodeKV :: a -> Val+++-- | Specifies how type @a@ can be decoded from a @Key@ or a @Val@.+class DecodeKV a where+  decodeKV :: Val -> Either Text a+++-- | Specifies how to turn 'HandleErr' into a custom error type @err@.+class FromHandleErr err where+  fromHandleErr :: HandleErr -> err+++instance FromHandleErr HandleErr where+  fromHandleErr = id+++-- | Like 'decodeOr', but transforms 'Nothing' to 'Gone'.+decodeOrGone ::+  (DecodeKV b, FromHandleErr err) =>+  Key ->+  Maybe Val ->+  Either err b+decodeOrGone key x =+  case decodeOr x of+    Left err -> Left err+    Right mb -> maybe (Left $ fromHandleErr $ Gone key) Right mb+++-- | Like 'decodeOr'', but transforms 'Nothing' to 'Gone'.+decodeOrGone' ::+  (DecodeKV b, FromHandleErr err) =>+  Key ->+  Either err (Maybe Val) ->+  Either err b+decodeOrGone' key = either Left $ decodeOrGone key+++-- | Decode a value, transformi decode errors to type @err@.+decodeOr' ::+  (DecodeKV b, FromHandleErr err) =>+  Either err (Maybe Val) ->+  Either err (Maybe b)+decodeOr' = either Left decodeOr+++-- | Decode a value, transforming decode errors to type @err@.+decodeOr ::+  (DecodeKV a, FromHandleErr err) =>+  Maybe Val ->+  Either err (Maybe a)+decodeOr = maybe (pure Nothing) (fmap Just . firstEither notDecoded . decodeKV)+++notDecoded :: FromHandleErr err => Text -> err+notDecoded = fromHandleErr . NotDecoded+++decode' :: (FromHandleErr err, DecodeKV a) => Val -> Either err a+decode' = either (Left . notDecoded) Right . decodeKV+++-- | Decodes a 'Map' from a @ValsByKey@ with encoded @Keys@ and @Vals@.+decodeKVs ::+  (Ord a, DecodeKV a, DecodeKV b, FromHandleErr err) =>+  ValsByKey ->+  Either err (Map a b)+decodeKVs =+  let step _ _ (Left x) = Left x+      step k v (Right m) = case (decode' k, decode' v) of+        (Left x, _) -> Left x+        (_, Left y) -> Left y+        (Right k', Right v') -> Right $ Map.insert k' v' m+   in Map.foldrWithKey step (Right Map.empty)+++-- | Like 'saveEncodedKVs', but updates the keys rather than completely replacing it.+updateEncodedKVs ::+  (Ord a, EncodeKV a, EncodeKV b, Monad m, FromHandleErr err) =>+  Handle m ->+  Key ->+  Map a b ->+  m (Either err ())+updateEncodedKVs = saveOrUpdateKVs True+++{- | Encode a 'Map' as a 'ValsByKey' with the @'Key's@ and @'Val's@ encoded.++- 'HandleErr' may be transformed to different error type+-}+saveEncodedKVs ::+  (Ord a, EncodeKV a, EncodeKV b, Monad m, FromHandleErr err) =>+  Handle m ->+  Key ->+  Map a b ->+  m (Either err ())+saveEncodedKVs = saveOrUpdateKVs False+++-- | Encode any 'Map' as a 'ValsByKey' by encoding its @'Key's@ and @'Val's@.+saveOrUpdateKVs ::+  (Ord a, EncodeKV a, EncodeKV b, Monad m, FromHandleErr err) =>+  -- | when @True@, the dict is updated+  Bool ->+  Handle m ->+  Key ->+  Map a b ->+  m (Either err ())+saveOrUpdateKVs _ _ _ kvs | Map.size kvs == 0 = pure $ Right ()+saveOrUpdateKVs update h key dict =+  let asRemote =+        Map.fromList+          . fmap (bimap encodeKV encodeKV)+          . Map.toList+      saver = if update then (updateKVs h) else (saveKVs h)+   in fmap (firstEither fromHandleErr) $ saver key $ asRemote dict+++firstEither :: (err1 -> err2) -> Either err1 b -> Either err2 b+firstEither f = either (Left . f) Right

@@ -0,0 +1,35 @@+{-# OPTIONS_HADDOCK prune not-home #-}++{- |+Copyright   : (c) 2022 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3+-}+module KeyedVals.Handle.Codec.Aeson (+  -- * newtypes+  AesonOf (..),+) where++import Data.Aeson (+  FromJSON (..),+  ToJSON (..),+  eitherDecodeStrict',+  encode,+ )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Text as Text+import KeyedVals.Handle.Codec (DecodeKV (..), EncodeKV (..))+++{- | A deriving-via helper type for types that implement 'DecodeKV' and 'EncodeKV'+ using Aeson's 'FromJSON' and 'ToJSON' type classes.+-}+newtype AesonOf a = AesonOf {fromAesonOf :: a}+++instance FromJSON a => DecodeKV (AesonOf a) where+  decodeKV = either (Left . Text.pack) (Right . AesonOf) . eitherDecodeStrict'+++instance ToJSON a => EncodeKV (AesonOf a) where+  encodeKV = LBS.toStrict . encode . fromAesonOf

@@ -0,0 +1,31 @@+{-# OPTIONS_HADDOCK prune not-home #-}++{- |+Copyright   : (c) 2022 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3+-}+module KeyedVals.Handle.Codec.HttpApiData (+  -- * newtypes+  HttpApiDataOf (..),+) where++import KeyedVals.Handle.Codec (DecodeKV (..), EncodeKV (..))+import Web.HttpApiData (+  FromHttpApiData (..),+  ToHttpApiData (..),+ )+++{- | A deriving-via helper type for types that implement 'DecodeKV' and 'EncodeKV'+ using 'FromHttpApiData' and 'ToHttpApiData' type classes.+-}+newtype HttpApiDataOf a = HttpApiDataOf {fromHttpApiDataOf :: a}+++instance FromHttpApiData a => DecodeKV (HttpApiDataOf a) where+  decodeKV = fmap HttpApiDataOf . parseHeader+++instance ToHttpApiData a => EncodeKV (HttpApiDataOf a) where+  encodeKV = toHeader . fromHttpApiDataOf

@@ -95,7 +95,7 @@ instance Exception HandleErr  --- | Represents a key used to store a 'Value'.+-- | Represents a key used to store a 'Val'. type Key = ByteString  @@ -103,5 +103,5 @@ type Val = ByteString  --- | Represents a related group of @'Value'@s stored by @'Key'@.+-- | Represents a related group of @'Val'@s stored by @'Key'@. type ValsByKey = Map Key Val

@@ -0,0 +1,454 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_HADDOCK prune not-home #-}++{- |+Module      : KeyedVals.Handle.Typed+Copyright   : (c) 2022 Tim Emiola+Maintainer  : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3++Provides typeclasses, data types and combinators that constrain the @types@ of+keys and values accessed in the key-value store, whilst also linking them to specific+storage paths.+-}+module KeyedVals.Handle.Typed (+  -- * How use this module+  -- $use++  -- * type-and-path-constrained Handle combinators+  TypedKVs,+  countKVs,+  loadFrom,+  loadKVs,+  loadSlice,+  mayLoadFrom,+  modKVs,+  saveTo,+  saveKVs,+  updateKVs,++  -- * link key-value collections to a path+  PathOf (..),+  VaryingPathOf (..),+  rawPath,+  expand,+  prepend,+  append,++  -- * unify @PathOf@/@VaryingPathOf@+  TypedPath (..),+  TypedKey,+  pathKey,+  pathOf,+  key,+  (//),++  -- * module re-exports+  module KeyedVals.Handle,+  module KeyedVals.Handle.Codec,+) where++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as C8+import Data.Functor ((<&>))+import Data.List.NonEmpty (NonEmpty)+import Data.Map.Strict (Map)+import Data.Proxy (Proxy (Proxy))+import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)+import KeyedVals.Handle (+  Handle,+  HandleErr (..),+  Key,+  Selection (..),+  close,+ )+import qualified KeyedVals.Handle as H+import KeyedVals.Handle.Codec+import Numeric.Natural+++{- $use++ This section contains information on how to store data using this library.+ It starts with a preamble that shows the directives and imports used in the+ examples below++ > {\-# LANGUAGE DeriveGeneric #-\}+ > {\-# LANGUAGE DerivingVia #-\}+ > {\-# LANGUAGE OverloadedStrings #-\}+ > {\-# LANGUAGE StandaloneDeriving #-\}+ >+ > import Data.Aeson (FromJSON, ToJSON)+ > import Data.Text (Text)+ > import GHC.Generics (Generic)+ > import KeyedVals.Handle.Codec.Aeson (AesonOf(..))+ > import KeyedVals.Handle.Codec.HttpApiData (HttpApiDataOf(..))+ > import qualified KeyedVals.Handle.Mem as Mem+ > import KeyedVals.Handle.Typed+ > import Web.HttpApiData (FromHttpApiData, ToHttpApiData)++ Usage is fairly simple: 'PathOf' and possibly a 'VaryingPathOf' instance for+ storable data types are declared. They describe how the data type is encoded+ and decoded and where in the key-value store the data should be saved.++ For example, given this data type:++ > data Person = Person+ >   { name :: Text+ >   , age  :: Int+ >   } deriving (Eq, Show, Generic)++ Suppose each @Person@ is to be stored as JSON, via the @Generic@+ implementation, e.g,++ > instance FromJSON Person+ > instance ToJSON Person++ Also suppose each Person is stored with an Int key. To enable that, define a+ @newtype@ of @Int@, e.g,++ > newtype PersonID = PersonID Int+ >   deriving stock (Eq, Show)+ >   deriving (ToHttpApiData, FromHttpApiData, Num, Ord) via Int++ Also, suppose the collection of @Person@s keyed by @PersonID@ is stored at a+ specific fixed path in the key-value store. E.g, it is to be used as a runtime+ cache to speed up access to person data, so the path @/runtime/cache/persons@+ is used.++ To specify all this, first define @DecodeKV@ and @EncodeKV@ instances for+ @Person@:++ > deriving via (AesonOf Person) instance DecodeKV Person+ > deriving via (AesonOf Person) instance EncodeKV Person++ .. and do the same for @PersonID@:++ > deriving via (HttpApiDataOf Int) instance DecodeKV PersonID+ > deriving via (HttpApiDataOf Int) instance EncodeKV PersonID++ Then declare a @PathOf@ instance that binds the types together with the path:++ > instance PathOf Person where+ >   type KVPath Person = "/runtime/cache/persons"+ >   type KeyType Person = PersonID++ Note: the @DecodeKV@ and @EncodeKV@ deriving statements above were+ standalone for illustrative purposes. In most cases, they ought to be part+ of the deriving clause of the data type. E.g,++ > newtype AnotherID = AnotherID Int+ >   deriving stock (Eq, Show)+ >   deriving (ToHttpApiData, FromHttpApiData, Num, Ord) via Int+ >   deriving (DecodeKV, EncodeKV) via (HttpApiDataOf Int)++ Now one can load and fetch @Person@s from a storage backend using the functions+ in this module, e.g:++ > >>> handle <- Mem.new+ > >>> tim = Person { name = "Tim", age = 48 }+ > >>> saveTo handle (key 1) tim+ > Right ()+ > >>> loadFrom handle (key 1)+ > Right (Person { name = "Tim", age = 48 })++ Suppose that in addition to the main collection of @Person@s, it's necessary to+ store a distinct list of the friends of each @Person@. I.e, store a small keyed+ collection of @Person@s per person.++ One way to achieve is to store each such collection at a similar path, e.g+ suppose the friends for the person with @anID@ are stored at+ @/app/person/<anId>/friends@.++ This can be implemented using the existing types along with another newtype+ that has @PathOf@ and @VaryingPathOf@ instances as follows++ > newtype Friend = Friend Person+ >   deriving stock (Eq, Show)+ >   deriving (FromJSON, ToJSON, EncodeKV, DecodeKV) via Person+ >+ > instance PathOf Friend where+ >   type KVPath Friend = "/app/person/{}/friends"+ >   type KeyType Friend = FriendID -- as defined earlier+ >+ > instance VaryingPathOf Friend where+ >   type PathVar Friend = PersonID+ >   modifyPath _ = expand -- implements modifyPath by expanding the braces to PathVar++ This allows @Friends@ to be saved or fetched as follows:++ > >>> dave = Person { name = "Dave", age = 61 }+ > >>> saveTo handle (key 2) dave -- save in main person list+ > Right ()+ > >>> saveTo handle ( 1 // 2) (Friend dave) -- save as friend of tim (person 1)+ > Right ()+-}+++-- | Obtains the path indicted by a 'TypedPath' as a 'Key'.+pathKey :: forall v. TypedPath v -> Key+pathKey Fixed = rawPath @v Proxy+pathKey (Variable part) = modifyPath @v Proxy part $ rawPath @v Proxy+++-- | Derives the 'TypedPath' corresponding to a 'TypedKey'.+pathOf :: TypedKey v -> TypedPath v+pathOf (ToKey _) = Fixed+pathOf (Extended part _) = Variable part+++{- | Represents a related group of @values@ each stored using a key of type+ @'KeyType' <value type>@+-}+type TypedKVs value = Map (KeyType value) value+++{- | Links the storage path of a group of key-values to the types of the key and+   value.+-}+class+  ( KnownSymbol (KVPath value)+  , EncodeKV (KeyType value)+  , DecodeKV (KeyType value)+  ) =>+  PathOf value+  where+  -- * the storage path where the key-values are saved+  type KVPath value :: Symbol+++  -- * the type of keys in this group of key-values+  type KeyType value+++{- | Allow the storage path specifed by @'PathOf'@ to vary so that related+  groups of key-values may be stored in similar, related paths.+-}+class PathOf value => VaryingPathOf value where+  -- * @PathVar@ is specified to modify the path+  type PathVar value+++  -- * Combines the raw 'KVPath' and @PathVar to obtain a new path.+  modifyPath :: Proxy value -> PathVar value -> Key -> Key+++-- | Supports implementation of 'modifyPath' via substitution of @{}@ within the 'KVPath'.+expand :: EncodeKV a => a -> Key -> Key+expand x template =+  let (prefix, afterPre) = B.breakSubstring braces template+      suffix = B.drop (B.length braces) afterPre+      result = prefix <> encodeKV x <> suffix+   in if B.isPrefixOf braces afterPre then result else template+++{- | Supports implementation of 'modifyPath'++Intended for used within the 'KVPath' of instances of 'VaryingPathOf', indicates where+ a variable should be substituted+-}+braces :: B.ByteString+braces = "{}"+++-- | Supports implementaton of 'modifyPath'.+append :: EncodeKV a => Key -> a -> Key -> Key+append sep x template = template <> sep <> encodeKV x+++-- | Supports implementaton of 'modifyPath'+prepend :: EncodeKV a => Key -> a -> Key -> Key+prepend sep x template = encodeKV x <> sep <> template+++{- | A phantom type indicating either an instance of @'PathOf'@ or of+   @'VaryingPathOf'@.++ Allows combinators with similar behaviour for either to be defined just once,+ rather than separately for each typeclass.+-}+data TypedPath v where+  Fixed :: (PathOf v) => TypedPath v+  Variable :: (VaryingPathOf v) => PathVar v -> TypedPath v+++-- | Similar to 'TypedPath', but includes an actual key along with the phantom type.+data TypedKey v where+  ToKey :: (PathOf v) => KeyType v -> TypedKey v+  Extended :: (VaryingPathOf v) => PathVar v -> KeyType v -> TypedKey v+++-- | Constructs a simple 'TypedKey'.+key :: PathOf v => KeyType v -> TypedKey v+key = ToKey+++-- | Constructs an extended 'TypedKey'.+infixr 5 //+++(//) :: VaryingPathOf v => PathVar v -> KeyType v -> TypedKey v+a // b = Extended a b+++instance EncodeKV (TypedKey v) where+  encodeKV (ToKey x) = encodeKV x+  encodeKV (Extended _ x) = encodeKV x+++-- | Obtain the raw path to key-values that implement 'PathOf'.+rawPath :: forall value. PathOf value => Proxy value -> Key+rawPath _ = C8.pack $ symbolVal @(KVPath value) Proxy+++-- | Like 'mayLoadFrom', but fails with 'Gone' if the value is missing.+loadFrom ::+  forall a m.+  (Monad m, DecodeKV a) =>+  Handle m ->+  TypedKey a ->+  m (Either HandleErr a)+loadFrom h aKey =+  let outer = pathKey $ pathOf aKey+      inner = encodeKV aKey+      full = outer <> "//" <> inner+   in H.loadFrom h outer inner <&> decodeOrGone' full+++{- | Like @'KeyedValues.Handle.loadVal'@ with the key, path and value+ constrained by @'TypedKey'@+-}+mayLoadFrom ::+  forall a m.+  (Monad m, DecodeKV a, PathOf a) =>+  Handle m ->+  TypedKey a ->+  m (Either HandleErr (Maybe a))+mayLoadFrom h aKey =+  let outer = pathKey $ pathOf aKey+      inner = encodeKV aKey+   in H.loadFrom h outer inner <&> decodeOr'+++{- | Like @'KeyedValues.Handle.saveTo'@ with the key, path and value constrained+ by @'TypedKey'@+-}+saveTo ::+  (Monad m, EncodeKV a, PathOf a) =>+  Handle m ->+  TypedKey a ->+  a ->+  m (Either HandleErr ())+saveTo h aKey someKVs =+  let outer = pathKey $ pathOf aKey+      inner = encodeKV aKey+   in H.saveTo h outer inner $ encodeKV someKVs+++{- | Like @'KeyedValues.Handle.loadKVs'@ with the path and key values constrained+ by @'TypedPath'@+-}+loadKVs ::+  ( Monad m+  , DecodeKV a+  , DecodeKV (KeyType a)+  , Ord (KeyType a)+  ) =>+  Handle m ->+  TypedPath a ->+  m (Either HandleErr (TypedKVs a))+loadKVs h k = H.loadKVs h (pathKey k) >>= pure . orDecodeKVs+++{- | Like @'KeyedValues.Handle.updateKVs'@ with the path and key-values+ constrained by @'TypedPath'@+-}+updateKVs ::+  (Monad m, EncodeKV a, EncodeKV (KeyType a), Ord (KeyType a)) =>+  Handle m ->+  TypedPath a ->+  TypedKVs a ->+  m (Either HandleErr ())+updateKVs h aKey = updateEncodedKVs h $ pathKey aKey+++{- | Like @'KeyedValues.Handle.savedKVs'@ with the path and key-values+ constrained by @'TypedPath'@+-}+saveKVs ::+  (Monad m, EncodeKV a, EncodeKV (KeyType a), Ord (KeyType a)) =>+  Handle m ->+  TypedPath a ->+  TypedKVs a ->+  m (Either HandleErr ())+saveKVs h k = saveEncodedKVs h $ pathKey k+++-- | Combines 'saveKVs' and 'loadKVs'+modKVs ::+  ( Monad m+  , EncodeKV a+  , EncodeKV (KeyType a)+  , DecodeKV a+  , DecodeKV (KeyType a)+  , Ord (KeyType a)+  ) =>+  (TypedKVs a -> TypedKVs a) ->+  Handle m ->+  TypedPath a ->+  m (Either HandleErr ())+modKVs modDict h aKey = do+  H.loadKVs h (pathKey aKey) >>= (pure . orDecodeKVs) >>= \case+    Left err -> pure $ Left err+    Right d -> saveKVs h aKey $ modDict d+++{- | Like @'KeyedValues.Handle.loadSlice'@ with the path and key-values+ constrained by @'TypedPath'@+-}+loadSlice ::+  forall m a.+  ( Monad m+  , DecodeKV a+  , PathOf a+  , DecodeKV (KeyType a)+  , Ord (KeyType a)+  ) =>+  Handle m ->+  TypedPath a ->+  NonEmpty (KeyType a) ->+  m (Either HandleErr (TypedKVs a))+loadSlice h aKey keys = do+  let selection = AllOf $ fmap encodeKV keys+  H.loadSlice h (pathKey aKey) selection >>= pure . orDecodeKVs+++orDecodeKVs ::+  (Ord a, DecodeKV a, DecodeKV b) =>+  Either HandleErr H.ValsByKey ->+  Either HandleErr (Map a b)+orDecodeKVs = either Left decodeKVs+++{- | Like @'KeyedValues.Handle.countKVs'@ with the path and key-values+ constrained by @'TypedPath'@+-}+countKVs ::+  forall a m.+  ( Monad m+  , Ord (KeyType a)+  ) =>+  Handle m ->+  TypedPath a ->+  m (Either HandleErr Natural)+countKVs h k = H.countKVs h $ pathKey k