{-# 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 :: forall a. ToJSON a => a -> ByteString
jsonVal = forall a. ToJSON a => a -> ByteString
encodeJSON


webKey :: ToHttpApiData a => a -> Key
webKey :: forall a. ToHttpApiData a => a -> ByteString
webKey = forall a. ToHttpApiData a => a -> ByteString
toHeader


substWebKey :: ToHttpApiData a => a -> Key -> Key
substWebKey :: forall a. ToHttpApiData a => a -> ByteString -> ByteString
substWebKey a
x ByteString
template =
  let (ByteString
prefix, ByteString
afterPre) = ByteString -> ByteString -> (ByteString, ByteString)
B.breakSubstring ByteString
mustache ByteString
template
      suffix :: ByteString
suffix = Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
mustache) ByteString
afterPre
      result :: ByteString
result = ByteString
prefix forall a. Semigroup a => a -> a -> a
<> forall a. ToHttpApiData a => a -> ByteString
webKey a
x forall a. Semigroup a => a -> a -> a
<> ByteString
suffix
   in if ByteString -> ByteString -> Bool
B.isPrefixOf ByteString
mustache ByteString
afterPre then ByteString
result else ByteString
template


appendWebKey :: ToHttpApiData a => Key -> a -> Key -> Key
appendWebKey :: forall a.
ToHttpApiData a =>
ByteString -> a -> ByteString -> ByteString
appendWebKey ByteString
sep a
x ByteString
template = ByteString
template forall a. Semigroup a => a -> a -> a
<> ByteString
sep forall a. Semigroup a => a -> a -> a
<> forall a. ToHttpApiData a => a -> ByteString
webKey a
x


prependWebKey :: ToHttpApiData a => Key -> a -> Key -> Key
prependWebKey :: forall a.
ToHttpApiData a =>
ByteString -> a -> ByteString -> ByteString
prependWebKey ByteString
sep a
x ByteString
template = forall a. ToHttpApiData a => a -> ByteString
webKey a
x forall a. Semigroup a => a -> a -> a
<> ByteString
sep forall a. Semigroup a => a -> a -> a
<> ByteString
template


mustache :: ByteString
mustache :: ByteString
mustache = ByteString
"{}"


jsonKey :: ToJSON a => a -> Key
jsonKey :: forall a. ToJSON a => a -> ByteString
jsonKey = forall a. ToJSON a => a -> ByteString
encodeJSON


decodeOrGone ::
  FromJSON b =>
  Key ->
  Maybe Val ->
  Either HandleErr b
decodeOrGone :: forall b.
FromJSON b =>
ByteString -> Maybe ByteString -> Either HandleErr b
decodeOrGone ByteString
key Maybe ByteString
x =
  case forall a err.
FromJSON a =>
(Text -> err) -> Maybe ByteString -> Either err (Maybe a)
decodeOr Text -> HandleErr
NotDecoded Maybe ByteString
x of
    Left HandleErr
err -> forall a b. a -> Either a b
Left HandleErr
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
$ ByteString -> HandleErr
Gone ByteString
key) forall a b. b -> Either a b
Right Maybe b
mb


decodeOrGone' ::
  FromJSON b =>
  Key ->
  Either HandleErr (Maybe Val) ->
  Either HandleErr b
decodeOrGone' :: forall b.
FromJSON b =>
ByteString
-> Either HandleErr (Maybe ByteString) -> Either HandleErr b
decodeOrGone' ByteString
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.
FromJSON b =>
ByteString -> Maybe ByteString -> Either HandleErr b
decodeOrGone ByteString
key


decodeOr' ::
  FromJSON b =>
  Either HandleErr (Maybe Val) ->
  Either HandleErr (Maybe b)
