{-# LANGUAGE TemplateHaskell #-}

{- |
Module      :  Google.Response

Define data types to represent all of the responses that are received from the Google API.
-}
module Google.Response
  ( Token(..)
  , Account(..)
  , DateTime(..)
  , ZonedDateTime(..)
  , CalendarEvent(..)
  , CalendarEventList(..)
  , GmailSend(..)
  , GmailList(..)
  , GmailMessage(..)
  , FileResource(..)
  , FileList(..)
  , MediaContent(..)
  ) where

import Data.Aeson (FromJSON(..), (.:?), withObject)
import Data.Aeson.Casing (snakeCase)
import Data.Aeson.TH (Options(..), defaultOptions, deriveFromJSON, deriveJSON)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe (fromMaybe)
import Data.Text (Text, intercalate, splitOn)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Web.FormUrlEncoded (FromForm, ToForm)
import Data.Time.Clock (UTCTime)
import Data.Time.LocalTime (ZonedTime, zonedTimeToUTC)
import Web.HttpApiData (FromHttpApiData(..), ToHttpApiData(..), parseUrlPieces, toUrlPieces)

import Google.Type (FileId, MediaType, MediaContent(..))


data Token = Token
  { Token -> Text
accessToken :: Text
  , Token -> Text
tokenType :: Text
  , Token -> Int
expiresIn :: Int
  } deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, (forall x. Token -> Rep Token x)
-> (forall x. Rep Token x -> Token) -> Generic Token
forall x. Rep Token x -> Token
forall x. Token -> Rep Token x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Token x -> Token
$cfrom :: forall x. Token -> Rep Token x
Generic, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show, Typeable)

deriveJSON (defaultOptions {fieldLabelModifier = snakeCase}) ''Token

instance FromForm Token

instance ToForm Token

newtype Account = Account
  { Account -> Text
email :: Text
  } deriving (Account -> Account -> Bool
(Account -> Account -> Bool)
-> (Account -> Account -> Bool) -> Eq Account
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Account -> Account -> Bool
$c/= :: Account -> Account -> Bool
== :: Account -> Account -> Bool
$c== :: Account -> Account -> Bool
Eq, (forall x. Account -> Rep Account x)
-> (forall x. Rep Account x -> Account) -> Generic Account
forall x. Rep Account x -> Account
forall x. Account -> Rep Account x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Account x -> Account
$cfrom :: forall x. Account -> Rep Account x
Generic, Int -> Account -> ShowS
[Account] -> ShowS
Account -> String
(Int -> Account -> ShowS)
-> (Account -> String) -> ([Account] -> ShowS) -> Show Account
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Account] -> ShowS
$cshowList :: [Account] -> ShowS
show :: Account -> String
$cshow :: Account -> String
showsPrec :: Int -> Account -> ShowS
$cshowsPrec :: Int -> Account -> ShowS
Show, Typeable, ByteString -> Either Text Account
Text -> Either Text Account
(Text -> Either Text Account)
-> (ByteString -> Either Text Account)
-> (Text -> Either Text Account)
-> FromHttpApiData Account
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
parseQueryParam :: Text -> Either Text Account
$cparseQueryParam :: Text -> Either Text Account
parseHeader :: ByteString -> Either Text Account
$cparseHeader :: ByteString -> Either Text Account
parseUrlPiece :: Text -> Either Text Account
$cparseUrlPiece :: Text -> Either Text Account
FromHttpApiData, Account -> ByteString
Account -> Builder
Account -> Text
(Account -> Text)
-> (Account -> Builder)
-> (Account -> ByteString)
-> (Account -> Text)
-> ToHttpApiData Account
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: Account -> Text
$ctoQueryParam :: Account -> Text
toHeader :: Account -> ByteString
$ctoHeader :: Account -> ByteString
toEncodedUrlPiece :: Account -> Builder
$ctoEncodedUrlPiece :: Account -> Builder
toUrlPiece :: Account -> Text
$ctoUrlPiece :: Account -> Text
ToHttpApiData)

deriveJSON defaultOptions ''Account

instance FromHttpApiData [Account] where
  parseUrlPiece :: Text -> Either Text [Account]
parseUrlPiece = [Text] -> Either Text [Account]
forall (t :: * -> *) a.
(Traversable t, FromHttpApiData a) =>
t Text -> Either Text (t a)
parseUrlPieces ([Text] -> Either Text [Account])
-> (Text -> [Text]) -> Text -> Either Text [Account]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> [Text]
splitOn Text
",")

instance ToHttpApiData [Account] where
  toUrlPiece :: [Account] -> Text
toUrlPiece = (Text -> [Text] -> Text
intercalate Text
",") ([Text] -> Text) -> ([Account] -> [Text]) -> [Account] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Account] -> [Text]
forall (t :: * -> *) a.
(Functor t, ToHttpApiData a) =>
t a -> t Text
toUrlPieces


newtype DateTime = DateTime
  { DateTime -> UTCTime
dateTime :: UTCTime
  } deriving (DateTime -> DateTime -> Bool
(DateTime -> DateTime -> Bool)
-> (DateTime -> DateTime -> Bool) -> Eq DateTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DateTime -> DateTime -> Bool
$c/= :: DateTime -> DateTime -> Bool
== :: DateTime -> DateTime -> Bool
$c== :: DateTime -> DateTime -> Bool
Eq, (forall x. DateTime -> Rep DateTime x)
-> (forall x. Rep DateTime x -> DateTime) -> Generic DateTime
forall x. Rep DateTime x -> DateTime
forall x. DateTime -> Rep DateTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DateTime x -> DateTime
$cfrom :: forall x. DateTime -> Rep DateTime x
Generic, Int -> DateTime -> ShowS
[DateTime] -> ShowS
DateTime -> String
(Int -> DateTime -> ShowS)
-> (DateTime -> String) -> ([DateTime] -> ShowS) -> Show DateTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DateTime] -> ShowS
$cshowList :: [DateTime] -> ShowS
show :: DateTime -> String
$cshow :: DateTime -> String
showsPrec :: Int -> DateTime -> ShowS
$cshowsPrec :: Int -> DateTime -> ShowS
Show, Typeable, ByteString -> Either Text DateTime
Text -> Either Text DateTime
(Text -> Either Text DateTime)
-> (ByteString -> Either Text DateTime)
-> (Text -> Either Text DateTime)
-> FromHttpApiData DateTime
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
parseQueryParam :: Text -> Either Text DateTime
$cparseQueryParam :: Text -> Either Text DateTime
parseHeader :: ByteString -> Either Text DateTime
$cparseHeader :: ByteString -> Either Text DateTime
parseUrlPiece :: Text -> Either Text DateTime
$cparseUrlPiece :: Text -> Either Text DateTime
FromHttpApiData, DateTime -> ByteString
DateTime -> Builder
DateTime -> Text
(DateTime -> Text)
-> (DateTime -> Builder)
-> (DateTime -> ByteString)
-> (DateTime -> Text)
-> ToHttpApiData DateTime
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: DateTime -> Text
$ctoQueryParam :: DateTime -> Text
toHeader :: DateTime -> ByteString
$ctoHeader :: DateTime -> ByteString
toEncodedUrlPiece :: DateTime -> Builder
$ctoEncodedUrlPiece :: DateTime -> Builder
toUrlPiece :: DateTime -> Text
$ctoUrlPiece :: DateTime -> Text
ToHttpApiData)

deriveJSON defaultOptions ''DateTime


