{-# 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 = 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 forall a err.
(DecodeKV a, FromHandleErr err) =>
Maybe Key -> Either err (Maybe a)
decodeOr Maybe Key
x of
    Left err
err -> forall a b. a -> Either a b
Left err
err
    Right Maybe b
mb -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall err. FromHandleErr err => HandleErr -> err
fromHandleErr forall a b. (a -> b) -> a -> b
$ Key -> HandleErr
Gone Key
key) 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> 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' = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall err1 err2 b.
(err1 -> err2) -> Either err1 b -> Either err2 b
firstEither forall err. FromHandleErr err => Text -> err
notDecoded forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DecodeKV a => Key -> Either Text a
decodeKV)


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