{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}

{-|
Module      : Dialogflow.V2.Payload.Google
Description : Dialogflow types for Google Actions payload.
Copyright   : (c) Mauricio Fierro, 2019
License     : BSD3-Clause
Maintainer  : Mauricio Fierro <mauriciofierrom@gmail.com>

This module contains types for the Google Actions payload to be included
in the webhook reponse. See the Dialogflow <https://developers.google.com/actions/build/json/dialogflow-webhook-json#dialogflow-response-body documentation>.
-}

module Dialogflow.V2.Fulfillment.Payload.Google where

import Data.Aeson ( parseJSON
                  , toJSON
                  , withObject
                  , FromJSON
                  , ToJSON
                  , Value(..)
                  , (.=)
                  , (.:)
                  , (.:!) )
import Data.Foldable (asum)
import qualified Data.HashMap.Strict as HM

import Dialogflow.Util
import qualified Dialogflow.V2.Fulfillment.Message as M

-- | This field can be used to provide responses for different platforms
-- like Actions on Google.
newtype GooglePayload =
  GooglePayload { GooglePayload -> Response
unGooglePayload :: Response } deriving (GooglePayload -> GooglePayload -> Bool
(GooglePayload -> GooglePayload -> Bool)
-> (GooglePayload -> GooglePayload -> Bool) -> Eq GooglePayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GooglePayload -> GooglePayload -> Bool
$c/= :: GooglePayload -> GooglePayload -> Bool
== :: GooglePayload -> GooglePayload -> Bool
$c== :: GooglePayload -> GooglePayload -> Bool
Eq, Int -> GooglePayload -> ShowS
[GooglePayload] -> ShowS
GooglePayload -> String
(Int -> GooglePayload -> ShowS)
-> (GooglePayload -> String)
-> ([GooglePayload] -> ShowS)
-> Show GooglePayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GooglePayload] -> ShowS
$cshowList :: [GooglePayload] -> ShowS
show :: GooglePayload -> String
$cshow :: GooglePayload -> String
showsPrec :: Int -> GooglePayload -> ShowS
$cshowsPrec :: Int -> GooglePayload -> ShowS
Show)

instance ToJSON GooglePayload where
  toJSON :: GooglePayload -> Value
toJSON GooglePayload
gp =
    [Pair] -> Value
noNullObjects [ Text
"google" Text -> Response -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= GooglePayload -> Response
unGooglePayload GooglePayload
gp]

-- | An image.
data Image =
  Image { Image -> String
iUrl :: String
        , Image -> String
iAccessibilityText :: String
        , Image -> Maybe Int
iHeight :: Maybe Int
        , Image -> Maybe Int
iWidth :: Maybe Int
        } deriving (Image -> Image -> Bool
(Image -> Image -> Bool) -> (Image -> Image -> Bool) -> Eq Image
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c== :: Image -> Image -> Bool
Eq, Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
(Int -> Image -> ShowS)
-> (Image -> String) -> ([Image] -> ShowS) -> Show Image
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Image] -> ShowS
$cshowList :: [Image] -> ShowS
show :: Image -> String
$cshow :: Image -> String
showsPrec :: Int -> Image -> ShowS
$cshowsPrec :: Int -> Image -> ShowS
Show)

instance FromJSON Image where
  parseJSON :: Value -> Parser Image
parseJSON = String -> (Object -> Parser Image) -> Value -> Parser Image
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"image" ((Object -> Parser Image) -> Value -> Parser Image)
-> (Object -> Parser Image) -> Value -> Parser Image
forall a b. (a -> b) -> a -> b
$ \Object
i -> do
    String
iUrl <- Object
i Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"url"
    String
iAccessibilityText <- Object
i Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"accessibilityText"
    Maybe Int
iHeight <- Object
i Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"height"
    Maybe Int
iWidth <- Object
i Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"width"
    Image -> Parser Image
forall (m :: * -> *) a. Monad m => a -> m a
return Image :: String -> String -> Maybe Int -> Maybe Int -> Image
Image{String
Maybe Int
iWidth :: Maybe Int
iHeight :: Maybe Int
iAccessibilityText :: String
iUrl :: String
iWidth :: Maybe Int
iHeight :: Maybe Int
iAccessibilityText :: String
iUrl :: String
..}

instance ToJSON Image where
  toJSON :: Image -> Value
toJSON Image{String
Maybe Int
iWidth :: Maybe Int
iHeight :: Maybe Int
iAccessibilityText :: String
iUrl :: String
iWidth :: Image -> Maybe Int
iHeight :: Image -> Maybe Int
iAccessibilityText :: Image -> String
iUrl :: Image -> String
..} =
    [Pair] -> Value
noNullObjects [ Text
"url" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
iUrl
           , Text
"accessibilityText" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
iAccessibilityText
           , Text
"height" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Int
iHeight
           , Text
"width" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Int
iWidth ]

-- | A 'BasicCard' can either contain an image or formatted text.
data BasicCardContent = BasicCardImage Image
                      | BasicCardFormattedText String
                      deriving (BasicCardContent -> BasicCardContent -> Bool
(BasicCardContent -> BasicCardContent -> Bool)
-> (BasicCardContent -> BasicCardContent -> Bool)
-> Eq BasicCardContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BasicCardContent -> BasicCardContent -> Bool
$c/= :: BasicCardContent -> BasicCardContent -> Bool
== :: BasicCardContent -> BasicCardContent -> Bool
$c== :: BasicCardContent -> BasicCardContent -> Bool
Eq, Int -> BasicCardContent -> ShowS
[BasicCardContent] -> ShowS
BasicCardContent -> String
(Int -> BasicCardContent -> ShowS)
-> (BasicCardContent -> String)
-> ([BasicCardContent] -> ShowS)
-> Show BasicCardContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BasicCardContent] -> ShowS
$cshowList :: [BasicCardContent] -> ShowS
show :: BasicCardContent -> String
$cshow :: BasicCardContent -> String
showsPrec :: Int -> BasicCardContent -> ShowS
$cshowsPrec :: Int -> BasicCardContent -> ShowS
Show)

instance FromJSON BasicCardContent where
  parseJSON :: Value -> Parser BasicCardContent
parseJSON = String
-> (Object -> Parser BasicCardContent)
-> Value
-> Parser BasicCardContent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Image or formatted text" ((Object -> Parser BasicCardContent)
 -> Value -> Parser BasicCardContent)