newtype ZonedDateTime = ZonedDateTime
  { ZonedDateTime -> Maybe ZonedTime
dateTime :: Maybe ZonedTime
  } deriving ((forall x. ZonedDateTime -> Rep ZonedDateTime x)
-> (forall x. Rep ZonedDateTime x -> ZonedDateTime)
-> Generic ZonedDateTime
forall x. Rep ZonedDateTime x -> ZonedDateTime
forall x. ZonedDateTime -> Rep ZonedDateTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ZonedDateTime x -> ZonedDateTime
$cfrom :: forall x. ZonedDateTime -> Rep ZonedDateTime x
Generic, Int -> ZonedDateTime -> ShowS
[ZonedDateTime] -> ShowS
ZonedDateTime -> String
(Int -> ZonedDateTime -> ShowS)
-> (ZonedDateTime -> String)
-> ([ZonedDateTime] -> ShowS)
-> Show ZonedDateTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZonedDateTime] -> ShowS
$cshowList :: [ZonedDateTime] -> ShowS
show :: ZonedDateTime -> String
$cshow :: ZonedDateTime -> String
showsPrec :: Int -> ZonedDateTime -> ShowS
$cshowsPrec :: Int -> ZonedDateTime -> ShowS
Show, Typeable, ByteString -> Either Text ZonedDateTime
Text -> Either Text ZonedDateTime
(Text -> Either Text ZonedDateTime)
-> (ByteString -> Either Text ZonedDateTime)
-> (Text -> Either Text ZonedDateTime)
-> FromHttpApiData ZonedDateTime
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
parseQueryParam :: Text -> Either Text ZonedDateTime
$cparseQueryParam :: Text -> Either Text ZonedDateTime
parseHeader :: ByteString -> Either Text ZonedDateTime
$cparseHeader :: ByteString -> Either Text ZonedDateTime
parseUrlPiece :: Text -> Either Text ZonedDateTime
$cparseUrlPiece :: Text -> Either Text ZonedDateTime
FromHttpApiData, ZonedDateTime -> ByteString
ZonedDateTime -> Builder
ZonedDateTime -> Text
(ZonedDateTime -> Text)
-> (ZonedDateTime -> Builder)
-> (ZonedDateTime -> ByteString)
-> (ZonedDateTime -> Text)
-> ToHttpApiData ZonedDateTime
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: ZonedDateTime -> Text
$ctoQueryParam :: ZonedDateTime -> Text
toHeader :: ZonedDateTime -> ByteString
$ctoHeader :: ZonedDateTime -> ByteString
toEncodedUrlPiece :: ZonedDateTime -> Builder
$ctoEncodedUrlPiece :: ZonedDateTime -> Builder
toUrlPiece :: ZonedDateTime -> Text
$ctoUrlPiece :: ZonedDateTime -> Text
ToHttpApiData)

deriveJSON defaultOptions ''ZonedDateTime

instance Eq ZonedDateTime where
  == :: ZonedDateTime -> ZonedDateTime -> Bool
(==) =
    (\ZonedDateTime
x ZonedDateTime
y ->
      let
        toUTC :: ZonedDateTime -> Maybe UTCTime
        toUTC :: ZonedDateTime -> Maybe UTCTime
toUTC = ((ZonedTime -> UTCTime) -> Maybe ZonedTime -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ZonedTime -> UTCTime
zonedTimeToUTC) (Maybe ZonedTime -> Maybe UTCTime)
-> (ZonedDateTime -> Maybe ZonedTime)
-> ZonedDateTime
-> Maybe UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ZonedDateTime -> Maybe ZonedTime
dateTime :: ZonedDateTime -> Maybe ZonedTime)
      in
        (ZonedDateTime -> Maybe UTCTime
toUTC ZonedDateTime
x) Maybe UTCTime -> Maybe UTCTime -> Bool
forall a. Eq a => a -> a -> Bool
== (ZonedDateTime -> Maybe UTCTime
toUTC ZonedDateTime
y)
    )

data ExtendedProperties = ExtendedProperties
  { ExtendedProperties -> HashMap Text Text
private :: HashMap Text Text
  , ExtendedProperties -> HashMap Text Text
shared :: HashMap Text Text
  } deriving (ExtendedProperties -> ExtendedProperties -> Bool
(ExtendedProperties -> ExtendedProperties -> Bool)
-> (ExtendedProperties -> ExtendedProperties -> Bool)
-> Eq ExtendedProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtendedProperties -> ExtendedProperties -> Bool
$c/= :: ExtendedProperties -> ExtendedProperties -> Bool
== :: ExtendedProperties -> ExtendedProperties -> Bool
$c== :: ExtendedProperties -> ExtendedProperties -> Bool
Eq, (forall x. ExtendedProperties -> Rep ExtendedProperties x)
-> (forall x. Rep ExtendedProperties x -> ExtendedProperties)
-> Generic ExtendedProperties
forall x. Rep ExtendedProperties x -> ExtendedProperties
forall x. ExtendedProperties -> Rep ExtendedProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExtendedProperties x -> ExtendedProperties
$cfrom :: forall x. ExtendedProperties -> Rep ExtendedProperties x
Generic, Int -> ExtendedProperties -> ShowS
[ExtendedProperties] -> ShowS
ExtendedProperties -> String
(Int -> ExtendedProperties -> ShowS)
-> (ExtendedProperties -> String)
-> ([ExtendedProperties] -> ShowS)
-> Show ExtendedProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtendedProperties] -> ShowS
$cshowList :: [ExtendedProperties] -> ShowS
show :: ExtendedProperties -> String
$cshow :: ExtendedProperties -> String
showsPrec :: Int -> ExtendedProperties -> ShowS
$cshowsPrec :: Int -> ExtendedProperties -> ShowS
Show, Typeable)

