{-# 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 :: HandleErr -> HandleErr
fromHandleErr = HandleErr -> HandleErr
forall a. a -> a
id


-- | Like 'decodeOr', but transforms 'Nothing' to 'Gone'.
decodeOrGone ::
  (DecodeKV b, FromHandleErr err) =>
  Key ->
  Maybe Val ->
  Either err b
decodeOrGone :: forall b err.
(DecodeKV b, FromHandleErr err) =>
Key -> Maybe Key -> Either err b
decodeOrGone Key
key Maybe Key
x =
  case Maybe Key -> Either err (Maybe b)
forall a err.
(DecodeKV a, FromHandleErr err) =>
Maybe Key -> Either err (Maybe a)
decodeOr Maybe Key
x of
    Left err
err -> err -> Either err b
forall a b. a -> Either a b
Left err
err
    Right Maybe b
mb -> Either err b -> (b -> Either err b) -> Maybe b -> Either err b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (err -> Either err b
forall a b. a -> Either a b
Left (err -> Either err b) -> err -> Either err b
forall a b. (a -> b) -> a -> b
$ HandleErr -> err
forall err. FromHandleErr err => HandleErr -> err
fromHandleErr (HandleErr -> err) -> HandleErr -> err
forall a b. (a -> b) -> a -> b
$ Key -> HandleErr
Gone Key
key) b -> Either err b
forall a b. b -> Either a b
Right Maybe b
mb


-- | Like 'decodeOr'', but transforms 'Nothing' to 'Gone'.
decodeOrGone' ::
  (DecodeKV b, FromHandleErr err) =>
  Key ->
  Either err (Maybe Val) ->
  Either err b
decodeOrGone' :: forall b err.
(DecodeKV b, FromHandleErr err) =>
Key -> Either err (Maybe Key) -> Either err b
decodeOrGone' Key
key = (err -> Either err b)
-> (Maybe Key -> Either err b)
-> Either err (Maybe Key)
-> Either err b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either err -> Either err b
forall a b. a -> Either a b
Left ((Maybe Key -> Either err b)
 -> Either err (Maybe Key) -> Either err b)
-> (Maybe Key -> Either err b)
-> Either err (Maybe Key)
-> Either err b
forall a b. (a -> b) -> a -> b
$ Key -> Maybe Key -> Either err b
forall b err.
(DecodeKV b, FromHandleErr err) =>
Key -> Maybe Key -> Either err b
decodeOrGone Key
key


-- | Decode a value, transformi decode errors to type @err@.
decodeOr' ::
  (DecodeKV b, FromHandleErr err) =>
  Either err (Maybe Val) ->
  Either err (Maybe b)
decodeOr' :: forall b err.
(DecodeKV b, FromHandleErr err) =>
Either err (Maybe Key) -> Either err (Maybe b)
decodeOr' = (err -> Either err (Maybe b))
-> (Maybe Key -> Either err (Maybe b))
-> Either err (Maybe Key)
-> Either err (Maybe b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either err -> Either err (Maybe b)
forall a b. a -> Either a b
Left Maybe Key -> Either err (Maybe b)
forall a err.
(DecodeKV a, FromHandleErr err) =>
Maybe Key -> Either err (Maybe a)
decodeOr


-- | Decode a value, transforming decode errors to type @err@.
decodeOr ::
  (DecodeKV a, FromHandleErr err) =>
  Maybe Val ->
  Either err (Maybe a)
decodeOr :: forall a err.
(DecodeKV a, FromHandleErr err) =>
Maybe Key -> Either err (Maybe a)
decodeOr = Either err (Maybe a)
-> (Key -> Either err (Maybe a))
-> Maybe Key
-> Either err (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> Either err (Maybe a)
forall a. a -> Either err a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing) ((a -> Maybe a) -> Either err a -> Either err (Maybe a)
forall a b. (a -> b) -> Either err a -> Either err b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Either err a -> Either err (Maybe a))
-> (Key -> Either err a) -> Key -> Either err (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> err) -> Either Text a -> Either err a
forall err1 err2 b.
(err1 -> err2) -> Either err1 b -> Either err2 b
firstEither Text -> err
forall err. FromHandleErr err => Text -> err
notDecoded (Either Text a -> Either err a)
-> (Key -> Either Text a) -> Key -> Either err a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Either Text a
forall a. DecodeKV a => Key -> Either Text a
decodeKV)


notDecoded :: FromHandleErr err => Text -> err
notDecoded :: forall err. FromHandleErr err => Text -> err
notDecoded = HandleErr -> err
forall err. FromHandleErr err => HandleErr -> err
fromHandleErr (HandleErr -> err) -> (Text -> HandleErr) -> Text -> err
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HandleErr
NotDecoded


decode' :: (FromHandleErr err, DecodeKV a) => Val -> Either err a
decode' :: forall err a.
(FromHandleErr err, DecodeKV a) =>
Key -> Either err a
decode' = (Text -> Either err a)
-> (a -> Either err a) -> Either Text a -> Either err a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (err -> Either err a
forall a b. a -> Either a b
Left (err -> Either err a) -> (Text -> err) -> Text -> Either err a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> err
forall err. FromHandleErr err => Text -> err
notDecoded) a -> Either err a
forall a b. b -> Either a b
Right (Either Text a -> Either err a)
-> (Key -> Either Text a) -> Key -> Either err a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Either Text a
forall a. DecodeKV a => Key -> Either Text a
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 :: forall a b err.
(Ord a, DecodeKV a, DecodeKV b, FromHandleErr err) =>
ValsByKey -> Either err (Map a b)
decodeKVs =
  let step :: Key -> Key -> Either a (Map k a) -> Either a (Map k a)
step Key
_ Key
_ (Left a
x) = a -> Either a (Map k a)
forall a b. a -> Either a b
Left a
x
      step Key
k Key
v (Right Map k a
m) = case (Key -> Either a k
forall err a.
(FromHandleErr err, DecodeKV a) =>
Key -> Either err a
decode' Key
k, Key -> Either a a
forall err a.
(FromHandleErr err, DecodeKV a) =>
Key -> Either err a
decode' Key
v) of
        (Left a
x, Either a a
_) -> a -> Either a (Map k a)
forall a b. a -> Either a b
Left a
x
        (Either a k
_, Left a
y) -> a -> Either a (Map k a)
forall a b. a -> Either a b
Left a
y
        (Right k
k', Right a
v') -> Map k a -> Either a (Map k a)
forall a b. b -> Either a b
Right (Map k a -> Either a (Map k a)) -> Map k a -> Either a (Map k a)
forall a b. (a -> b) -> a -> b
$ k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k' a
v' Map k a
m
   in (Key -> Key -> Either err (Map a b) -> Either err (Map a b))
-> Either err (Map a b) -> ValsByKey -> Either err (Map a b)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey Key -> Key -> Either err (Map a b) -> Either err (Map a b)
forall {a} {k} {a}.
(FromHandleErr a, DecodeKV k, DecodeKV a, Ord k) =>
Key -> Key -> Either a (Map k a) -> Either a (Map k a)
step (Map a b -> Either err (Map a b)
forall a b. b -> Either a b
Right Map a b
forall k a. Map k a
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 :: forall a b (m :: * -> *) err.
(Ord a, EncodeKV a, EncodeKV b, Monad m, FromHandleErr err) =>
Handle m -> Key -> Map a b -> m (Either err ())
updateEncodedKVs = Bool -> Handle m -> Key -> Map a b -> m (Either err ())
forall a b (m :: * -> *) err.
(Ord a, EncodeKV a, EncodeKV b, Monad m, FromHandleErr err) =>
Bool -> Handle m -> Key -> Map a b -> m (Either err ())
saveOrUpdateKVs Bool
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 :: forall a b (m :: * -> *) err.
(Ord a, EncodeKV a, EncodeKV b, Monad m, FromHandleErr err) =>
Handle m -> Key -> Map a b -> m (Either err ())
saveEncodedKVs = Bool -> Handle m -> Key -> Map a b -> m (Either err ())
forall a b (m :: * -> *) err.
(Ord a, EncodeKV a, EncodeKV b, Monad m, FromHandleErr err) =>
Bool -> Handle m -> Key -> Map a b -> m (Either err ())
saveOrUpdateKVs Bool
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 :: forall a b (m :: * -> *) err.
(Ord a, EncodeKV a, EncodeKV b, Monad m, FromHandleErr err) =>
Bool -> Handle m -> Key -> Map a b -> m (Either err ())
saveOrUpdateKVs Bool
_ Handle m
_ Key
_ Map a b
kvs | Map a b -> Int
forall k a. Map k a -> Int
Map.size Map a b
kvs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Either err () -> m (Either err ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either err () -> m (Either err ()))
-> Either err () -> m (Either err ())
forall a b. (a -> b) -> a -> b
$ () -> Either err ()
forall a b. b -> Either a b
Right ()
saveOrUpdateKVs Bool
update Handle m
h Key
key Map a b
dict =
  let asRemote :: Map a b -> ValsByKey
asRemote =
        [(Key, Key)] -> ValsByKey
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          ([(Key, Key)] -> ValsByKey)
-> (Map a b -> [(Key, Key)]) -> Map a b -> ValsByKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (Key, Key)) -> [(a, b)] -> [(Key, Key)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Key) -> (b -> Key) -> (a, b) -> (Key, Key)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> Key
forall a. EncodeKV a => a -> Key
encodeKV b -> Key
forall a. EncodeKV a => a -> Key
encodeKV)
          ([(a, b)] -> [(Key, Key)])
-> (Map a b -> [(a, b)]) -> Map a b -> [(Key, Key)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList
      saver :: Key -> ValsByKey -> m (Either HandleErr ())
saver = if Bool
update then (Handle m -> Key -> ValsByKey -> m (Either HandleErr ())
forall (m :: * -> *).
Handle m -> Key -> ValsByKey -> m (Either HandleErr ())
updateKVs Handle m
h) else (Handle m -> Key -> ValsByKey -> m (Either HandleErr ())
forall (m :: * -> *).
Handle m -> Key -> ValsByKey -> m (Either HandleErr ())
saveKVs Handle m
h)
   in (Either HandleErr () -> Either err ())
-> m (Either HandleErr ()) -> m (Either err ())
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HandleErr -> err) -> Either HandleErr () -> Either err ()
forall err1 err2 b.
(err1 -> err2) -> Either err1 b -> Either err2 b
firstEither HandleErr -> err
forall err. FromHandleErr err => HandleErr -> err
fromHandleErr) (m (Either HandleErr ()) -> m (Either err ()))
-> m (Either HandleErr ()) -> m (Either err ())
forall a b. (a -> b) -> a -> b
$ Key -> ValsByKey -> m (Either HandleErr ())
saver Key
key (ValsByKey -> m (Either HandleErr ()))
-> ValsByKey -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ Map a b -> ValsByKey
asRemote Map a b
dict


firstEither :: (err1 -> err2) -> Either err1 b -> Either err2 b
firstEither :: forall err1 err2 b.
(err1 -> err2) -> Either err1 b -> Either err2 b
firstEither err1 -> err2
f = (err1 -> Either err2 b)
-> (b -> Either err2 b) -> Either err1 b -> Either err2 b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (err2 -> Either err2 b
forall a b. a -> Either a b
Left (err2 -> Either err2 b) -> (err1 -> err2) -> err1 -> Either err2 b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. err1 -> err2
f) b -> Either err2 b
forall a b. b -> Either a b
Right