{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

module AWSLambda.Events.Records where

import           Control.Lens.TH (makeLenses)
import           Data.Aeson      (FromJSON (..), withObject, (.:))

newtype RecordsEvent a = RecordsEvent { RecordsEvent a -> [a]
_reRecords :: [a] } deriving (RecordsEvent a -> RecordsEvent a -> Bool
(RecordsEvent a -> RecordsEvent a -> Bool)
-> (RecordsEvent a -> RecordsEvent a -> Bool)
-> Eq (RecordsEvent a)
forall a. Eq a => RecordsEvent a -> RecordsEvent a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecordsEvent a -> RecordsEvent a -> Bool
$c/= :: forall a. Eq a => RecordsEvent a -> RecordsEvent a -> Bool
== :: RecordsEvent a -> RecordsEvent a -> Bool
$c== :: forall a. Eq a => RecordsEvent a -> RecordsEvent a -> Bool
Eq, Int -> RecordsEvent a -> ShowS
[RecordsEvent a] -> ShowS
RecordsEvent a -> String
(Int -> RecordsEvent a -> ShowS)
-> (RecordsEvent a -> String)
-> ([RecordsEvent a] -> ShowS)
-> Show (RecordsEvent a)
forall a. Show a => Int -> RecordsEvent a -> ShowS
forall a. Show a => [RecordsEvent a] -> ShowS
forall a. Show a => RecordsEvent a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecordsEvent a] -> ShowS
$cshowList :: forall a. Show a => [RecordsEvent a] -> ShowS
show :: RecordsEvent a -> String
$cshow :: forall a. Show a => RecordsEvent a -> String
showsPrec :: Int -> RecordsEvent a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RecordsEvent a -> ShowS
Show)

instance FromJSON a => FromJSON (RecordsEvent a) where
  parseJSON :: Value -> Parser (RecordsEvent a)
parseJSON = String
-> (Object -> Parser (RecordsEvent a))
-> Value
-> Parser (RecordsEvent a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RecordsEvent" ((Object -> Parser (RecordsEvent a))
 -> Value -> Parser (RecordsEvent a))
-> (Object -> Parser (RecordsEvent a))
-> Value
-> Parser (RecordsEvent a)
forall a b. (a -> b) -> a -> b
$ \Object
o -> [a] -> RecordsEvent a
forall a. [a] -> RecordsEvent a
RecordsEvent ([a] -> RecordsEvent a) -> Parser [a] -> Parser (RecordsEvent a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [a]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"Records"

$(makeLenses ''RecordsEvent)