instance FromJSON ExtendedProperties where
  parseJSON :: Value -> Parser ExtendedProperties
parseJSON = String
-> (Object -> Parser ExtendedProperties)
-> Value
-> Parser ExtendedProperties
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExtendedProperties" ((Object -> Parser ExtendedProperties)
 -> Value -> Parser ExtendedProperties)
-> (Object -> Parser ExtendedProperties)
-> Value
-> Parser ExtendedProperties
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    HashMap Text Text -> HashMap Text Text -> ExtendedProperties
ExtendedProperties
      (HashMap Text Text -> HashMap Text Text -> ExtendedProperties)
-> Parser (HashMap Text Text)
-> Parser (HashMap Text Text -> ExtendedProperties)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HashMap Text Text -> Maybe (HashMap Text Text) -> HashMap Text Text
forall a. a -> Maybe a -> a
fromMaybe HashMap Text Text
forall k v. HashMap k v
HashMap.empty (Maybe (HashMap Text Text) -> HashMap Text Text)
-> Parser (Maybe (HashMap Text Text)) -> Parser (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe (HashMap Text Text))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"private")
      Parser (HashMap Text Text -> ExtendedProperties)
-> Parser (HashMap Text Text) -> Parser ExtendedProperties
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (HashMap Text Text -> Maybe (HashMap Text Text) -> HashMap Text Text
forall a. a -> Maybe a -> a
fromMaybe HashMap Text Text
forall k v. HashMap k v
HashMap.empty (Maybe (HashMap Text Text) -> HashMap Text Text)
-> Parser (Maybe (HashMap Text Text)) -> Parser (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe (HashMap Text Text))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"shared")

data CalendarEvent = CalendarEvent
  { CalendarEvent -> Text
status :: Text
  , CalendarEvent -> Account
organizer :: Account
  , CalendarEvent -> Account
creator :: Account
  , CalendarEvent -> Maybe [Account]
attendees :: Maybe [Account]
  , CalendarEvent -> Maybe Text
summary :: Maybe Text
  , CalendarEvent -> Maybe Text
description :: Maybe Text
  , CalendarEvent -> Maybe ZonedDateTime
start :: Maybe ZonedDateTime
  , CalendarEvent -> Maybe ZonedDateTime
end :: Maybe ZonedDateTime
  , CalendarEvent -> Maybe ExtendedProperties
extendedProperties :: Maybe ExtendedProperties
  } deriving (CalendarEvent -> CalendarEvent -> Bool
(CalendarEvent -> CalendarEvent -> Bool)
-> (CalendarEvent -> CalendarEvent -> Bool) -> Eq CalendarEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CalendarEvent -> CalendarEvent -> Bool
$c/= :: CalendarEvent -> CalendarEvent -> Bool
== :: CalendarEvent -> CalendarEvent -> Bool
$c== :: CalendarEvent -> CalendarEvent -> Bool
Eq, (forall x. CalendarEvent -> Rep CalendarEvent x)
-> (forall x. Rep CalendarEvent x -> CalendarEvent)
-> Generic CalendarEvent
forall x. Rep CalendarEvent x -> CalendarEvent
forall x. CalendarEvent -> Rep CalendarEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CalendarEvent x -> CalendarEvent
$cfrom :: forall x. CalendarEvent -> Rep CalendarEvent x
Generic, Int -> CalendarEvent -> ShowS
[CalendarEvent] -> ShowS
CalendarEvent -> String
(Int -> CalendarEvent -> ShowS)
-> (CalendarEvent -> String)
-> ([CalendarEvent] -> ShowS)
-> Show CalendarEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CalendarEvent] -> ShowS
$cshowList :: [CalendarEvent] -> ShowS
show :: CalendarEvent -> String
$cshow :: CalendarEvent -> String
showsPrec :: Int -> CalendarEvent -> ShowS
$cshowsPrec :: Int -> CalendarEvent -> ShowS
Show, Typeable)

deriveFromJSON defaultOptions ''CalendarEvent


