{-# 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 (
TypedKVs,
countKVs,
loadFrom,
loadKVs,
loadSlice,
mayLoadFrom,
modKVs,
saveTo,
saveKVs,
updateKVs,
PathOf (..),
VaryingPathOf (..),
rawPath,
expand,
prepend,
append,
TypedPath (..),
TypedKey,
pathKey,
pathOf,
key,
(//),
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
pathKey :: forall v. TypedPath v -> Key
pathKey :: forall v. TypedPath v -> ByteString
pathKey TypedPath v
Fixed = forall value. PathOf value => Proxy value -> ByteString
rawPath @v Proxy v
forall {k} (t :: k). Proxy t
Proxy
pathKey (Variable PathVar v
part) = forall value.
VaryingPathOf value =>
Proxy value -> PathVar value -> ByteString -> ByteString
modifyPath @v Proxy v
forall {k} (t :: k). Proxy t
Proxy PathVar v
part (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ forall value. PathOf value => Proxy value -> ByteString
rawPath @v Proxy v
forall {k} (t :: k). Proxy t
Proxy
pathOf :: TypedKey v -> TypedPath v
pathOf :: forall v. TypedKey v -> TypedPath v
pathOf (ToKey KeyType v
_) = TypedPath v
forall v. PathOf v => TypedPath v
Fixed
pathOf (Extended PathVar v
part KeyType v
_) = PathVar v -> TypedPath v
forall v. VaryingPathOf v => PathVar v -> TypedPath v
Variable PathVar v
part
type TypedKVs value = Map (KeyType value) value
class
( KnownSymbol (KVPath value)
, EncodeKV (KeyType value)
, DecodeKV (KeyType value)
) =>
PathOf value
where
type KVPath value :: Symbol
type KeyType value
class PathOf value => VaryingPathOf value where
type PathVar value
modifyPath :: Proxy value -> PathVar value -> Key -> Key
expand :: EncodeKV a => a -> Key -> Key
expand :: forall a. EncodeKV a => a -> ByteString -> ByteString
expand a
x ByteString
template =
let (ByteString
prefix, ByteString
afterPre) = ByteString -> ByteString -> (ByteString, ByteString)
B.breakSubstring ByteString
braces ByteString
template
suffix :: ByteString
suffix = Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
braces) ByteString
afterPre
result :: ByteString
result = ByteString
prefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> a -> ByteString
forall a. EncodeKV a => a -> ByteString
encodeKV a
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
suffix
in if ByteString -> ByteString -> Bool
B.isPrefixOf ByteString
braces ByteString
afterPre then ByteString
result else ByteString
template
braces :: B.ByteString
braces :: ByteString
braces = ByteString
"{}"
append :: EncodeKV a => Key -> a -> Key -> Key
append :: forall a. EncodeKV a => ByteString -> a -> ByteString -> ByteString
append ByteString
sep a
x ByteString
template = ByteString
template ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
sep ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> a -> ByteString
forall a. EncodeKV a => a -> ByteString
encodeKV a
x
prepend :: EncodeKV a => Key -> a -> Key -> Key
prepend :: forall a. EncodeKV a => ByteString -> a -> ByteString -> ByteString
prepend ByteString
sep a
x ByteString
template = a -> ByteString
forall a. EncodeKV a => a -> ByteString
encodeKV a
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
sep ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
template
data TypedPath v where
Fixed :: (PathOf v) => TypedPath v
Variable :: (VaryingPathOf v) => PathVar v -> TypedPath v
data TypedKey v where
ToKey :: (PathOf v) => KeyType v -> TypedKey v
Extended :: (VaryingPathOf v) => PathVar v -> KeyType v -> TypedKey v
key :: PathOf v => KeyType v -> TypedKey v
key :: forall v. PathOf v => KeyType v -> TypedKey v
key = KeyType v -> TypedKey v
forall v. PathOf v => KeyType v -> TypedKey v
ToKey
infixr 5 //
(//) :: VaryingPathOf v => PathVar v -> KeyType v -> TypedKey v
PathVar v
a // :: forall v. VaryingPathOf v => PathVar v -> KeyType v -> TypedKey v
// KeyType v
b = PathVar v -> KeyType v -> TypedKey v
forall v. VaryingPathOf v => PathVar v -> KeyType v -> TypedKey v
Extended PathVar v
a KeyType v
b
instance EncodeKV (TypedKey v) where
encodeKV :: TypedKey v -> ByteString
encodeKV (ToKey KeyType v
x) = KeyType v -> ByteString
forall a. EncodeKV a => a -> ByteString
encodeKV KeyType v
x
encodeKV (Extended PathVar v
_ KeyType v
x) = KeyType v -> ByteString
forall a. EncodeKV a => a -> ByteString
encodeKV KeyType v
x
rawPath :: forall value. PathOf value => Proxy value -> Key
rawPath :: forall value. PathOf value => Proxy value -> ByteString
rawPath Proxy value
_ = String -> ByteString
C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @(KVPath value) Proxy (KVPath value)
forall {k} (t :: k). Proxy t
Proxy
loadFrom ::
forall a m.
(Monad m, DecodeKV a) =>
Handle m ->
TypedKey a ->
m (Either HandleErr a)
loadFrom :: forall a (m :: * -> *).
(Monad m, DecodeKV a) =>
Handle m -> TypedKey a -> m (Either HandleErr a)
loadFrom Handle m
h TypedKey a
aKey =
let outer :: ByteString
outer = TypedPath a -> ByteString
forall v. TypedPath v -> ByteString
pathKey (TypedPath a -> ByteString) -> TypedPath a -> ByteString
forall a b. (a -> b) -> a -> b
$ TypedKey a -> TypedPath a
forall v. TypedKey v -> TypedPath v
pathOf TypedKey a
aKey
inner :: ByteString
inner = TypedKey a -> ByteString
forall a. EncodeKV a => a -> ByteString
encodeKV TypedKey a
aKey
full :: ByteString
full = ByteString
outer ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"//" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
inner
in Handle m
-> ByteString
-> ByteString
-> m (Either HandleErr (Maybe ByteString))
forall (m :: * -> *).
Handle m
-> ByteString
-> ByteString
-> m (Either HandleErr (Maybe ByteString))
H.loadFrom Handle m
h ByteString
outer ByteString
inner m (Either HandleErr (Maybe ByteString))
-> (Either HandleErr (Maybe ByteString) -> Either HandleErr a)
-> m (Either HandleErr a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ByteString
-> Either HandleErr (Maybe ByteString) -> Either HandleErr a
forall b err.
(DecodeKV b, FromHandleErr err) =>
ByteString -> Either err (Maybe ByteString) -> Either err b
decodeOrGone' ByteString
full
mayLoadFrom ::
forall a m.
(Monad m, DecodeKV a, PathOf a) =>
Handle m ->
TypedKey a ->
m (Either HandleErr (Maybe a))
mayLoadFrom :: forall a (m :: * -> *).
(Monad m, DecodeKV a, PathOf a) =>
Handle m -> TypedKey a -> m (Either HandleErr (Maybe a))
mayLoadFrom Handle m
h TypedKey a
aKey =
let outer :: ByteString
outer = TypedPath a -> ByteString
forall v. TypedPath v -> ByteString
pathKey (TypedPath a -> ByteString) -> TypedPath a -> ByteString
forall a b. (a -> b) -> a -> b
$ TypedKey a -> TypedPath a
forall v. TypedKey v -> TypedPath v
pathOf TypedKey a
aKey
inner :: ByteString
inner = TypedKey a -> ByteString
forall a. EncodeKV a => a -> ByteString
encodeKV TypedKey a
aKey
in Handle m
-> ByteString
-> ByteString
-> m (Either HandleErr (Maybe ByteString))
forall (m :: * -> *).
Handle m
-> ByteString
-> ByteString
-> m (Either HandleErr (Maybe ByteString))
H.loadFrom Handle m
h ByteString
outer ByteString
inner m (Either HandleErr (Maybe ByteString))
-> (Either HandleErr (Maybe ByteString)
-> Either HandleErr (Maybe a))
-> m (Either HandleErr (Maybe a))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Either HandleErr (Maybe ByteString) -> Either HandleErr (Maybe a)
forall b err.
(DecodeKV b, FromHandleErr err) =>
Either err (Maybe ByteString) -> Either err (Maybe b)
decodeOr'
saveTo ::
(Monad m, EncodeKV a, PathOf a) =>
Handle m ->
TypedKey a ->
a ->
m (Either HandleErr ())
saveTo :: forall (m :: * -> *) a.
(Monad m, EncodeKV a, PathOf a) =>
Handle m -> TypedKey a -> a -> m (Either HandleErr ())
saveTo Handle m
h TypedKey a
aKey a
someKVs =
let outer :: ByteString
outer = TypedPath a -> ByteString
forall v. TypedPath v -> ByteString
pathKey (TypedPath a -> ByteString) -> TypedPath a -> ByteString
forall a b. (a -> b) -> a -> b
$ TypedKey a -> TypedPath a
forall v. TypedKey v -> TypedPath v
pathOf TypedKey a
aKey
inner :: ByteString
inner = TypedKey a -> ByteString
forall a. EncodeKV a => a -> ByteString
encodeKV TypedKey a
aKey
in Handle m
-> ByteString
-> ByteString
-> ByteString
-> m (Either HandleErr ())
forall (m :: * -> *).
Handle m
-> ByteString
-> ByteString
-> ByteString
-> m (Either HandleErr ())
H.saveTo Handle m
h ByteString
outer ByteString
inner (ByteString -> m (Either HandleErr ()))
-> ByteString -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. EncodeKV a => a -> ByteString
encodeKV a
someKVs
loadKVs ::
( Monad m
, DecodeKV a
, DecodeKV (KeyType a)
, Ord (KeyType a)
) =>
Handle m ->
TypedPath a ->
m (Either HandleErr (TypedKVs a))
loadKVs :: forall (m :: * -> *) a.
(Monad m, DecodeKV a, DecodeKV (KeyType a), Ord (KeyType a)) =>
Handle m -> TypedPath a -> m (Either HandleErr (TypedKVs a))
loadKVs Handle m
h TypedPath a
k = Handle m -> ByteString -> m (Either HandleErr ValsByKey)
forall (m :: * -> *).
Handle m -> ByteString -> m (Either HandleErr ValsByKey)
H.loadKVs Handle m
h (TypedPath a -> ByteString
forall v. TypedPath v -> ByteString
pathKey TypedPath a
k) m (Either HandleErr ValsByKey)
-> (Either HandleErr ValsByKey
-> m (Either HandleErr (Map (KeyType a) a)))
-> m (Either HandleErr (Map (KeyType a) a))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either HandleErr (Map (KeyType a) a)
-> m (Either HandleErr (Map (KeyType a) a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr (Map (KeyType a) a)
-> m (Either HandleErr (Map (KeyType a) a)))
-> (Either HandleErr ValsByKey
-> Either HandleErr (Map (KeyType a) a))
-> Either HandleErr ValsByKey
-> m (Either HandleErr (Map (KeyType a) a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either HandleErr ValsByKey -> Either HandleErr (Map (KeyType a) a)
forall a b.
(Ord a, DecodeKV a, DecodeKV b) =>
Either HandleErr ValsByKey -> Either HandleErr (Map a b)
orDecodeKVs
updateKVs ::
(Monad m, EncodeKV a, EncodeKV (KeyType a), Ord (KeyType a)) =>
Handle m ->
TypedPath a ->
TypedKVs a ->
m (Either HandleErr ())
updateKVs :: forall (m :: * -> *) a.
(Monad m, EncodeKV a, EncodeKV (KeyType a), Ord (KeyType a)) =>
Handle m -> TypedPath a -> TypedKVs a -> m (Either HandleErr ())
updateKVs Handle m
h TypedPath a
aKey = Handle m
-> ByteString -> Map (KeyType a) a -> m (Either HandleErr ())
forall a b (m :: * -> *) err.
(Ord a, EncodeKV a, EncodeKV b, Monad m, FromHandleErr err) =>
Handle m -> ByteString -> Map a b -> m (Either err ())
updateEncodedKVs Handle m
h (ByteString -> Map (KeyType a) a -> m (Either HandleErr ()))
-> ByteString -> Map (KeyType a) a -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ TypedPath a -> ByteString
forall v. TypedPath v -> ByteString
pathKey TypedPath a
aKey
saveKVs ::
(Monad m, EncodeKV a, EncodeKV (KeyType a), Ord (KeyType a)) =>
Handle m ->
TypedPath a ->
TypedKVs a ->
m (Either HandleErr ())
saveKVs :: forall (m :: * -> *) a.
(Monad m, EncodeKV a, EncodeKV (KeyType a), Ord (KeyType a)) =>
Handle m -> TypedPath a -> TypedKVs a -> m (Either HandleErr ())
saveKVs Handle m
h TypedPath a
k = Handle m
-> ByteString -> Map (KeyType a) a -> m (Either HandleErr ())
forall a b (m :: * -> *) err.
(Ord a, EncodeKV a, EncodeKV b, Monad m, FromHandleErr err) =>
Handle m -> ByteString -> Map a b -> m (Either err ())
saveEncodedKVs Handle m
h (ByteString -> Map (KeyType a) a -> m (Either HandleErr ()))
-> ByteString -> Map (KeyType a) a -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ TypedPath a -> ByteString
forall v. TypedPath v -> ByteString
pathKey TypedPath a
k
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 :: forall (m :: * -> *) a.
(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 TypedKVs a -> TypedKVs a
modDict Handle m
h TypedPath a
aKey = do
Handle m -> ByteString -> m (Either HandleErr ValsByKey)
forall (m :: * -> *).
Handle m -> ByteString -> m (Either HandleErr ValsByKey)
H.loadKVs Handle m
h (TypedPath a -> ByteString
forall v. TypedPath v -> ByteString
pathKey TypedPath a
aKey) m (Either HandleErr ValsByKey)
-> (Either HandleErr ValsByKey
-> m (Either HandleErr (TypedKVs a)))
-> m (Either HandleErr (TypedKVs a))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either HandleErr (TypedKVs a) -> m (Either HandleErr (TypedKVs a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr (TypedKVs a)
-> m (Either HandleErr (TypedKVs a)))
-> (Either HandleErr ValsByKey -> Either HandleErr (TypedKVs a))
-> Either HandleErr ValsByKey
-> m (Either HandleErr (TypedKVs a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either HandleErr ValsByKey -> Either HandleErr (TypedKVs a)
forall a b.
(Ord a, DecodeKV a, DecodeKV b) =>
Either HandleErr ValsByKey -> Either HandleErr (Map a b)
orDecodeKVs) m (Either HandleErr (TypedKVs a))
-> (Either HandleErr (TypedKVs a) -> m (Either HandleErr ()))
-> m (Either HandleErr ())
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left HandleErr
err -> Either HandleErr () -> m (Either HandleErr ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr () -> m (Either HandleErr ()))
-> Either HandleErr () -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ HandleErr -> Either HandleErr ()
forall a b. a -> Either a b
Left HandleErr
err
Right TypedKVs a
d -> Handle m -> TypedPath a -> TypedKVs a -> m (Either HandleErr ())
forall (m :: * -> *) a.
(Monad m, EncodeKV a, EncodeKV (KeyType a), Ord (KeyType a)) =>
Handle m -> TypedPath a -> TypedKVs a -> m (Either HandleErr ())
saveKVs Handle m
h TypedPath a
aKey (TypedKVs a -> m (Either HandleErr ()))
-> TypedKVs a -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ TypedKVs a -> TypedKVs a
modDict TypedKVs a
d
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 :: 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 Handle m
h TypedPath a
aKey NonEmpty (KeyType a)
keys = do
let selection :: Selection
selection = NonEmpty ByteString -> Selection
AllOf (NonEmpty ByteString -> Selection)
-> NonEmpty ByteString -> Selection
forall a b. (a -> b) -> a -> b
$ (KeyType a -> ByteString)
-> NonEmpty (KeyType a) -> NonEmpty ByteString
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyType a -> ByteString
forall a. EncodeKV a => a -> ByteString
encodeKV NonEmpty (KeyType a)
keys
Handle m
-> ByteString -> Selection -> m (Either HandleErr ValsByKey)
forall (m :: * -> *).
Handle m
-> ByteString -> Selection -> m (Either HandleErr ValsByKey)
H.loadSlice Handle m
h (TypedPath a -> ByteString
forall v. TypedPath v -> ByteString
pathKey TypedPath a
aKey) Selection
selection m (Either HandleErr ValsByKey)
-> (Either HandleErr ValsByKey
-> m (Either HandleErr (TypedKVs a)))
-> m (Either HandleErr (TypedKVs a))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either HandleErr (TypedKVs a) -> m (Either HandleErr (TypedKVs a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr (TypedKVs a)
-> m (Either HandleErr (TypedKVs a)))
-> (Either HandleErr ValsByKey -> Either HandleErr (TypedKVs a))
-> Either HandleErr ValsByKey
-> m (Either HandleErr (TypedKVs a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either HandleErr ValsByKey -> Either HandleErr (TypedKVs a)
forall a b.
(Ord a, DecodeKV a, DecodeKV b) =>
Either HandleErr ValsByKey -> Either HandleErr (Map a b)
orDecodeKVs
orDecodeKVs ::
(Ord a, DecodeKV a, DecodeKV b) =>
Either HandleErr H.ValsByKey ->
Either HandleErr (Map a b)
orDecodeKVs :: forall a b.
(Ord a, DecodeKV a, DecodeKV b) =>
Either HandleErr ValsByKey -> Either HandleErr (Map a b)
orDecodeKVs = (HandleErr -> Either HandleErr (Map a b))
-> (ValsByKey -> Either HandleErr (Map a b))
-> Either HandleErr ValsByKey
-> Either HandleErr (Map a b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HandleErr -> Either HandleErr (Map a b)
forall a b. a -> Either a b
Left ValsByKey -> Either HandleErr (Map a b)
forall a b err.
(Ord a, DecodeKV a, DecodeKV b, FromHandleErr err) =>
ValsByKey -> Either err (Map a b)
decodeKVs
countKVs ::
forall a m.
( Monad m
, Ord (KeyType a)
) =>
Handle m ->
TypedPath a ->
m (Either HandleErr Natural)
countKVs :: forall a (m :: * -> *).
(Monad m, Ord (KeyType a)) =>
Handle m -> TypedPath a -> m (Either HandleErr Natural)
countKVs Handle m
h TypedPath a
k = Handle m -> ByteString -> m (Either HandleErr Natural)
forall (m :: * -> *).
Handle m -> ByteString -> m (Either HandleErr Natural)
H.countKVs Handle m
h (ByteString -> m (Either HandleErr Natural))
-> ByteString -> m (Either HandleErr Natural)
forall a b. (a -> b) -> a -> b
$ TypedPath a -> ByteString
forall v. TypedPath v -> ByteString
pathKey TypedPath a
k