{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK prune not-home #-}
module KeyedVals.Handle.Aeson (
decodeOr,
decodeOr',
decodeOrGone,
decodeOrGone',
jsonVal,
jsonKey,
webKey,
appendWebKey,
substWebKey,
prependWebKey,
decodeJsonKeyKVs,
decodeWebKeyKVs,
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 (..))
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)
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')
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'
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
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)
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
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
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
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
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
saveOrUpdateKVs ::
(Ord a, ToJSON b, Monad m) =>
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
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