data CalendarEventList = CalendarEventList
  { CalendarEventList -> Text
kind :: Text
  , CalendarEventList -> Text
summary :: Text
  , CalendarEventList -> [CalendarEvent]
items :: [CalendarEvent]
  } deriving (CalendarEventList -> CalendarEventList -> Bool
(CalendarEventList -> CalendarEventList -> Bool)
-> (CalendarEventList -> CalendarEventList -> Bool)
-> Eq CalendarEventList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CalendarEventList -> CalendarEventList -> Bool
$c/= :: CalendarEventList -> CalendarEventList -> Bool
== :: CalendarEventList -> CalendarEventList -> Bool
$c== :: CalendarEventList -> CalendarEventList -> Bool
Eq, (forall x. CalendarEventList -> Rep CalendarEventList x)
-> (forall x. Rep CalendarEventList x -> CalendarEventList)
-> Generic CalendarEventList
forall x. Rep CalendarEventList x -> CalendarEventList
forall x. CalendarEventList -> Rep CalendarEventList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CalendarEventList x -> CalendarEventList
$cfrom :: forall x. CalendarEventList -> Rep CalendarEventList x
Generic, Int -> CalendarEventList -> ShowS
[CalendarEventList] -> ShowS
CalendarEventList -> String
(Int -> CalendarEventList -> ShowS)
-> (CalendarEventList -> String)
-> ([CalendarEventList] -> ShowS)
-> Show CalendarEventList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CalendarEventList] -> ShowS
$cshowList :: [CalendarEventList] -> ShowS
show :: CalendarEventList -> String
$cshow :: CalendarEventList -> String
showsPrec :: Int -> CalendarEventList -> ShowS
$cshowsPrec :: Int -> CalendarEventList -> ShowS
Show, Typeable)

deriveFromJSON defaultOptions ''CalendarEventList


data GmailSend = GmailSend
  { GmailSend -> Text
id :: Text
  } deriving (GmailSend -> GmailSend -> Bool
(GmailSend -> GmailSend -> Bool)
-> (GmailSend -> GmailSend -> Bool) -> Eq GmailSend
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GmailSend -> GmailSend -> Bool
$c/= :: GmailSend -> GmailSend -> Bool
== :: GmailSend -> GmailSend -> Bool
$c== :: GmailSend -> GmailSend -> Bool
Eq, (forall x. GmailSend -> Rep GmailSend x)
-> (forall x. Rep GmailSend x -> GmailSend) -> Generic GmailSend
forall x. Rep GmailSend x -> GmailSend
forall x. GmailSend -> Rep GmailSend x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GmailSend x -> GmailSend
$cfrom :: forall x. GmailSend -> Rep GmailSend x
Generic, Int -> GmailSend -> ShowS
[GmailSend] -> ShowS
GmailSend -> String
(Int -> GmailSend -> ShowS)
-> (GmailSend -> String)
-> ([GmailSend] -> ShowS)
-> Show GmailSend
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GmailSend] -> ShowS
$cshowList :: [GmailSend] -> ShowS
show :: GmailSend -> String
$cshow :: GmailSend -> String
showsPrec :: Int -> GmailSend -> ShowS
$cshowsPrec :: Int -> GmailSend -> ShowS
Show, Typeable)

deriveJSON defaultOptions ''GmailSend

instance FromForm GmailSend

instance ToForm GmailSend

data GmailMessage = GmailMessage
  { GmailMessage -> Text
id :: Text
  , GmailMessage -> Text
threadId :: Text
  , GmailMessage -> Maybe Text
snippet :: Maybe Text
  } deriving (GmailMessage -> GmailMessage -> Bool
(GmailMessage -> GmailMessage -> Bool)
-> (GmailMessage -> GmailMessage -> Bool) -> Eq GmailMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GmailMessage -> GmailMessage -> Bool
$c/= :: GmailMessage -> GmailMessage -> Bool
== :: GmailMessage -> GmailMessage -> Bool
$c== :: GmailMessage -> GmailMessage -> Bool
Eq, (forall x. GmailMessage -> Rep GmailMessage x)
-> (forall x. Rep GmailMessage x -> GmailMessage)
-> Generic GmailMessage
forall x. Rep GmailMessage x -> GmailMessage
forall x. GmailMessage -> Rep GmailMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GmailMessage x -> GmailMessage
$cfrom :: forall x. GmailMessage -> Rep GmailMessage x
Generic, Int -> GmailMessage -> ShowS
[GmailMessage] -> ShowS
GmailMessage -> String
(Int -> GmailMessage -> ShowS)
-> (GmailMessage -> String)
-> ([GmailMessage] -> ShowS)
-> Show GmailMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GmailMessage] -> ShowS
$cshowList :: [GmailMessage] -> ShowS
show :: GmailMessage -> String
$cshow :: GmailMessage -> String
showsPrec :: Int -> GmailMessage -> ShowS
$cshowsPrec :: Int -> GmailMessage -> ShowS
Show, Typeable)
deriveJSON defaultOptions ''GmailMessage

instance FromForm GmailMessage

instance ToForm GmailMessage

data GmailList = GmailList
  { GmailList -> [GmailMessage]
messages :: [GmailMessage]
  } deriving (GmailList -> GmailList -> Bool
(GmailList -> GmailList -> Bool)
-> (GmailList -> GmailList -> Bool) -> Eq GmailList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GmailList -> GmailList -> Bool
$c/= :: GmailList -> GmailList -> Bool
== :: GmailList -> GmailList -> Bool
$c== :: GmailList -> GmailList -> Bool
Eq, (forall x. GmailList -> Rep GmailList x)
-> (forall x. Rep GmailList x -> GmailList) -> Generic GmailList
forall x. Rep GmailList x -> GmailList
forall x. GmailList -> Rep GmailList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GmailList x -> GmailList
$cfrom :: forall x. GmailList -> Rep GmailList x
Generic, Int -> GmailList -> ShowS
[GmailList] -> ShowS
GmailList -> String
(Int -> GmailList -> ShowS)
-> (GmailList -> String)
-> ([GmailList] -> ShowS)
-> Show GmailList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GmailList] -> ShowS
$cshowList :: [GmailList] -> ShowS
show :: GmailList -> String
$cshow :: GmailList -> String
showsPrec :: Int -> GmailList -> ShowS
$cshowsPrec :: Int -> GmailList -> ShowS
Show, Typeable)
deriveJSON defaultOptions ''GmailList

data FileResource = FileResource
  { FileResource -> Text
kind :: Text
  , FileResource -> FileId
id :: FileId
  , FileResource -> Text
name :: Text
  , FileResource -> MediaType
mimeType :: MediaType
  } deriving (FileResource -> FileResource -> Bool
(FileResource -> FileResource -> Bool)
-> (FileResource -> FileResource -> Bool) -> Eq FileResource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileResource -> FileResource -> Bool
$c/= :: FileResource -> FileResource -> Bool
== :: FileResource -> FileResource -> Bool
$c== :: FileResource -> FileResource -> Bool
Eq, (forall x. FileResource -> Rep FileResource x)
-> (forall x. Rep FileResource x -> FileResource)
-> Generic FileResource
forall x. Rep FileResource x -> FileResource
forall x. FileResource -> Rep FileResource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileResource x -> FileResource
$cfrom :: forall x. FileResource -> Rep FileResource x
Generic, Int -> FileResource -> ShowS
[FileResource] -> ShowS
FileResource -> String
(Int -> FileResource -> ShowS)
-> (FileResource -> String)
-> ([FileResource] -> ShowS)
-> Show FileResource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileResource] -> ShowS
$cshowList :: [FileResource] -> ShowS
show :: FileResource -> String
$cshow :: FileResource -> String
showsPrec :: Int -> FileResource -> ShowS
$cshowsPrec :: Int -> FileResource -> ShowS
Show, Typeable)

deriveJSON defaultOptions ''FileResource


data FileList = FileList
  { FileList -> Text
kind :: Text
  , FileList -> [FileResource]
files :: [FileResource]
  } deriving (FileList -> FileList -> Bool
(FileList -> FileList -> Bool)
-> (FileList -> FileList -> Bool) -> Eq FileList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileList -> FileList -> Bool
$c/= :: FileList -> FileList -> Bool
== :: FileList -> FileList -> Bool
$c== :: FileList -> FileList -> Bool
Eq, (forall x. FileList -> Rep FileList x)
-> (forall x. Rep FileList x -> FileList) -> Generic FileList
forall x. Rep FileList x -> FileList
forall x. FileList -> Rep FileList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileList x -> FileList
$cfrom :: forall x. FileList -> Rep FileList x
Generic, Int -> FileList -> ShowS
[FileList] -> ShowS
FileList -> String
(Int -> FileList -> ShowS)
-> (FileList -> String) -> ([FileList] -> ShowS) -> Show FileList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileList] -> ShowS
$cshowList :: [FileList] -> ShowS
show :: FileList -> String
$cshow :: FileList -> String
showsPrec :: Int -> FileList -> ShowS
$cshowsPrec :: Int -> FileList -> ShowS
Show, Typeable)

deriveJSON defaultOptions ''FileList