-> (Object -> Parser BasicCardContent)
-> Value
-> Parser BasicCardContent
forall a b. (a -> b) -> a -> b
$ \Object
bcc ->
    [Parser BasicCardContent] -> Parser BasicCardContent
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ Image -> BasicCardContent
BasicCardImage (Image -> BasicCardContent)
-> Parser Image -> Parser BasicCardContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
bcc Object -> Text -> Parser Image
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"image"
         , String -> BasicCardContent
BasicCardFormattedText (String -> BasicCardContent)
-> Parser String -> Parser BasicCardContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
bcc Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"formattedText" ]

instance ToJSON BasicCardContent where
  toJSON :: BasicCardContent -> Value
toJSON = \case
    BasicCardImage Image
image -> [Pair] -> Value
noNullObjects [ Text
"image" Text -> Image -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Image
image ]
    BasicCardFormattedText String
formattedText -> [Pair] -> Value
noNullObjects [ Text
"formattedText" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
formattedText ]

-- | Possible image display options for affecting the presentation of an 'Image'.
-- This should be used for when the 'Image''s aspect ratio does not match the 'Image'
-- container's aspect ratio.
data ImageDisplayOption = DEFAULT
                          -- ^ Fill the gaps between the 'Image' and the 'Image' container
                          -- with gray bars.
                        | WHITE
                          -- ^  Fill the gaps between the 'Image' and the 'Image' container
                          -- with white bars.
                        | CROPPED
                          -- ^ 'Image' is scaled such that the 'Image' width and height match
                          -- or exceed the container dimensions. This may crop the top and
                          -- bottom of the 'Image' if the scaled 'Image' height is greater than
                          -- the container height, or crop the left and right of the 'Image'
                          -- if the scaled 'Image' width is greater than the container width.
                          -- This is similar to "Zoom Mode" on a widescreen TV when playing
                          -- a 4:3 video.
                        deriving (ImageDisplayOption -> ImageDisplayOption -> Bool
(ImageDisplayOption -> ImageDisplayOption -> Bool)
-> (ImageDisplayOption -> ImageDisplayOption -> Bool)
-> Eq ImageDisplayOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageDisplayOption -> ImageDisplayOption -> Bool
$c/= :: ImageDisplayOption -> ImageDisplayOption -> Bool
== :: ImageDisplayOption -> ImageDisplayOption -> Bool
$c== :: ImageDisplayOption -> ImageDisplayOption -> Bool
Eq, ReadPrec [ImageDisplayOption]
ReadPrec ImageDisplayOption
Int -> ReadS ImageDisplayOption
ReadS [ImageDisplayOption]
(Int -> ReadS ImageDisplayOption)
-> ReadS [ImageDisplayOption]
-> ReadPrec ImageDisplayOption
-> ReadPrec [ImageDisplayOption]
-> Read ImageDisplayOption
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImageDisplayOption]
$creadListPrec :: ReadPrec [ImageDisplayOption]
readPrec :: ReadPrec ImageDisplayOption
$creadPrec :: ReadPrec ImageDisplayOption
readList :: ReadS [ImageDisplayOption]
$creadList :: ReadS [ImageDisplayOption]
readsPrec :: Int -> ReadS ImageDisplayOption
$creadsPrec :: Int -> ReadS ImageDisplayOption
Read, Int -> ImageDisplayOption -> ShowS
[ImageDisplayOption] -> ShowS
ImageDisplayOption -> String
(Int -> ImageDisplayOption -> ShowS)
-> (ImageDisplayOption -> String)
-> ([ImageDisplayOption] -> ShowS)
-> Show ImageDisplayOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageDisplayOption] -> ShowS
$cshowList :: [ImageDisplayOption] -> ShowS
show :: ImageDisplayOption -> String
$cshow :: ImageDisplayOption -> String
showsPrec :: Int -> ImageDisplayOption -> ShowS
$cshowsPrec :: Int -> ImageDisplayOption -> ShowS
Show)

instance FromJSON ImageDisplayOption where
  parseJSON :: Value -> Parser ImageDisplayOption
parseJSON = String
-> (Object -> Parser ImageDisplayOption)
-> Value
-> Parser ImageDisplayOption
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"imageDisplayOption" ((Object -> Parser ImageDisplayOption)
 -> Value -> Parser ImageDisplayOption)
-> (Object -> Parser ImageDisplayOption)
-> Value
-> Parser ImageDisplayOption
forall a b. (a -> b) -> a -> b
$ \Object
x -> do
    String
ido <- Object
x Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"imageDisplayOptions"
    ImageDisplayOption -> Parser ImageDisplayOption
forall (m :: * -> *) a. Monad m => a -> m a
return (ImageDisplayOption -> Parser ImageDisplayOption)
-> ImageDisplayOption -> Parser ImageDisplayOption
forall a b. (a -> b) -> a -> b
$ String -> ImageDisplayOption
forall a. Read a => String -> a
read String
ido

instance ToJSON ImageDisplayOption where
  toJSON :: ImageDisplayOption -> Value
toJSON ImageDisplayOption
x = [Pair] -> Value
noNullObjects [ Text
"imageDisplayOptions" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ImageDisplayOption -> String
forall a. Show a => a -> String
show ImageDisplayOption
x ]

-- | The type of the media within the response.
data MediaType = MEDIA_TYPE_UNSPECIFIED -- ^ Unspecified.
               | AUDIO                  -- ^ Audio stream.
               deriving (MediaType -> MediaType -> Bool
(MediaType -> MediaType -> Bool)
-> (MediaType -> MediaType -> Bool) -> Eq MediaType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MediaType -> MediaType -> Bool
$c/= :: MediaType -> MediaType -> Bool
== :: MediaType -> MediaType -> Bool
$c== :: MediaType -> MediaType -> Bool
Eq, ReadPrec [MediaType]
ReadPrec MediaType
Int -> ReadS MediaType
ReadS [MediaType]
(Int -> ReadS MediaType)
-> ReadS [MediaType]
-> ReadPrec MediaType
-> ReadPrec [MediaType]
-> Read MediaType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MediaType]
$creadListPrec :: ReadPrec [MediaType]
readPrec :: ReadPrec MediaType
$creadPrec :: ReadPrec MediaType
readList :: ReadS [MediaType]
$creadList :: ReadS [MediaType]
readsPrec :: Int -> ReadS MediaType
$creadsPrec :: Int -> ReadS MediaType
Read, Int -> MediaType -> ShowS
[MediaType] -> ShowS
MediaType -> String
(Int -> MediaType -> ShowS)
-> (MediaType -> String)
-> ([MediaType] -> ShowS)
-> Show MediaType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MediaType] -> ShowS
$cshowList :: [MediaType] -> ShowS
show :: MediaType -> String
$cshow :: MediaType -> String
showsPrec :: Int -> MediaType -> ShowS
$cshowsPrec :: Int -> MediaType -> ShowS
Show)

instance FromJSON MediaType where
  parseJSON :: Value -> Parser MediaType
parseJSON = String -> (Object -> Parser MediaType) -> Value -> Parser MediaType
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"mediaType" ((Object -> Parser MediaType) -> Value -> Parser MediaType)
-> (Object -> Parser MediaType) -> Value -> Parser MediaType
forall a b. (a -> b) -> a -> b
$ \Object
x -> do
    String
mt <- Object
x Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"mediaType"
    MediaType -> Parser MediaType
forall (m :: * -> *) a. Monad m => a -> m a
return (MediaType -> Parser MediaType) -> MediaType -> Parser MediaType
forall a b. (a -> b) -> a -> b
$ String -> MediaType
forall a. Read a => String -> a
read String
mt

instance ToJSON MediaType where
  toJSON :: MediaType -> Value
toJSON MediaType
x = [Pair] -> Value
noNullObjects [ Text
"mediaType" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= MediaType -> String
forall a. Show a => a -> String
show MediaType
x ]

-- | Represents one media noNullObjects which is returned with 'MediaResponse'.
-- Contains information about the media, such as name, description, url, etc.
data MediaObject =
  MediaObject { MediaObject -> String
moName :: String
                -- ^ Name of the 'MediaObject'.
              , MediaObject -> String
moDescription :: String
                -- ^ Description of the 'MediaObject'.
              , MediaObject -> String
moContentUrl :: String
                -- ^ The url pointing to the media content.
              , MediaObject -> Image
moLargeImage :: Image
                -- ^ A large 'Image', such as the cover of the album, etc.
              , MediaObject -> Image
moIcon :: Image
                -- ^ A small 'Image' icon displayed on the right from the title.
                -- It's resized to 36x36 dp.
              } deriving (MediaObject -> MediaObject -> Bool
(MediaObject -> MediaObject -> Bool)
-> (MediaObject -> MediaObject -> Bool) -> Eq MediaObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MediaObject -> MediaObject -> Bool
$c/= :: MediaObject -> MediaObject -> Bool
== :: MediaObject -> MediaObject -> Bool
$c== :: MediaObject -> MediaObject -> Bool
Eq, Int -> MediaObject -> ShowS
[MediaObject] -> ShowS
MediaObject -> String
(Int -> MediaObject -> ShowS)
-> (MediaObject -> String)
-> ([MediaObject] -> ShowS)
-> Show MediaObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MediaObject] -> ShowS
$cshowList :: [MediaObject] -> ShowS
show :: MediaObject -> String
$cshow :: MediaObject -> String
showsPrec :: Int -> MediaObject -> ShowS
$cshowsPrec :: Int -> MediaObject -> ShowS
Show)

instance FromJSON MediaObject where
  parseJSON :: Value -> Parser MediaObject
parseJSON = String
-> (Object -> Parser MediaObject) -> Value -> Parser MediaObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"MediaObject" ((Object -> Parser MediaObject) -> Value -> Parser MediaObject)
-> (Object -> Parser MediaObject) -> Value -> Parser MediaObject
forall a b. (a -> b) -> a -> b
$ \Object
mo -> do
    String
moName <- Object
mo Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
    String
moDescription <- Object
mo Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"description"
    String
moContentUrl <- Object
mo Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"contentUrl"
    Image
moLargeImage <- Object
mo Object -> Text -> Parser Image
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"largeImage"
    Image
moIcon <- Object
mo Object -> Text -> Parser Image
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"icon"
    MediaObject -> Parser MediaObject
forall (m :: * -> *) a. Monad m => a -> m a
return MediaObject :: String -> String -> String -> Image -> Image -> MediaObject
MediaObject{String
Image
moIcon :: Image
moLargeImage :: Image
moContentUrl :: String
moDescription :: String
moName :: String
moIcon :: Image
moLargeImage :: Image
moContentUrl :: String
moDescription :: String
moName :: String
..}

instance ToJSON MediaObject where
  toJSON :: MediaObject -> Value
toJSON MediaObject{String
Image
moIcon :: Image
moLargeImage :: Image
moContentUrl :: String
moDescription :: String
moName :: String
moIcon :: MediaObject -> Image
moLargeImage :: MediaObject -> Image
moContentUrl :: MediaObject -> String
moDescription :: MediaObject -> String
moName :: MediaObject -> String
..} =
    [Pair] -> Value
noNullObjects [ Text
"name" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
moName
           , Text
"description" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
moDescription
           , Text
"contentUrl" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
moContentUrl
           , Text
"largeImage" Text -> Image -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Image
moLargeImage
           , Text
"icon" Text -> Image -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Image
moIcon ]

-- | The possible types of @RichMessage@s.
data RichMessageType = RMTSimpleResponse
                     | RMTBasicCard
                     | RMTMediaResponse

-- | The response items.
data Res t where
  -- | A simple response containing speech or text to show the user.
  SimpleResponse :: M.SimpleResponse -> Res 'RMTSimpleResponse

  -- | A basic card for displaying some information, e.g. an image and/or text.
  BasicCard :: Maybe String        -- ^ Title.
            -> Maybe String        -- ^ Subtitle.
            -> BasicCardContent    -- ^ Card content can be an image of formatted text.
            -> [M.BasicCardButton] -- ^ Buttons. Currently supports at most 1.
            -> ImageDisplayOption  -- ^ Type of display option.
            -> Res 'RMTBasicCard

  -- | The response indicating a set of media to be played within the conversation.
  MediaResponse :: MediaType     -- ^ Type of the media within this response.
                -> [MediaObject] -- ^ The list of 'MediaObject's.
                -> Res 'RMTMediaResponse

deriving instance Eq (Res t)
deriving instance Show (Res t)