decodeOr' :: forall b.
FromJSON b =>
Either HandleErr (Maybe ByteString) -> Either HandleErr (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.
FromJSON a =>
(Text -> err) -> Maybe ByteString -> Either err (Maybe a)
decodeOr Text -> HandleErr
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 :: forall a err.
FromJSON a =>
(Text -> err) -> Maybe ByteString -> Either err (Maybe a)
decodeOr Text -> err
f = 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 err1 err2 b.
(err1 -> err2) -> Either err1 b -> Either err2 b
firstEither (Text -> err
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
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 :: forall a b c.
(Ord a, FromJSON a, FromJSON b) =>
(Text -> c) -> ValsByKey -> Either c (Map a b)
decodeJsonKeyKVs Text -> c
f = forall err1 err2 b.
(err1 -> err2) -> Either err1 b -> Either err2 b
firstEither Text -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
(Ord a, FromJSON b) =>
(ByteString -> Either Text a) -> ValsByKey -> Either Text (Map a b)
decodeKVs' ByteString -> Either Text a
decoder
  where
    decoder :: ByteString -> Either Text a
decoder = forall err1 err2 b.
(err1 -> err2) -> Either err1 b -> Either err2 b
firstEither String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
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 :: forall a b c.
(Ord a, FromHttpApiData a, FromJSON b) =>
(Text -> c) -> ValsByKey -> Either c (Map a b)
decodeWebKeyKVs Text -> c
f = forall err1 err2 b.
(err1 -> err2) -> Either err1 b -> Either err2 b
firstEither Text -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
(Ord a, FromJSON b) =>
(ByteString -> Either Text a) -> ValsByKey -> Either Text (Map a b)
decodeKVs' forall a. FromHttpApiData a => ByteString -> Either Text a
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' :: forall a b.
(Ord a, FromJSON b) =>
(ByteString -> Either Text a) -> ValsByKey -> Either Text (Map a b)
decodeKVs' ByteString -> Either Text a
decoder =
  let step :: ByteString
-> ByteString -> Either Text (Map a a) -> Either Text (Map a a)
step ByteString
_ ByteString
_ (Left Text
x) = forall a b. a -> Either a b
Left Text
x
      step ByteString
k ByteString
v (Right Map a a
m) = case (ByteString -> Either Text a
decoder ByteString
k, forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' ByteString
v) of
        (Left Text
x, Either String a
_) -> forall a b. a -> Either a b
Left Text
x
        (Either Text a
_, Left String
y) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
y
        (Right a
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 a
k' a
v' Map a a
m
   in forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey forall {a}.
FromJSON a =>
ByteString
-> ByteString -> Either Text (Map a a) -> Either Text (Map a a)
step (forall a b. b -> Either a b
Right forall k a. Map k a
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 :: forall a b (m :: * -> *) err.
(Ord a, ToJSON a, ToJSON b, Monad m) =>
(HandleErr -> err)
-> Handle m -> ByteString -> Map a b -> m (Either err ())
saveJsonKeyKVs HandleErr -> err
f = forall a b (m :: * -> *) err.
(Ord a, ToJSON b, Monad m) =>
(HandleErr -> err)
-> (a -> ByteString)
-> Handle m
-> ByteString
-> Map a b
-> m (Either err ())
saveKVs HandleErr -> err
f forall a. ToJSON a => a -> ByteString
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 :: forall a b (m :: * -> *) err.
(Ord a, ToHttpApiData a, ToJSON b, Monad m) =>
(HandleErr -> err)
-> Handle m -> ByteString -> Map a b -> m (Either err ())
saveHttpApiKVs HandleErr -> err
fromHandleErr = forall a b (m :: * -> *) err.
(Ord a, ToJSON b, Monad m) =>
(HandleErr -> err)
-> (a -> ByteString)
-> Handle m
-> ByteString
-> Map a b
-> m (Either err ())
saveKVs HandleErr -> err
fromHandleErr forall a. ToHttpApiData a => a -> ByteString
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 :: forall a b (m :: * -> *) err.
(Ord a, ToHttpApiData a, ToJSON b, Monad m) =>
(HandleErr -> err)
-> Handle m -> ByteString -> Map a b -> m (Either err ())
updateHttpApiKVs HandleErr -> err
fromHandleErr = forall a b (m :: * -> *) err.
(Ord a, ToJSON b, Monad m) =>
Bool
-> (HandleErr -> err)
-> (a -> ByteString)
-> Handle m
-> ByteString
-> Map a b
-> m (Either err ())
saveOrUpdateKVs Bool
True HandleErr -> err
fromHandleErr forall a. ToHttpApiData a => a -> ByteString
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' :: forall a b (m :: * -> *).
(Ord a, ToJSON b, Monad m) =>
(a -> ByteString)
-> Handle m -> ByteString -> Map a b -> m (Either HandleErr ())
saveKVs' = forall a b (m :: * -> *) err.
(Ord a, ToJSON b, Monad m) =>
(HandleErr -> err)
-> (a -> ByteString)
-> Handle m
-> ByteString
-> Map a b
-> m (Either err ())
saveKVs forall a. a -> a
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 :: forall a b (m :: * -> *) err.
(Ord a, ToJSON b, Monad m) =>
(HandleErr -> err)
-> (a -> ByteString)
-> Handle m
-> ByteString
-> Map a b
-> m (Either err ())
saveKVs = forall a b (m :: * -> *) err.
(Ord a, ToJSON b, Monad m) =>
Bool
-> (HandleErr -> err)
-> (a -> ByteString)
-> Handle m
-> ByteString
-> Map a b
-> m (Either err ())
saveOrUpdateKVs Bool
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 :: forall a b (m :: * -> *) err.
(Ord a, ToJSON b, Monad m) =>
Bool
-> (HandleErr -> err)
-> (a -> ByteString)
-> Handle m
-> ByteString
-> Map a b
-> m (Either err ())
saveOrUpdateKVs Bool
_ HandleErr -> err
_ a -> ByteString
_ Handle m
_ ByteString
_ Map a b
dict | forall k a. Map k a -> Int
Map.size Map a b
dict 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 HandleErr -> err
toErr a -> ByteString
fromKey Handle m
h ByteString
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 a -> ByteString
fromKey forall a. ToJSON a => a -> ByteString
encodeJSON)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList
      saver :: Handle m -> ByteString -> ValsByKey -> m (Either HandleErr ())
saver = if Bool
update then forall (m :: * -> *).
Handle m -> ByteString -> ValsByKey -> m (Either HandleErr ())
hUpdateKVs else forall (m :: * -> *).
Handle m -> ByteString -> ValsByKey -> m (Either HandleErr ())
hSaveKVs
   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 HandleErr -> err
toErr) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Handle m -> ByteString -> ValsByKey -> m (Either HandleErr ())
saver Handle m
h ByteString
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


-- | Encode JSON as a remote value.
encodeJSON :: ToJSON a => a -> Val
encodeJSON :: forall a. ToJSON a => a -> ByteString
encodeJSON = ByteString -> ByteString
LBS.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode