module Aws.Lambda.Utilities
  ( toJSONText,
    tshow,
    decodeObj,
  )
where

import qualified Aws.Lambda.Runtime.Error as Error
import Data.Aeson (FromJSON, ToJSON, eitherDecode, encode)
import qualified Data.ByteString.Lazy.Char8 as LazyByteString
import Data.Text (Text, pack)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Typeable (Proxy (..), Typeable, typeRep)

toJSONText :: ToJSON a => a -> Text
toJSONText :: forall a. ToJSON a => a -> Text
toJSONText = ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LazyByteString.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
encode

tshow :: Show a => a -> Text
tshow :: forall a. Show a => a -> Text
tshow = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Helper function that the dispatcher will use to
-- decode the JSON that comes as an AWS Lambda event into the
-- appropriate type expected by the handler.
decodeObj :: forall a. (FromJSON a, Typeable a) => LazyByteString.ByteString -> Either Error.Parsing a
decodeObj :: forall a.
(FromJSON a, Typeable a) =>
ByteString -> Either Parsing a
decodeObj ByteString
x =
  let objName :: Text
objName = String -> Text
pack (String -> Text) -> (TypeRep -> String) -> TypeRep -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> Text) -> TypeRep -> Text
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
   in case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
x of
        Left String
e -> Parsing -> Either Parsing a
forall a b. a -> Either a b
Left (Parsing -> Either Parsing a) -> Parsing -> Either Parsing a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Parsing
Error.Parsing (String -> Text
pack String
e) (String -> Text
pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
LazyByteString.unpack (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
x) Text
objName
        Right a
v -> a -> Either Parsing a
forall a. a -> Either Parsing a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v