instance FromJSON (Res 'RMTSimpleResponse) where
  parseJSON :: Value -> Parser (Res 'RMTSimpleResponse)
parseJSON = String
-> (Object -> Parser (Res 'RMTSimpleResponse))
-> Value
-> Parser (Res 'RMTSimpleResponse)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"simpleResponse" ((Object -> Parser (Res 'RMTSimpleResponse))
 -> Value -> Parser (Res 'RMTSimpleResponse))
-> (Object -> Parser (Res 'RMTSimpleResponse))
-> Value
-> Parser (Res 'RMTSimpleResponse)
forall a b. (a -> b) -> a -> b
$ \Object
sr -> do
    SimpleResponse
simpleResponse <- Object
sr Object -> Text -> Parser SimpleResponse
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"simpleResponse"
    Res 'RMTSimpleResponse -> Parser (Res 'RMTSimpleResponse)
forall (m :: * -> *) a. Monad m => a -> m a
return (Res 'RMTSimpleResponse -> Parser (Res 'RMTSimpleResponse))
-> Res 'RMTSimpleResponse -> Parser (Res 'RMTSimpleResponse)
forall a b. (a -> b) -> a -> b
$ SimpleResponse -> Res 'RMTSimpleResponse
SimpleResponse SimpleResponse
simpleResponse

instance FromJSON (Res 'RMTBasicCard) where
  parseJSON :: Value -> Parser (Res 'RMTBasicCard)
parseJSON = String
-> (Object -> Parser (Res 'RMTBasicCard))
-> Value
-> Parser (Res 'RMTBasicCard)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"basicCard" ((Object -> Parser (Res 'RMTBasicCard))
 -> Value -> Parser (Res 'RMTBasicCard))
-> (Object -> Parser (Res 'RMTBasicCard))
-> Value
-> Parser (Res 'RMTBasicCard)
forall a b. (a -> b) -> a -> b
$ \Object
basicCard -> do
    Object
bc <- Object
basicCard Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"basicCard"
    Maybe String
mbTitle <- Object
bc Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"title"
    Maybe String
mbSubtitle <- Object
bc Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"subtitle"
    BasicCardContent
content <- Value -> Parser BasicCardContent
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
bc)
    [BasicCardButton]
buttons <- Object
bc Object -> Text -> Parser [BasicCardButton]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"buttons"
    ImageDisplayOption
imageDisplayOption <- Value -> Parser ImageDisplayOption
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
bc)
    Res 'RMTBasicCard -> Parser (Res 'RMTBasicCard)
forall (m :: * -> *) a. Monad m => a -> m a
return (Res 'RMTBasicCard -> Parser (Res 'RMTBasicCard))
-> Res 'RMTBasicCard -> Parser (Res 'RMTBasicCard)
forall a b. (a -> b) -> a -> b
$ Maybe String
-> Maybe String
-> BasicCardContent
-> [BasicCardButton]
-> ImageDisplayOption
-> Res 'RMTBasicCard
BasicCard Maybe String
mbTitle Maybe String
mbSubtitle BasicCardContent
content [BasicCardButton]
buttons ImageDisplayOption
imageDisplayOption

instance FromJSON (Res 'RMTMediaResponse) where
  parseJSON :: Value -> Parser (Res 'RMTMediaResponse)
parseJSON = String
-> (Object -> Parser (Res 'RMTMediaResponse))
-> Value
-> Parser (Res 'RMTMediaResponse)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"mediaResponse" ((Object -> Parser (Res 'RMTMediaResponse))
 -> Value -> Parser (Res 'RMTMediaResponse))
-> (Object -> Parser (Res 'RMTMediaResponse))
-> Value
-> Parser (Res 'RMTMediaResponse)
forall a b. (a -> b) -> a -> b
$ \Object
mediaResponse -> do
    Object
mr <- Object
mediaResponse Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"mediaResponse"
    MediaType
mediaType <- Value -> Parser MediaType
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
mr)
    [MediaObject]
mediaObjects <- Object
mr Object -> Text -> Parser [MediaObject]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"mediaObjects"
    Res 'RMTMediaResponse -> Parser (Res 'RMTMediaResponse)
forall (m :: * -> *) a. Monad m => a -> m a
return (Res 'RMTMediaResponse -> Parser (Res 'RMTMediaResponse))
-> Res 'RMTMediaResponse -> Parser (Res 'RMTMediaResponse)
forall a b. (a -> b) -> a -> b
$ MediaType -> [MediaObject] -> Res 'RMTMediaResponse
MediaResponse MediaType
mediaType [MediaObject]
mediaObjects

instance ToJSON (Res t) where
  toJSON :: Res t -> Value
toJSON (SimpleResponse SimpleResponse
s) = [Pair] -> Value
noNullObjects [ Text
"simpleResponse" Text -> SimpleResponse -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=  SimpleResponse
s ]
  toJSON (BasicCard Maybe String
t Maybe String
s BasicCardContent
c [BasicCardButton]
b ImageDisplayOption
d) =
    [Pair] -> Value
noNullObjects [ Text
"basicCard" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
obj ]
      where
        obj :: Value
obj = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [ Text
"title" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
t
                                   , Text
"subtitle" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
s
                                   , Text
"buttons" Text -> [BasicCardButton] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [BasicCardButton]
b ] Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> BasicCardContent -> Object
forall a. ToJSON a => a -> Object
toObject BasicCardContent
c Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> ImageDisplayOption -> Object
forall a. ToJSON a => a -> Object
toObject ImageDisplayOption
d
  toJSON (MediaResponse MediaType
mediaType [MediaObject]
mos) =
    [Pair] -> Value
noNullObjects [ Text
"mediaResponse" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
obj ]
      where
        obj :: Value
obj = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [ Text
"mediaObjects" Text -> [MediaObject] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [MediaObject]
mos ] Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> MediaType -> Object
forall a. ToJSON a => a -> Object
toObject MediaType
mediaType

-- | The items to include in the 'RichResponse'
data Item where
  Item :: (Show (Res t)) => Res t -> Item

instance Eq Item where
  == :: Item -> Item -> Bool
(==) (Item x :: Res t
x@BasicCard{}) (Item y :: Res t
y@BasicCard{}) = Res t
x Res t -> Res t -> Bool
forall a. Eq a => a -> a -> Bool
== Res t
Res t
y
  (==) (Item x :: Res t
x@SimpleResponse{}) (Item y :: Res t
y@SimpleResponse{}) = Res t
x Res t -> Res t -> Bool
forall a. Eq a => a -> a -> Bool
== Res t
Res t
y
  (==) (Item x :: Res t
x@MediaResponse{}) (Item y :: Res t
y@MediaResponse{}) = Res t
x Res t -> Res t -> Bool
forall a. Eq a => a -> a -> Bool
== Res t
Res t
y
  (==) Item
_ Item
_ = Bool
False

instance ToJSON Item where
  toJSON :: Item -> Value
toJSON (Item Res t
x) = Res t -> Value
forall a. ToJSON a => a -> Value
toJSON Res t
x

deriving instance Show Item

-- | A rich response that can include audio, text, cards, suggestions
-- and structured data.
data RichResponse = RichResponse
  { RichResponse -> [Item]
items :: [Item]
  -- ^ A list of UI elements which compose the response. The items must meet
  -- the following requirements:
  -- 1. The first item must be a 'SimpleResponse'
  -- 2. At most two 'SimpleResponse'
  -- 3. At most one rich response item (e.g. 'BasicCard', 'StructuredResponse',
  -- 'MediaResponse', or HtmlResponse)
  -- 4. You cannot use a rich response item if you're using an actions.intent.OPTION
  -- intent ie ListSelect or CarouselSelect
  , RichResponse -> [Suggestion]
suggestions :: [Suggestion]
  -- ^ A list of suggested replies. These will always appear at the end of the response.
  , RichResponse -> Maybe LinkOutSuggestion
linkOutSuggestion :: Maybe LinkOutSuggestion
  -- ^  An additional suggestion chip that can link out to the associated app
  -- or site.
  } deriving (RichResponse -> RichResponse -> Bool
(RichResponse -> RichResponse -> Bool)
-> (RichResponse -> RichResponse -> Bool) -> Eq RichResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RichResponse -> RichResponse -> Bool
$c/= :: RichResponse -> RichResponse -> Bool
== :: RichResponse -> RichResponse -> Bool
$c== :: RichResponse -> RichResponse -> Bool
Eq, Int -> RichResponse -> ShowS
[RichResponse] -> ShowS
RichResponse -> String
(Int -> RichResponse -> ShowS)
-> (RichResponse -> String)
-> ([RichResponse] -> ShowS)
-> Show RichResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RichResponse] -> ShowS
$cshowList :: [RichResponse] -> ShowS
show :: RichResponse -> String
$cshow :: RichResponse -> String
showsPrec :: Int -> RichResponse -> ShowS
$cshowsPrec :: Int -> RichResponse -> ShowS
Show)

instance ToJSON RichResponse where
  toJSON :: RichResponse -> Value
toJSON RichResponse{[Suggestion]
[Item]
Maybe LinkOutSuggestion
linkOutSuggestion :: Maybe LinkOutSuggestion
suggestions :: [Suggestion]
items :: [Item]
linkOutSuggestion :: RichResponse -> Maybe LinkOutSuggestion
suggestions :: RichResponse -> [Suggestion]
items :: RichResponse -> [Item]
..} =
    [Pair] -> Value
noNullObjects [ Text
"items" Text -> [Item] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Item]
items
           , Text
"suggestions" Text -> [Suggestion] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Suggestion]
suggestions
           , Text
"linkOutSuggestion" Text -> Maybe LinkOutSuggestion -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe LinkOutSuggestion
linkOutSuggestion ]

-- | The response sent by the fulfillment to Google Assistant.
data Response =
  Response { Response -> Bool
expectUserResponse :: Bool
             -- ^ Indicates whether your fulfillment expects a user response.
             -- Set the value to true when to keep the conversation going and
             -- false to end the conversation.
           , Response -> Maybe String
userStorage :: Maybe String
             -- ^ Stores persistent data tied to a specific user. The total storage
             -- amount is 10,000 bytes.
           , Response -> RichResponse
richResponse :: RichResponse
             -- ^ This field contains audio, text, cards, suggestions, or structured
             -- data for the Assistant to render. To learn more about using rich
             -- responses for Actions on Google, see 'Res'.
           } deriving (Response -> Response -> Bool
(Response -> Response -> Bool)
-> (Response -> Response -> Bool) -> Eq Response
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Response -> Response -> Bool
$c/= :: Response -> Response -> Bool
== :: Response -> Response -> Bool
$c== :: Response -> Response -> Bool
Eq, Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show)

instance ToJSON Response where
  toJSON :: Response -> Value
toJSON Response{Bool
Maybe String
RichResponse
richResponse :: RichResponse
userStorage :: Maybe String
expectUserResponse :: Bool
richResponse :: Response -> RichResponse
userStorage :: Response -> Maybe String
expectUserResponse :: Response -> Bool
..} =
    [Pair] -> Value
noNullObjects [ Text
"expectUserResponse" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
expectUserResponse
           , Text
"userStorage" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
userStorage
           , Text
"richResponse" Text -> RichResponse -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= RichResponse
richResponse ]

-- | Different types of url hints.
data UrlTypeHint = URL_TYPE_HINT_UNSPECIFIED
                   -- ^ Unspecified.
                 | AMP_CONTENT
                   -- ^ URL that points directly to AMP content, or to a canonical
                   -- URL which refers to AMP content via .
                 deriving (UrlTypeHint -> UrlTypeHint -> Bool
(UrlTypeHint -> UrlTypeHint -> Bool)
-> (UrlTypeHint -> UrlTypeHint -> Bool) -> Eq UrlTypeHint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UrlTypeHint -> UrlTypeHint -> Bool
$c/= :: UrlTypeHint -> UrlTypeHint -> Bool
== :: UrlTypeHint -> UrlTypeHint -> Bool
$c== :: UrlTypeHint -> UrlTypeHint -> Bool
Eq, ReadPrec [UrlTypeHint]
ReadPrec UrlTypeHint
Int -> ReadS UrlTypeHint
ReadS [UrlTypeHint]
(Int -> ReadS UrlTypeHint)
-> ReadS [UrlTypeHint]
-> ReadPrec UrlTypeHint
-> ReadPrec [UrlTypeHint]
-> Read UrlTypeHint
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UrlTypeHint]
$creadListPrec :: ReadPrec [UrlTypeHint]
readPrec :: ReadPrec UrlTypeHint
$creadPrec :: ReadPrec UrlTypeHint
readList :: ReadS [UrlTypeHint]
$creadList :: ReadS [UrlTypeHint]
readsPrec :: Int -> ReadS UrlTypeHint
$creadsPrec :: Int -> ReadS UrlTypeHint
Read, Int -> UrlTypeHint -> ShowS
[UrlTypeHint] -> ShowS
UrlTypeHint -> String
(Int -> UrlTypeHint -> ShowS)
-> (UrlTypeHint -> String)
-> ([UrlTypeHint] -> ShowS)
-> Show UrlTypeHint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UrlTypeHint] -> ShowS
$cshowList :: [UrlTypeHint] -> ShowS
show :: UrlTypeHint -> String
$cshow :: UrlTypeHint -> String
showsPrec :: Int -> UrlTypeHint -> ShowS
$cshowsPrec :: Int -> UrlTypeHint -> ShowS
Show)

instance FromJSON UrlTypeHint where
  parseJSON :: Value -> Parser UrlTypeHint
parseJSON = String
-> (Object -> Parser UrlTypeHint) -> Value -> Parser UrlTypeHint
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"urlTypeHint" ((Object -> Parser UrlTypeHint) -> Value -> Parser UrlTypeHint)
-> (Object -> Parser UrlTypeHint) -> Value -> Parser UrlTypeHint
forall a b. (a -> b) -> a -> b
$ \Object
x -> do
    String
uth <- Object
x Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"urlTypeHint"
    UrlTypeHint -> Parser UrlTypeHint
forall (m :: * -> *) a. Monad m => a -> m a
return (UrlTypeHint -> Parser UrlTypeHint)
-> UrlTypeHint -> Parser UrlTypeHint
forall a b. (a -> b) -> a -> b
$ String -> UrlTypeHint
forall a. Read a => String -> a
read String
uth

instance ToJSON UrlTypeHint where
  toJSON :: UrlTypeHint -> Value
toJSON UrlTypeHint
x = [Pair] -> Value
noNullObjects [ Text
"urlTypeHint" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UrlTypeHint -> String
forall a. Show a => a -> String
show UrlTypeHint
x ]

-- | VersionFilter should be included if specific version/s of the App are
-- required.
data VersionFilter = VersionFilter
  { VersionFilter -> Int
minVersion :: Int
    -- ^  Min version code or 0, inclusive.
  , VersionFilter -> Int
maxVersion :: Int
    -- ^ Max version code, inclusive. The range considered is [minVersion:maxVersion].
    -- A null range implies any version.
  } deriving (VersionFilter -> VersionFilter -> Bool
(VersionFilter -> VersionFilter -> Bool)
-> (VersionFilter -> VersionFilter -> Bool) -> Eq VersionFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionFilter -> VersionFilter -> Bool
$c/= :: VersionFilter -> VersionFilter -> Bool
== :: VersionFilter -> VersionFilter -> Bool
$c== :: VersionFilter -> VersionFilter -> Bool
Eq, ReadPrec [VersionFilter]
ReadPrec VersionFilter
Int -> ReadS VersionFilter
ReadS [VersionFilter]
(Int -> ReadS VersionFilter)
-> ReadS [VersionFilter]
-> ReadPrec VersionFilter
-> ReadPrec [VersionFilter]
-> Read VersionFilter
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VersionFilter]
$creadListPrec :: ReadPrec [VersionFilter]
readPrec :: ReadPrec VersionFilter
$creadPrec :: ReadPrec VersionFilter
readList :: ReadS [VersionFilter]
$creadList :: ReadS [VersionFilter]
readsPrec :: Int -> ReadS VersionFilter
$creadsPrec :: Int -> ReadS VersionFilter
Read, Int -> VersionFilter -> ShowS
[VersionFilter] -> ShowS
VersionFilter -> String
(Int -> VersionFilter -> ShowS)
-> (VersionFilter -> String)
-> ([VersionFilter] -> ShowS)
-> Show VersionFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionFilter] -> ShowS
$cshowList :: [VersionFilter] -> ShowS
show :: VersionFilter -> String
$cshow :: VersionFilter -> String
showsPrec :: Int -> VersionFilter -> ShowS
$cshowsPrec :: Int -> VersionFilter -> ShowS
Show)

instance FromJSON VersionFilter where
  parseJSON :: Value -> Parser VersionFilter
parseJSON = String
-> (Object -> Parser VersionFilter)
-> Value
-> Parser VersionFilter
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"versionFilter" ((Object -> Parser VersionFilter) -> Value -> Parser VersionFilter)
-> (Object -> Parser VersionFilter)
-> Value
-> Parser VersionFilter
forall a b. (a -> b) -> a -> b
$ \Object
vf -> do
    Int
minVersion <- Object
vf Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"minVersion"
    Int
maxVersion <- Object
vf Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"maxVersion"
    VersionFilter -> Parser VersionFilter
forall (m :: * -> *) a. Monad m => a -> m a
return VersionFilter :: Int -> Int -> VersionFilter
VersionFilter{Int
maxVersion :: Int
minVersion :: Int
maxVersion :: Int
minVersion :: Int
..}

instance ToJSON VersionFilter where
  toJSON :: VersionFilter -> Value
toJSON VersionFilter{Int
maxVersion :: Int
minVersion :: Int
maxVersion :: VersionFilter -> Int
minVersion :: VersionFilter -> Int
..} =
    [Pair] -> Value
noNullObjects [ Text
"minVersion" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
minVersion
           , Text
"maxVersion" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
maxVersion ]

-- | Specification of the Android App for fulfillment restrictions.
data AndroidApp = AndroidApp
  { AndroidApp -> String
aaPackageName :: String
    -- ^ Package name must be specified when specifing Android Fulfillment.
  , AndroidApp -> [VersionFilter]
aaVersions :: [VersionFilter]
    -- ^ When multiple filters are specified, any filter match will trigger the app.
  } deriving (AndroidApp -> AndroidApp -> Bool
(AndroidApp -> AndroidApp -> Bool)
-> (AndroidApp -> AndroidApp -> Bool) -> Eq AndroidApp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AndroidApp -> AndroidApp -> Bool
$c/= :: AndroidApp -> AndroidApp -> Bool
== :: AndroidApp -> AndroidApp -> Bool
$c== :: AndroidApp -> AndroidApp -> Bool
Eq, ReadPrec [AndroidApp]
ReadPrec AndroidApp
Int -> ReadS AndroidApp
ReadS [AndroidApp]
(Int -> ReadS AndroidApp)
-> ReadS [AndroidApp]
-> ReadPrec AndroidApp
-> ReadPrec [AndroidApp]
-> Read AndroidApp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AndroidApp]
$creadListPrec :: ReadPrec [AndroidApp]
readPrec :: ReadPrec AndroidApp
$creadPrec :: ReadPrec AndroidApp
readList :: ReadS [AndroidApp]
$creadList :: ReadS [AndroidApp]
readsPrec :: Int -> ReadS AndroidApp
$creadsPrec :: Int -> ReadS AndroidApp
Read, Int -> AndroidApp -> ShowS
[AndroidApp] -> ShowS
AndroidApp -> String
(Int -> AndroidApp -> ShowS)
-> (AndroidApp -> String)
-> ([AndroidApp] -> ShowS)
-> Show AndroidApp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AndroidApp] -> ShowS
$cshowList :: [AndroidApp] -> ShowS
show :: AndroidApp -> String
$cshow :: AndroidApp -> String
showsPrec :: Int -> AndroidApp -> ShowS
$cshowsPrec :: Int -> AndroidApp -> ShowS
Show)

instance FromJSON AndroidApp where
  parseJSON :: Value -> Parser AndroidApp
parseJSON = String
-> (Object -> Parser AndroidApp) -> Value -> Parser AndroidApp
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"androidApp" ((Object -> Parser AndroidApp) -> Value -> Parser AndroidApp)
-> (Object -> Parser AndroidApp) -> Value -> Parser AndroidApp
forall a b. (a -> b) -> a -> b
$ \Object
aa -> do
    String
aaPackageName <- Object
aa Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"packageName"
    [VersionFilter]
aaVersions <- Object
aa Object -> Text -> Parser [VersionFilter]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"versions"
    AndroidApp -> Parser AndroidApp
forall (m :: * -> *) a. Monad m => a -> m a
return AndroidApp :: String -> [VersionFilter] -> AndroidApp
AndroidApp{String
[VersionFilter]
aaVersions :: [VersionFilter]
aaPackageName :: String
aaVersions :: [VersionFilter]
aaPackageName :: String
..}

instance ToJSON AndroidApp where
  toJSON :: AndroidApp -> Value
toJSON AndroidApp{String
[VersionFilter]
aaVersions :: [VersionFilter]
aaPackageName :: String
aaVersions :: AndroidApp -> [VersionFilter]
aaPackageName :: AndroidApp -> String
..} =
    [Pair] -> Value
noNullObjects [ Text
"packageName" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
aaPackageName
           , Text
"versions" Text -> [VersionFilter] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [VersionFilter]
aaVersions ]

-- | Opens the given url.
data OpenUrlAction =
  OpenUrlAction { OpenUrlAction -> String
ouaUrl :: String
                  -- ^ The url field which could be any of: - http/https urls
                  -- for opening an App-linked App or a webpage.
                , OpenUrlAction -> AndroidApp
ouaAndroidApp :: AndroidApp
                -- ^  Information about the Android App if the URL is expected
                -- to be fulfilled by an Android App.
                , OpenUrlAction -> UrlTypeHint
ouaUrlTypeHint :: UrlTypeHint
                -- ^  Indicates a hint for the url type.
                } deriving (OpenUrlAction -> OpenUrlAction -> Bool
(OpenUrlAction -> OpenUrlAction -> Bool)
-> (OpenUrlAction -> OpenUrlAction -> Bool) -> Eq OpenUrlAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenUrlAction -> OpenUrlAction -> Bool
$c/= :: OpenUrlAction -> OpenUrlAction -> Bool
== :: OpenUrlAction -> OpenUrlAction -> Bool
$c== :: OpenUrlAction -> OpenUrlAction -> Bool
Eq, ReadPrec [OpenUrlAction]
ReadPrec OpenUrlAction
Int -> ReadS OpenUrlAction
ReadS [OpenUrlAction]
(Int -> ReadS OpenUrlAction)
-> ReadS [OpenUrlAction]
-> ReadPrec OpenUrlAction
-> ReadPrec [OpenUrlAction]
-> Read OpenUrlAction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OpenUrlAction]
$creadListPrec :: ReadPrec [OpenUrlAction]
readPrec :: ReadPrec OpenUrlAction
$creadPrec :: ReadPrec OpenUrlAction
readList :: ReadS [OpenUrlAction]
$creadList :: ReadS [OpenUrlAction]
readsPrec :: Int -> ReadS OpenUrlAction
$creadsPrec :: Int -> ReadS OpenUrlAction
Read, Int -> OpenUrlAction -> ShowS
[OpenUrlAction] -> ShowS
OpenUrlAction -> String
(Int -> OpenUrlAction -> ShowS)
-> (OpenUrlAction -> String)
-> ([OpenUrlAction] -> ShowS)
-> Show OpenUrlAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenUrlAction] -> ShowS
$cshowList :: [OpenUrlAction] -> ShowS
show :: OpenUrlAction -> String
$cshow :: OpenUrlAction -> String
showsPrec :: Int -> OpenUrlAction -> ShowS
$cshowsPrec :: Int -> OpenUrlAction -> ShowS
Show)

