module Polysemy.Http.AesonEntity where

import Data.Aeson (eitherDecode', eitherDecodeStrict', encode)

import Polysemy.Http.Data.Entity (EntityDecode, EntityEncode, EntityError(EntityError))
import qualified Polysemy.Http.Data.Entity as Entity (EntityDecode(..), EntityEncode(..))

-- |Interpreter for 'EntityEncode' that uses Aeson.
interpretEntityEncodeAeson ::
  ToJSON d =>
  Sem (EntityEncode d : r) a ->
  Sem r a
interpretEntityEncodeAeson :: Sem (EntityEncode d : r) a -> Sem r a
interpretEntityEncodeAeson =
  (forall x (rInitial :: EffectRow).
 EntityEncode d (Sem rInitial) x -> Sem r x)
-> Sem (EntityEncode d : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall x (rInitial :: EffectRow). e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Entity.Encode a ->
      ByteString -> Sem r ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (d -> ByteString
forall a. ToJSON a => a -> ByteString
encode d
a)
    Entity.EncodeStrict a ->
      x -> Sem r x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> x
forall l s. LazyStrict l s => l -> s
toStrict (d -> ByteString
forall a. ToJSON a => a -> ByteString
encode d
a))
{-# INLINE interpretEntityEncodeAeson #-}

decodeWith ::
  ConvertUtf8 Text s =>
  (s -> Either String a) ->
  s ->
  Sem r (Either EntityError a)
decodeWith :: (s -> Either String a) -> s -> Sem r (Either EntityError a)
decodeWith s -> Either String a
dec s
body =
  Either EntityError a -> Sem r (Either EntityError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either EntityError a -> Sem r (Either EntityError a))
-> (Either String a -> Either EntityError a)
-> Either String a
-> Sem r (Either EntityError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> EntityError) -> Either String a -> Either EntityError a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (Text -> Text -> EntityError
EntityError (s -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 s
body) (Text -> EntityError) -> (String -> Text) -> String -> EntityError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText) (Either String a -> Sem r (Either EntityError a))
-> Either String a -> Sem r (Either EntityError a)
forall a b. (a -> b) -> a -> b
$ s -> Either String a
dec s
body
{-# INLINE decodeWith #-}

-- |Interpreter for 'EntityDecode' that uses Aeson.
interpretEntityDecodeAeson ::
  FromJSON d =>
  Sem (EntityDecode d : r) a ->
  Sem r a
interpretEntityDecodeAeson :: Sem (EntityDecode d : r) a -> Sem r a
interpretEntityDecodeAeson =
  (forall x (rInitial :: EffectRow).
 EntityDecode d (Sem rInitial) x -> Sem r x)
-> Sem (EntityDecode d : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall x (rInitial :: EffectRow). e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Entity.Decode body ->
      (ByteString -> Either String d)
-> ByteString -> Sem r (Either EntityError d)
forall s a (r :: EffectRow).
ConvertUtf8 Text s =>
(s -> Either String a) -> s -> Sem r (Either EntityError a)
decodeWith ByteString -> Either String d
forall a. FromJSON a => ByteString -> Either String a
eitherDecode' ByteString
body
    Entity.DecodeStrict body ->
      (ByteString -> Either String d)
-> ByteString -> Sem r (Either EntityError d)
forall s a (r :: EffectRow).
ConvertUtf8 Text s =>
(s -> Either String a) -> s -> Sem r (Either EntityError a)
decodeWith ByteString -> Either String d
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' ByteString
body
{-# INLINE interpretEntityDecodeAeson #-}