module HaskellWorks.Polysemy.Data.Aeson
  ( AesonDecodeError(..)
  , aesonDecode
  ) where

import qualified Data.Aeson                                 as Aeson
import qualified HaskellWorks.Polysemy.Data.ByteString.Lazy as LBS
import           HaskellWorks.Polysemy.Prelude
import           Polysemy
import           Polysemy.Error

import           Data.Aeson                                 (FromJSON)

newtype AesonDecodeError
  = AesonDecodeError String
  deriving (Int -> AesonDecodeError -> ShowS
[AesonDecodeError] -> ShowS
AesonDecodeError -> String
(Int -> AesonDecodeError -> ShowS)
-> (AesonDecodeError -> String)
-> ([AesonDecodeError] -> ShowS)
-> Show AesonDecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AesonDecodeError -> ShowS
showsPrec :: Int -> AesonDecodeError -> ShowS
$cshow :: AesonDecodeError -> String
show :: AesonDecodeError -> String
$cshowList :: [AesonDecodeError] -> ShowS
showList :: [AesonDecodeError] -> ShowS
Show)

aesonDecode :: ()
  => Member (Error AesonDecodeError) r
  => FromJSON a
  => LBS.ByteString
  -> Sem r a
aesonDecode :: forall (r :: EffectRow) a.
(Member (Error AesonDecodeError) r, FromJSON a) =>
ByteString -> Sem r a
aesonDecode ByteString
bs =
  Either String a -> Sem (Error String : r) a
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode ByteString
bs)
    Sem (Error String : r) a
-> (Sem (Error String : r) a -> Sem r a) -> Sem r a
forall a b. a -> (a -> b) -> b
& (String -> AesonDecodeError) -> Sem (Error String : r) a -> Sem r a
forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError String -> AesonDecodeError
AesonDecodeError