instance FromJSON OpenUrlAction where
  parseJSON :: Value -> Parser OpenUrlAction
parseJSON = String
-> (Object -> Parser OpenUrlAction)
-> Value
-> Parser OpenUrlAction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"openUrlAction" ((Object -> Parser OpenUrlAction) -> Value -> Parser OpenUrlAction)
-> (Object -> Parser OpenUrlAction)
-> Value
-> Parser OpenUrlAction
forall a b. (a -> b) -> a -> b
$ \Object
oua -> do
    String
ouaUrl <- Object
oua Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"url"
    AndroidApp
ouaAndroidApp <- Object
oua Object -> Text -> Parser AndroidApp
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"androidApp"
    UrlTypeHint
ouaUrlTypeHint <- Value -> Parser UrlTypeHint
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
oua)
    OpenUrlAction -> Parser OpenUrlAction
forall (m :: * -> *) a. Monad m => a -> m a
return OpenUrlAction :: String -> AndroidApp -> UrlTypeHint -> OpenUrlAction
OpenUrlAction{String
AndroidApp
UrlTypeHint
ouaUrlTypeHint :: UrlTypeHint
ouaAndroidApp :: AndroidApp
ouaUrl :: String
ouaUrlTypeHint :: UrlTypeHint
ouaAndroidApp :: AndroidApp
ouaUrl :: String
..}

instance ToJSON OpenUrlAction where
  toJSON :: OpenUrlAction -> Value
toJSON OpenUrlAction{String
AndroidApp
UrlTypeHint
ouaUrlTypeHint :: UrlTypeHint
ouaAndroidApp :: AndroidApp
ouaUrl :: String
ouaUrlTypeHint :: OpenUrlAction -> UrlTypeHint
ouaAndroidApp :: OpenUrlAction -> AndroidApp
ouaUrl :: OpenUrlAction -> String
..} =
    Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [ Text
"url" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
ouaUrl
                         , Text
"androidApp" Text -> AndroidApp -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AndroidApp
ouaAndroidApp
                         ] Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> UrlTypeHint -> Object
forall a. ToJSON a => a -> Object
toObject UrlTypeHint
ouaUrlTypeHint

-- | Creates a suggestion chip that allows the user to jump out to the App
-- or Website associated with this agent.
data LinkOutSuggestion = LinkOutSuggestion
  { LinkOutSuggestion -> String
losDestinationName :: String
    -- ^ The name of the app or site this chip is linking to. The chip will be
    -- rendered with the title "Open ". Max 20 chars.
  , LinkOutSuggestion -> String
losUrl :: String
    -- ^ Deprecated. Use OpenUrlAction instead.
  , LinkOutSuggestion -> OpenUrlAction
losOpenUrlAction :: OpenUrlAction
    -- ^ The URL of the App or Site to open when the user taps the suggestion
    -- chip. Ownership of this App/URL must be validated in the actions on Google
    -- developer console, or the suggestion will not be shown to the user.
  } deriving (LinkOutSuggestion -> LinkOutSuggestion -> Bool
(LinkOutSuggestion -> LinkOutSuggestion -> Bool)
-> (LinkOutSuggestion -> LinkOutSuggestion -> Bool)
-> Eq LinkOutSuggestion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinkOutSuggestion -> LinkOutSuggestion -> Bool
$c/= :: LinkOutSuggestion -> LinkOutSuggestion -> Bool
== :: LinkOutSuggestion -> LinkOutSuggestion -> Bool
$c== :: LinkOutSuggestion -> LinkOutSuggestion -> Bool
Eq, Int -> LinkOutSuggestion -> ShowS
[LinkOutSuggestion] -> ShowS
LinkOutSuggestion -> String
(Int -> LinkOutSuggestion -> ShowS)
-> (LinkOutSuggestion -> String)
-> ([LinkOutSuggestion] -> ShowS)
-> Show LinkOutSuggestion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinkOutSuggestion] -> ShowS
$cshowList :: [LinkOutSuggestion] -> ShowS
show :: LinkOutSuggestion -> String
$cshow :: LinkOutSuggestion -> String
showsPrec :: Int -> LinkOutSuggestion -> ShowS
$cshowsPrec :: Int -> LinkOutSuggestion -> ShowS
Show)

instance FromJSON LinkOutSuggestion where
  parseJSON :: Value -> Parser LinkOutSuggestion
parseJSON = String
-> (Object -> Parser LinkOutSuggestion)
-> Value
-> Parser LinkOutSuggestion
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"linkOutSuggestion" ((Object -> Parser LinkOutSuggestion)
 -> Value -> Parser LinkOutSuggestion)
-> (Object -> Parser LinkOutSuggestion)
-> Value
-> Parser LinkOutSuggestion
forall a b. (a -> b) -> a -> b
$ \Object
los -> do
    String
losDestinationName <- Object
los Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"destinationName"
    String
losUrl <- Object
los Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"url"
    OpenUrlAction
losOpenUrlAction <- Object
los Object -> Text -> Parser OpenUrlAction
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"openUrlAction"
    LinkOutSuggestion -> Parser LinkOutSuggestion
forall (m :: * -> *) a. Monad m => a -> m a
return LinkOutSuggestion :: String -> String -> OpenUrlAction -> LinkOutSuggestion
LinkOutSuggestion{String
OpenUrlAction
losOpenUrlAction :: OpenUrlAction
losUrl :: String
losDestinationName :: String
losOpenUrlAction :: OpenUrlAction
losUrl :: String
losDestinationName :: String
..}

instance ToJSON LinkOutSuggestion where
  toJSON :: LinkOutSuggestion -> Value
toJSON LinkOutSuggestion{String
OpenUrlAction
losOpenUrlAction :: OpenUrlAction
losUrl :: String
losDestinationName :: String
losOpenUrlAction :: LinkOutSuggestion -> OpenUrlAction
losUrl :: LinkOutSuggestion -> String
losDestinationName :: LinkOutSuggestion -> String
..} =
    [Pair] -> Value
noNullObjects [ Text
"destinationName" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
losDestinationName
           , Text
"url" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
losUrl
           , Text
"openUrlAction" Text -> OpenUrlAction -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OpenUrlAction
losOpenUrlAction ]

-- | A suggestion chip that the user can tap to quickly post a reply to
-- the conversation.
newtype Suggestion = Suggestion { Suggestion -> String
unSuggestion :: String }
  deriving (Suggestion -> Suggestion -> Bool
(Suggestion -> Suggestion -> Bool)
-> (Suggestion -> Suggestion -> Bool) -> Eq Suggestion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Suggestion -> Suggestion -> Bool
$c/= :: Suggestion -> Suggestion -> Bool
== :: Suggestion -> Suggestion -> Bool
$c== :: Suggestion -> Suggestion -> Bool
Eq, Int -> Suggestion -> ShowS
[Suggestion] -> ShowS
Suggestion -> String
(Int -> Suggestion -> ShowS)
-> (Suggestion -> String)
-> ([Suggestion] -> ShowS)
-> Show Suggestion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Suggestion] -> ShowS
$cshowList :: [Suggestion] -> ShowS
show :: Suggestion -> String
$cshow :: Suggestion -> String
showsPrec :: Int -> Suggestion -> ShowS
$cshowsPrec :: Int -> Suggestion -> ShowS
Show)

instance FromJSON Suggestion where
  parseJSON :: Value -> Parser Suggestion
parseJSON = String
-> (Object -> Parser Suggestion) -> Value -> Parser Suggestion
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"suggestion" ((Object -> Parser Suggestion) -> Value -> Parser Suggestion)
-> (Object -> Parser Suggestion) -> Value -> Parser Suggestion
forall a b. (a -> b) -> a -> b
$ \Object
s -> do
    String
suggestion <- Object
s Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"title"
    Suggestion -> Parser Suggestion
forall (m :: * -> *) a. Monad m => a -> m a
return (Suggestion -> Parser Suggestion)
-> Suggestion -> Parser Suggestion
forall a b. (a -> b) -> a -> b
$ String -> Suggestion
Suggestion String
suggestion

instance ToJSON Suggestion where
  toJSON :: Suggestion -> Value
toJSON Suggestion
s = [Pair] -> Value
noNullObjects [ Text
"title" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Suggestion -> String
unSuggestion Suggestion
s ]