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

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

This module contains types for Dialogflow messages to be used in
a fulfillment webhook response. See the Dialogflow <https://cloud.google.com/dialogflow/docs/reference/rpc/google.cloud.dialogflow.v2#google.cloud.dialogflow.v2.Intent.Message documentation>.
-}

module Dialogflow.V2.Fulfillment.Message
  ( CardButton(..)
  , BasicCardContent(..)
  , BasicCardButton(..)
  , Item(..)
  , OpenUriAction(..)
  , SpeechText(..)
  , SimpleResponse(..)
  , Suggestion(..)
  , SelectItemInfo(..)
  , MsgType(..)
  , Msg( Text
       , Image
       , QuickReplies
       , Card
       , SimpleResponses
       , BasicCard
       , Suggestions
       , LinkOutSuggestion
       , ListSelect
       , CarouselSelect
       )
  , Message(..)
  ) where

import Data.Aeson ( FromJSON
                  , parseJSON
                  , ToJSON
                  , toJSON
                  , Value(..)
                  , withObject
                  , (.:)
                  , (.:!)
                  , (.=))
import Data.Foldable (asum)

import qualified Data.HashMap.Strict as HM

import Dialogflow.Util

-- | Button for a 'Card' message
data CardButton = CardButton
  { CardButton -> Maybe String
cbText     :: Maybe String -- ^ The text to show on the button.
  , CardButton -> Maybe String
cbPostback :: Maybe String -- ^ The text to send to the Dialogflow API or URI to open.
  } deriving (CardButton -> CardButton -> Bool
(CardButton -> CardButton -> Bool)
-> (CardButton -> CardButton -> Bool) -> Eq CardButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CardButton -> CardButton -> Bool
$c/= :: CardButton -> CardButton -> Bool
== :: CardButton -> CardButton -> Bool
$c== :: CardButton -> CardButton -> Bool
Eq, Int -> CardButton -> ShowS
[CardButton] -> ShowS
CardButton -> String
(Int -> CardButton -> ShowS)
-> (CardButton -> String)
-> ([CardButton] -> ShowS)
-> Show CardButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CardButton] -> ShowS
$cshowList :: [CardButton] -> ShowS
show :: CardButton -> String
$cshow :: CardButton -> String
showsPrec :: Int -> CardButton -> ShowS
$cshowsPrec :: Int -> CardButton -> ShowS
Show)

instance FromJSON CardButton where
  parseJSON :: Value -> Parser CardButton
parseJSON = String
-> (Object -> Parser CardButton) -> Value -> Parser CardButton
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"cardButton" ((Object -> Parser CardButton) -> Value -> Parser CardButton)
-> (Object -> Parser CardButton) -> Value -> Parser CardButton
forall a b. (a -> b) -> a -> b
$ \Object
cb -> do
    Maybe String
cbText <- Object
cb Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"text"
    Maybe String
cbPostback <- Object
cb Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"postback"
    CardButton -> Parser CardButton
forall (m :: * -> *) a. Monad m => a -> m a
return CardButton :: Maybe String -> Maybe String -> CardButton
CardButton{Maybe String
cbPostback :: Maybe String
cbText :: Maybe String
cbPostback :: Maybe String
cbText :: Maybe String
..}

instance ToJSON CardButton where
  toJSON :: CardButton -> Value
toJSON CardButton{Maybe String
cbPostback :: Maybe String
cbText :: Maybe String
cbPostback :: CardButton -> Maybe String
cbText :: CardButton -> Maybe String
..} =
    [Pair] -> Value
noNullObjects [ Text
"text" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
cbText
           , Text
"postback" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
cbPostback ]

-- | The 'BasicCard' message can have either an 'Image' or
-- formatted text as content.
data BasicCardContent = BasicCardImage (Msg 'MsgImage)
                      | 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 [ Msg 'MsgImage -> BasicCardContent
BasicCardImage (Msg 'MsgImage -> BasicCardContent)
-> Parser (Msg 'MsgImage) -> Parser BasicCardContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
bcc Object -> Text -> Parser (Msg 'MsgImage)
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
"formatted_text" ]

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

-- | A 'SimpleResponse' can have text-to-speech in plain text
-- or SSML format.
data SpeechText = TextToSpeech String -- ^ The plain text of the speech output
                | SSML String         -- ^ Structured spoken response to the user in SSML format
                deriving (SpeechText -> SpeechText -> Bool
(SpeechText -> SpeechText -> Bool)
-> (SpeechText -> SpeechText -> Bool) -> Eq SpeechText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpeechText -> SpeechText -> Bool
$c/= :: SpeechText -> SpeechText -> Bool
== :: SpeechText -> SpeechText -> Bool
$c== :: SpeechText -> SpeechText -> Bool
Eq, Int -> SpeechText -> ShowS
[SpeechText] -> ShowS
SpeechText -> String
(Int -> SpeechText -> ShowS)
-> (SpeechText -> String)
-> ([SpeechText] -> ShowS)
-> Show SpeechText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpeechText] -> ShowS
$cshowList :: [SpeechText] -> ShowS
show :: SpeechText -> String
$cshow :: SpeechText -> String
showsPrec :: Int -> SpeechText -> ShowS
$cshowsPrec :: Int -> SpeechText -> ShowS
Show)

instance FromJSON SpeechText where
  parseJSON :: Value -> Parser SpeechText
parseJSON = String
-> (Object -> Parser SpeechText) -> Value -> Parser SpeechText
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"textToSpeech or SSML" ((Object -> Parser SpeechText) -> Value -> Parser SpeechText)
-> (Object -> Parser SpeechText) -> Value -> Parser SpeechText
forall a b. (a -> b) -> a -> b
$ \Object
st ->
    [Parser SpeechText] -> Parser SpeechText
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ String -> SpeechText
TextToSpeech (String -> SpeechText) -> Parser String -> Parser SpeechText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
st Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"textToSpeech"
         , String -> SpeechText
SSML (String -> SpeechText) -> Parser String -> Parser SpeechText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
st Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ssml" ]

instance ToJSON SpeechText where
  toJSON :: SpeechText -> Value
toJSON = \case
    TextToSpeech String
textToSpeech -> [Pair] -> Value
noNullObjects [Text
"textToSpeech" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
textToSpeech]
    SSML String
ssml -> [Pair] -> Value
noNullObjects [Text
"ssml" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
ssml]

-- | A simple response message containing speech or text
data SimpleResponse = SimpleResponse
  { SimpleResponse -> SpeechText
simpleResponseText :: SpeechText   -- ^ The speech text
  , SimpleResponse -> Maybe String
displayText        :: Maybe String -- ^ The text to display
  } deriving (SimpleResponse -> SimpleResponse -> Bool
(SimpleResponse -> SimpleResponse -> Bool)
-> (SimpleResponse -> SimpleResponse -> Bool) -> Eq SimpleResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleResponse -> SimpleResponse -> Bool
$c/= :: SimpleResponse -> SimpleResponse -> Bool
== :: SimpleResponse -> SimpleResponse -> Bool
$c== :: SimpleResponse -> SimpleResponse -> Bool
Eq, Int -> SimpleResponse -> ShowS
[SimpleResponse] -> ShowS
SimpleResponse -> String
(Int -> SimpleResponse -> ShowS)
-> (SimpleResponse -> String)
-> ([SimpleResponse] -> ShowS)
-> Show SimpleResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleResponse] -> ShowS
$cshowList :: [SimpleResponse] -> ShowS
show :: SimpleResponse -> String
$cshow :: SimpleResponse -> String
showsPrec :: Int -> SimpleResponse -> ShowS
$cshowsPrec :: Int -> SimpleResponse -> ShowS
Show)

instance FromJSON SimpleResponse where
  parseJSON :: Value -> Parser SimpleResponse
parseJSON = String
-> (Object -> Parser SimpleResponse)
-> Value
-> Parser SimpleResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"simpleResponse" ((Object -> Parser SimpleResponse)
 -> Value -> Parser SimpleResponse)
-> (Object -> Parser SimpleResponse)
-> Value
-> Parser SimpleResponse
forall a b. (a -> b) -> a -> b
$ \Object
sr -> do
    SpeechText
simpleResponseText <- Value -> Parser SpeechText
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
sr)
    Maybe String
displayText <- Object
sr Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"displayText"
    SimpleResponse -> Parser SimpleResponse
forall (m :: * -> *) a. Monad m => a -> m a
return SimpleResponse :: SpeechText -> Maybe String -> SimpleResponse
SimpleResponse{Maybe String
SpeechText
displayText :: Maybe String
simpleResponseText :: SpeechText
displayText :: Maybe String
simpleResponseText :: SpeechText
..}

instance ToJSON SimpleResponse where
  toJSON :: SimpleResponse -> Value
toJSON SimpleResponse{Maybe String
SpeechText
displayText :: Maybe String
simpleResponseText :: SpeechText
displayText :: SimpleResponse -> Maybe String
simpleResponseText :: SimpleResponse -> SpeechText
..} = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$
    SpeechText -> Object
forall a. ToJSON a => a -> Object
toObject SpeechText
simpleResponseText Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> [Pair] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [Text
"displayText" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
displayText ]

-- | An action to open the given URI. Used in 'BasicCardButton's.
newtype OpenUriAction = OpenUriAction
  { OpenUriAction -> String
unOpenUriAction :: String -- ^ The HTTP or HTTPS scheme URI
  } deriving (OpenUriAction -> OpenUriAction -> Bool
(OpenUriAction -> OpenUriAction -> Bool)
-> (OpenUriAction -> OpenUriAction -> Bool) -> Eq OpenUriAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenUriAction -> OpenUriAction -> Bool
$c/= :: OpenUriAction -> OpenUriAction -> Bool
== :: OpenUriAction -> OpenUriAction -> Bool
$c== :: OpenUriAction -> OpenUriAction -> Bool
Eq, Int -> OpenUriAction -> ShowS
[OpenUriAction] -> ShowS
OpenUriAction -> String
(Int -> OpenUriAction -> ShowS)
-> (OpenUriAction -> String)
-> ([OpenUriAction] -> ShowS)
-> Show OpenUriAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenUriAction] -> ShowS
$cshowList :: [OpenUriAction] -> ShowS
show :: OpenUriAction -> String
$cshow :: OpenUriAction -> String
showsPrec :: Int -> OpenUriAction -> ShowS
$cshowsPrec :: Int -> OpenUriAction -> ShowS
Show)

instance ToJSON OpenUriAction where
  toJSON :: OpenUriAction -> Value
toJSON OpenUriAction
oua = [Pair] -> Value
noNullObjects [ Text
"uri" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OpenUriAction -> String
unOpenUriAction OpenUriAction
oua ]

instance FromJSON OpenUriAction where
  parseJSON :: Value -> Parser OpenUriAction
parseJSON = String
-> (Object -> Parser OpenUriAction)
-> Value
-> Parser OpenUriAction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"openUriAction" ((Object -> Parser OpenUriAction) -> Value -> Parser OpenUriAction)
-> (Object -> Parser OpenUriAction)
-> Value
-> Parser OpenUriAction
forall a b. (a -> b) -> a -> b
$ \Object
oua -> do
    String
uri <- Object
oua Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"uri"
    OpenUriAction -> Parser OpenUriAction
forall (m :: * -> *) a. Monad m => a -> m a
return (OpenUriAction -> Parser OpenUriAction)
-> OpenUriAction -> Parser OpenUriAction
forall a b. (a -> b) -> a -> b
$ String -> OpenUriAction
OpenUriAction String
uri

-- | Buttons for 'BasicCard's.
data BasicCardButton = BasicCardButton
  { BasicCardButton -> String
bcbTitle :: String                -- ^ The title of the button
  , BasicCardButton -> OpenUriAction
bcbOpenUriAction :: OpenUriAction -- ^ Action to take when a user taps on the button
  } deriving (BasicCardButton -> BasicCardButton -> Bool
(BasicCardButton -> BasicCardButton -> Bool)
-> (BasicCardButton -> BasicCardButton -> Bool)
-> Eq BasicCardButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BasicCardButton -> BasicCardButton -> Bool
$c/= :: BasicCardButton -> BasicCardButton -> Bool
== :: BasicCardButton -> BasicCardButton -> Bool
$c== :: BasicCardButton -> BasicCardButton -> Bool
Eq, Int -> BasicCardButton -> ShowS
[BasicCardButton] -> ShowS
BasicCardButton -> String
(Int -> BasicCardButton -> ShowS)
-> (BasicCardButton -> String)
-> ([BasicCardButton] -> ShowS)
-> Show BasicCardButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BasicCardButton] -> ShowS
$cshowList :: [BasicCardButton] -> ShowS
show :: BasicCardButton -> String
$cshow :: BasicCardButton -> String
showsPrec :: Int -> BasicCardButton -> ShowS
$cshowsPrec :: Int -> BasicCardButton -> ShowS
Show)

instance FromJSON BasicCardButton where
  parseJSON :: Value -> Parser BasicCardButton
parseJSON = String
-> (Object -> Parser BasicCardButton)
-> Value
-> Parser BasicCardButton
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"basicCardButton" ((Object -> Parser BasicCardButton)
 -> Value -> Parser BasicCardButton)
-> (Object -> Parser BasicCardButton)
-> Value
-> Parser BasicCardButton
forall a b. (a -> b) -> a -> b
$ \Object
bcb -> do
    String
bcbTitle <- Object
bcb Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"title"
    OpenUriAction
bcbOpenUriAction <- Object
bcb Object -> Text -> Parser OpenUriAction
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"open_uri_action"
    BasicCardButton -> Parser BasicCardButton
forall (m :: * -> *) a. Monad m => a -> m a
return BasicCardButton :: String -> OpenUriAction -> BasicCardButton
BasicCardButton{String
OpenUriAction
bcbOpenUriAction :: OpenUriAction
bcbTitle :: String
bcbOpenUriAction :: OpenUriAction
bcbTitle :: String
..}

instance ToJSON BasicCardButton where
  toJSON :: BasicCardButton -> Value
toJSON BasicCardButton{String
OpenUriAction
bcbOpenUriAction :: OpenUriAction
bcbTitle :: String
bcbOpenUriAction :: BasicCardButton -> OpenUriAction
bcbTitle :: BasicCardButton -> String
..} =
    [Pair] -> Value
noNullObjects [ Text
"title" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
bcbTitle
           , Text
"open_uri_action" Text -> OpenUriAction -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OpenUriAction
bcbOpenUriAction ]

-- | Suggestion chips.
newtype Suggestion = Suggestion
  { Suggestion -> String
unSuggestionTitle :: String -- ^ The text shown in the suggestion chip
  } 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
unSuggestionTitle <- 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
unSuggestionTitle

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
unSuggestionTitle Suggestion
s ]

-- | Additional information about an 'Item' for when it is triggered in a dialog.
data SelectItemInfo = SelectItemInfo
  { SelectItemInfo -> String
siiKey      :: String
  -- ^ A unique key that will be sent back to the agent if this response is given.
  , SelectItemInfo -> Maybe [String]
siiSynonyms :: Maybe [String]
  -- ^ A list of synonyms that can also be used to trigger this item in dialog.
  } deriving (SelectItemInfo -> SelectItemInfo -> Bool
(SelectItemInfo -> SelectItemInfo -> Bool)
-> (SelectItemInfo -> SelectItemInfo -> Bool) -> Eq SelectItemInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectItemInfo -> SelectItemInfo -> Bool
$c/= :: SelectItemInfo -> SelectItemInfo -> Bool
== :: SelectItemInfo -> SelectItemInfo -> Bool
$c== :: SelectItemInfo -> SelectItemInfo -> Bool
Eq, Int -> SelectItemInfo -> ShowS
[SelectItemInfo] -> ShowS
SelectItemInfo -> String
(Int -> SelectItemInfo -> ShowS)
-> (SelectItemInfo -> String)
-> ([SelectItemInfo] -> ShowS)
-> Show SelectItemInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectItemInfo] -> ShowS
$cshowList :: [SelectItemInfo] -> ShowS
show :: SelectItemInfo -> String
$cshow :: SelectItemInfo -> String
showsPrec :: Int -> SelectItemInfo -> ShowS
$cshowsPrec :: Int -> SelectItemInfo -> ShowS
Show)

instance FromJSON SelectItemInfo where
  parseJSON :: Value -> Parser SelectItemInfo
parseJSON = String
-> (Object -> Parser SelectItemInfo)
-> Value
-> Parser SelectItemInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"selectedItemInfo" ((Object -> Parser SelectItemInfo)
 -> Value -> Parser SelectItemInfo)
-> (Object -> Parser SelectItemInfo)
-> Value
-> Parser SelectItemInfo
forall a b. (a -> b) -> a -> b
$ \Object
sii -> do
    String
siiKey <- Object
sii Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"key"
    Maybe [String]
siiSynonyms <- Object
sii Object -> Text -> Parser (Maybe [String])
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"synonyms"
    SelectItemInfo -> Parser SelectItemInfo
forall (m :: * -> *) a. Monad m => a -> m a
return SelectItemInfo :: String -> Maybe [String] -> SelectItemInfo
SelectItemInfo{String
Maybe [String]
siiSynonyms :: Maybe [String]
siiKey :: String
siiSynonyms :: Maybe [String]
siiKey :: String
..}

instance ToJSON SelectItemInfo where
  toJSON :: SelectItemInfo -> Value
toJSON SelectItemInfo{String
Maybe [String]
siiSynonyms :: Maybe [String]
siiKey :: String
siiSynonyms :: SelectItemInfo -> Maybe [String]
siiKey :: SelectItemInfo -> String
..} =
    [Pair] -> Value
noNullObjects [ Text
"key" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
siiKey
           , Text
"synonyms" Text -> Maybe [String] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [String]
siiSynonyms ]

-- | The possible types of 'Message'.
data MsgType = MsgText
             | MsgImage
             | MsgQuickReplies
             | MsgCard
             | MsgSimpleResponses
             | MsgBasicCard
             | MsgSuggestions
             | MsgLinkOutSuggestion
             | MsgListSelect
             | MsgCarouselSelect

-- | The messages to be included in the Response.
data Msg t where
  -- | The text response message.
  Text
    :: Maybe [String] -- ^ The collection of the agent's responses
    -> Msg 'MsgText

  -- | The image response message.
  Image
    :: String -- ^ The public URI to an image file
    -> Maybe String -- ^ A text description of the image to be used for accessibility
    -> Msg 'MsgImage

  -- | The quick replies response message.
  QuickReplies
    :: Maybe String   -- ^ The title of the collection of quick replies
    -> [String]       -- ^ The collection of quick replies
    -> Msg 'MsgQuickReplies

  -- | The card response.
  Card
    :: Maybe String -- ^ The title of the card
    -> Maybe String -- ^ The subtitle of the card
    -> Maybe String -- ^ The public URI to an image file for the card
    -> Maybe [CardButton] -- ^ The collection of card buttons
    -> Msg 'MsgCard

  -- | The collection of 'SimpleResponse' candidates.
  SimpleResponses
    :: [SimpleResponse] -- ^ The list of simple responses
    -> Msg 'MsgSimpleResponses

-- TODO: Check if the formattedText and image fields are mutually exclusive
  -- | The basic card message. Useful for displaying information.
  BasicCard
    :: Maybe String      -- ^ The title of the card
    -> Maybe String      -- ^ The subtitle of the card
    -> BasicCardContent  -- ^ The body text or image of the card
    -> Maybe [BasicCardButton] -- ^ The collection of card buttons
    -> Msg 'MsgBasicCard

  -- | The collection of 'Suggestion'.
  Suggestions
    :: [Suggestion] -- ^ The list of suggested replies
    -> Msg 'MsgSuggestions

  -- | The suggestion chip message that allows the user to jump
  -- out to the app or the website associated with this agent.
  LinkOutSuggestion
    :: String -- ^ The name of the app or site this chip is linking to
    -> String -- ^ The URI of the app or site to open when the user taps the suggestion chip
    -> Msg 'MsgLinkOutSuggestion

  -- | The card for presenting a list of options to select from.
  ListSelect
    :: Maybe String -- ^ The overall title of the list
    -> [Item] -- ^ List items
    -> Msg 'MsgListSelect

  -- | The card for representing a carousel of options to select from.
  CarouselSelect
    :: [Item] -- ^ Carousel items
    -> Msg 'MsgCarouselSelect

deriving instance Show (Msg t)
deriving instance Eq (Msg t)

instance FromJSON (Msg 'MsgImage) where
  parseJSON :: Value -> Parser (Msg 'MsgImage)
parseJSON = String
-> (Object -> Parser (Msg 'MsgImage))
-> Value
-> Parser (Msg 'MsgImage)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"image" ((Object -> Parser (Msg 'MsgImage))
 -> Value -> Parser (Msg 'MsgImage))
-> (Object -> Parser (Msg 'MsgImage))
-> Value
-> Parser (Msg 'MsgImage)
forall a b. (a -> b) -> a -> b
$ \Object
i -> do
    String
uri <- Object
i Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"image_uri"
    Maybe String
allyText <- Object
i Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"accessibility_text"
    Msg 'MsgImage -> Parser (Msg 'MsgImage)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String -> Msg 'MsgImage
Image String
uri Maybe String
allyText)

instance FromJSON (Msg 'MsgText) where
  parseJSON :: Value -> Parser (Msg 'MsgText)
parseJSON = String
-> (Object -> Parser (Msg 'MsgText))
-> Value
-> Parser (Msg 'MsgText)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"text" ((Object -> Parser (Msg 'MsgText))
 -> Value -> Parser (Msg 'MsgText))
-> (Object -> Parser (Msg 'MsgText))
-> Value
-> Parser (Msg 'MsgText)
forall a b. (a -> b) -> a -> b
$ \Object
t -> do
    Maybe [String]
text <- Object
t Object -> Text -> Parser (Maybe [String])
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"text"
    Msg 'MsgText -> Parser (Msg 'MsgText)
forall (m :: * -> *) a. Monad m => a -> m a
return (Msg 'MsgText -> Parser (Msg 'MsgText))
-> Msg 'MsgText -> Parser (Msg 'MsgText)
forall a b. (a -> b) -> a -> b
$ Maybe [String] -> Msg 'MsgText
Text Maybe [String]
text

instance FromJSON (Msg 'MsgQuickReplies) where
  parseJSON :: Value -> Parser (Msg 'MsgQuickReplies)
parseJSON = String
-> (Object -> Parser (Msg 'MsgQuickReplies))
-> Value
-> Parser (Msg 'MsgQuickReplies)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"quickReplies" ((Object -> Parser (Msg 'MsgQuickReplies))
 -> Value -> Parser (Msg 'MsgQuickReplies))
-> (Object -> Parser (Msg 'MsgQuickReplies))
-> Value
-> Parser (Msg 'MsgQuickReplies)
forall a b. (a -> b) -> a -> b
$ \Object
qr -> do
    Maybe String
title <- Object
qr Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"title"
    [String]
replies <- Object
qr Object -> Text -> Parser [String]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"quick_replies"
    Msg 'MsgQuickReplies -> Parser (Msg 'MsgQuickReplies)
forall (m :: * -> *) a. Monad m => a -> m a
return (Msg 'MsgQuickReplies -> Parser (Msg 'MsgQuickReplies))
-> Msg 'MsgQuickReplies -> Parser (Msg 'MsgQuickReplies)
forall a b. (a -> b) -> a -> b
$ Maybe String -> [String] -> Msg 'MsgQuickReplies
QuickReplies Maybe String
title [String]
replies

instance FromJSON (Msg 'MsgCard) where
  parseJSON :: Value -> Parser (Msg 'MsgCard)
parseJSON = String
-> (Object -> Parser (Msg 'MsgCard))
-> Value
-> Parser (Msg 'MsgCard)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"card" ((Object -> Parser (Msg 'MsgCard))
 -> Value -> Parser (Msg 'MsgCard))
-> (Object -> Parser (Msg 'MsgCard))
-> Value
-> Parser (Msg 'MsgCard)
forall a b. (a -> b) -> a -> b
$ \Object
card -> do
    Object
c <- Object
card Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"card"
    Maybe String
mbTitle <- Object
c Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"title"
    Maybe String
mbSubtitle <- Object
c Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"subtitle"
    Maybe String
mbUri <- Object
c Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"image_uri"
    Maybe [CardButton]
cardButtons <- Object
c Object -> Text -> Parser (Maybe [CardButton])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"buttons"
    Msg 'MsgCard -> Parser (Msg 'MsgCard)
forall (m :: * -> *) a. Monad m => a -> m a
return (Msg 'MsgCard -> Parser (Msg 'MsgCard))
-> Msg 'MsgCard -> Parser (Msg 'MsgCard)
forall a b. (a -> b) -> a -> b
$ Maybe String
-> Maybe String
-> Maybe String
-> Maybe [CardButton]
-> Msg 'MsgCard
Card Maybe String
mbTitle Maybe String
mbSubtitle Maybe String
mbUri Maybe [CardButton]
cardButtons

instance FromJSON (Msg 'MsgSimpleResponses) where
  parseJSON :: Value -> Parser (Msg 'MsgSimpleResponses)
parseJSON = String
-> (Object -> Parser (Msg 'MsgSimpleResponses))
-> Value
-> Parser (Msg 'MsgSimpleResponses)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"simpleResponses" ((Object -> Parser (Msg 'MsgSimpleResponses))
 -> Value -> Parser (Msg 'MsgSimpleResponses))
-> (Object -> Parser (Msg 'MsgSimpleResponses))
-> Value
-> Parser (Msg 'MsgSimpleResponses)
forall a b. (a -> b) -> a -> b
$ \Object
sr -> do
    Object
srs <- Object
sr Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"simpleResponses"
    [SimpleResponse]
responses <- Object
srs Object -> Text -> Parser [SimpleResponse]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"simpleResponses"
    Msg 'MsgSimpleResponses -> Parser (Msg 'MsgSimpleResponses)
forall (m :: * -> *) a. Monad m => a -> m a
return (Msg 'MsgSimpleResponses -> Parser (Msg 'MsgSimpleResponses))
-> Msg 'MsgSimpleResponses -> Parser (Msg 'MsgSimpleResponses)
forall a b. (a -> b) -> a -> b
$ [SimpleResponse] -> Msg 'MsgSimpleResponses
SimpleResponses [SimpleResponse]
responses

instance FromJSON (Msg 'MsgBasicCard) where
  parseJSON :: Value -> Parser (Msg 'MsgBasicCard)
parseJSON = String
-> (Object -> Parser (Msg 'MsgBasicCard))
-> Value
-> Parser (Msg 'MsgBasicCard)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"basicCard" ((Object -> Parser (Msg 'MsgBasicCard))
 -> Value -> Parser (Msg 'MsgBasicCard))
-> (Object -> Parser (Msg 'MsgBasicCard))
-> Value
-> Parser (Msg 'MsgBasicCard)
forall a b. (a -> b) -> a -> b
$ \Object
bc -> do
    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 (Maybe a)
.:! Text
"subtitle"
    BasicCardContent
content <- Value -> Parser BasicCardContent
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
bc)
    Maybe [BasicCardButton]
buttons <- Object
bc Object -> Text -> Parser (Maybe [BasicCardButton])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"buttons"
    Msg 'MsgBasicCard -> Parser (Msg 'MsgBasicCard)
forall (m :: * -> *) a. Monad m => a -> m a
return (Msg 'MsgBasicCard -> Parser (Msg 'MsgBasicCard))
-> Msg 'MsgBasicCard -> Parser (Msg 'MsgBasicCard)
forall a b. (a -> b) -> a -> b
$ Maybe String
-> Maybe String
-> BasicCardContent
-> Maybe [BasicCardButton]
-> Msg 'MsgBasicCard
BasicCard Maybe String
mbTitle Maybe String
mbSubtitle BasicCardContent
content Maybe [BasicCardButton]
buttons

instance FromJSON (Msg 'MsgSuggestions) where
  parseJSON :: Value -> Parser (Msg 'MsgSuggestions)
parseJSON = String
-> (Object -> Parser (Msg 'MsgSuggestions))
-> Value
-> Parser (Msg 'MsgSuggestions)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"suggestions" ((Object -> Parser (Msg 'MsgSuggestions))
 -> Value -> Parser (Msg 'MsgSuggestions))
-> (Object -> Parser (Msg 'MsgSuggestions))
-> Value
-> Parser (Msg 'MsgSuggestions)
forall a b. (a -> b) -> a -> b
$ \Object
sgs -> do
    [Suggestion]
suggestions <- Object
sgs Object -> Text -> Parser [Suggestion]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"suggestions"
    Msg 'MsgSuggestions -> Parser (Msg 'MsgSuggestions)
forall (m :: * -> *) a. Monad m => a -> m a
return (Msg 'MsgSuggestions -> Parser (Msg 'MsgSuggestions))
-> Msg 'MsgSuggestions -> Parser (Msg 'MsgSuggestions)
forall a b. (a -> b) -> a -> b
$ [Suggestion] -> Msg 'MsgSuggestions
Suggestions [Suggestion]
suggestions

instance FromJSON (Msg 'MsgLinkOutSuggestion) where
  parseJSON :: Value -> Parser (Msg 'MsgLinkOutSuggestion)
parseJSON = String
-> (Object -> Parser (Msg 'MsgLinkOutSuggestion))
-> Value
-> Parser (Msg 'MsgLinkOutSuggestion)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"linkOutSuggestion" ((Object -> Parser (Msg 'MsgLinkOutSuggestion))
 -> Value -> Parser (Msg 'MsgLinkOutSuggestion))
-> (Object -> Parser (Msg 'MsgLinkOutSuggestion))
-> Value
-> Parser (Msg 'MsgLinkOutSuggestion)
forall a b. (a -> b) -> a -> b
$ \Object
los -> do
    String
uri <- Object
los Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"uri"
    String
destinationName <- Object
los Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"destination_name"
    Msg 'MsgLinkOutSuggestion -> Parser (Msg 'MsgLinkOutSuggestion)
forall (m :: * -> *) a. Monad m => a -> m a
return (Msg 'MsgLinkOutSuggestion -> Parser (Msg 'MsgLinkOutSuggestion))
-> Msg 'MsgLinkOutSuggestion -> Parser (Msg 'MsgLinkOutSuggestion)
forall a b. (a -> b) -> a -> b
$ String -> String -> Msg 'MsgLinkOutSuggestion
LinkOutSuggestion String
destinationName String
uri

instance FromJSON (Msg 'MsgListSelect) where
  parseJSON :: Value -> Parser (Msg 'MsgListSelect)
parseJSON = String
-> (Object -> Parser (Msg 'MsgListSelect))
-> Value
-> Parser (Msg 'MsgListSelect)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"listSelect" ((Object -> Parser (Msg 'MsgListSelect))
 -> Value -> Parser (Msg 'MsgListSelect))
-> (Object -> Parser (Msg 'MsgListSelect))
-> Value
-> Parser (Msg 'MsgListSelect)
forall a b. (a -> b) -> a -> b
$ \Object
ls -> do
    Maybe String
title <- Object
ls Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"title"
    [Item]
items <- Object
ls Object -> Text -> Parser [Item]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"items"
    Msg 'MsgListSelect -> Parser (Msg 'MsgListSelect)
forall (m :: * -> *) a. Monad m => a -> m a
return (Msg 'MsgListSelect -> Parser (Msg 'MsgListSelect))
-> Msg 'MsgListSelect -> Parser (Msg 'MsgListSelect)
forall a b. (a -> b) -> a -> b
$ Maybe String -> [Item] -> Msg 'MsgListSelect
ListSelect Maybe String
title [Item]
items

instance FromJSON (Msg 'MsgCarouselSelect) where
  parseJSON :: Value -> Parser (Msg 'MsgCarouselSelect)
parseJSON = String
-> (Object -> Parser (Msg 'MsgCarouselSelect))
-> Value
-> Parser (Msg 'MsgCarouselSelect)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"carouselSelect" ((Object -> Parser (Msg 'MsgCarouselSelect))
 -> Value -> Parser (Msg 'MsgCarouselSelect))
-> (Object -> Parser (Msg 'MsgCarouselSelect))
-> Value
-> Parser (Msg 'MsgCarouselSelect)
forall a b. (a -> b) -> a -> b
$ \Object
cs -> do
    [Item]
items <- Object
cs Object -> Text -> Parser [Item]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"items"
    Msg 'MsgCarouselSelect -> Parser (Msg 'MsgCarouselSelect)
forall (m :: * -> *) a. Monad m => a -> m a
return (Msg 'MsgCarouselSelect -> Parser (Msg 'MsgCarouselSelect))
-> Msg 'MsgCarouselSelect -> Parser (Msg 'MsgCarouselSelect)
forall a b. (a -> b) -> a -> b
$ [Item] -> Msg 'MsgCarouselSelect
CarouselSelect [Item]
items

instance ToJSON (Msg t) where
  toJSON :: Msg t -> Value
toJSON (Text Maybe [String]
mbText) = [Pair] -> Value
noNullObjects [ Text
"text" Text -> Maybe [String] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [String]
mbText ]
  toJSON (Image String
uri Maybe String
accesibilityText) =
    [Pair] -> Value
noNullObjects [ Text
"image_uri" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
uri
           , Text
"accessibility_text" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
accesibilityText ]
  toJSON (QuickReplies Maybe String
mbTitle [String]
quickReplies) =
    [Pair] -> Value
noNullObjects [ Text
"title" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
mbTitle
           , Text
"quick_replies" Text -> [String] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [String]
quickReplies ]
  toJSON (Card Maybe String
title Maybe String
subtitle Maybe String
imageUri Maybe [CardButton]
buttons) =
    [Pair] -> Value
noNullObjects [ Text
"card" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
noNullObjects [Text
"title" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
title
                              , Text
"subtitle" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
subtitle
                              , Text
"image_uri" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
imageUri
                              , Text
"buttons" Text -> Maybe [CardButton] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [CardButton]
buttons ] ]
  toJSON (SimpleResponses [SimpleResponse]
simpleResponses) =
    [Pair] -> Value
noNullObjects [ Text
"simpleResponses" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
noNullObjects [Text
"simpleResponses" Text -> [SimpleResponse] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [SimpleResponse]
simpleResponses ] ]
  toJSON (BasicCard Maybe String
mbTitle Maybe String
mbSubtitle BasicCardContent
content Maybe [BasicCardButton]
buttons) =
    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
mbTitle
                         , Text
"subtitle" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
mbSubtitle
                         , Text
"buttons" Text -> Maybe [BasicCardButton] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [BasicCardButton]
buttons ] Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> BasicCardContent -> Object
forall a. ToJSON a => a -> Object
toObject BasicCardContent
content
  toJSON (Suggestions [Suggestion]
xs) = [Pair] -> Value
noNullObjects [ Text
"suggestions" Text -> [Suggestion] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Suggestion]
xs ]
  toJSON (LinkOutSuggestion String
name String
uri) =
    [Pair] -> Value
noNullObjects [ Text
"destination_name" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
name, Text
"uri" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
uri ]
  toJSON (ListSelect Maybe String
mbTitle [Item]
items) =
    [Pair] -> Value
noNullObjects [ Text
"title" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
mbTitle
           , Text
"items" Text -> [Item] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Item]
items ]
  toJSON (CarouselSelect [Item]
items) = [Pair] -> Value
noNullObjects [ Text
"items" Text -> [Item] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Item]
items ]

-- | This type is used to wrap the messages under one type.
data Message where
  Message :: (Show (Msg t)) => Msg t -> Message

instance Show Message where
  show :: Message -> String
show (Message Msg t
o) = Msg t -> String
forall a. Show a => a -> String
show Msg t
o

instance ToJSON Message where
  toJSON :: Message -> Value
toJSON (Message bc :: Msg t
bc@BasicCard{}) = [Pair] -> Value
noNullObjects [ Text
"basicCard" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Msg t -> Value
forall a. ToJSON a => a -> Value
toJSON Msg t
bc ]
  toJSON (Message Msg t
o) = Msg t -> Value
forall a. ToJSON a => a -> Value
toJSON Msg t
o

instance Eq Message where
  == :: Message -> Message -> Bool
(==) (Message x :: Msg t
x@Text{}) (Message y :: Msg t
y@Text{}) = Msg t
x Msg t -> Msg t -> Bool
forall a. Eq a => a -> a -> Bool
== Msg t
Msg t
y
  (==) (Message x :: Msg t
x@Image{}) (Message y :: Msg t
y@Image{}) = Msg t
x Msg t -> Msg t -> Bool
forall a. Eq a => a -> a -> Bool
== Msg t
Msg t
y
  (==) (Message x :: Msg t
x@QuickReplies{}) (Message y :: Msg t
y@QuickReplies{}) = Msg t
x Msg t -> Msg t -> Bool
forall a. Eq a => a -> a -> Bool
== Msg t
Msg t
y
  (==) (Message x :: Msg t
x@Card{}) (Message y :: Msg t
y@Card{}) = Msg t
x Msg t -> Msg t -> Bool
forall a. Eq a => a -> a -> Bool
== Msg t
Msg t
y
  (==) (Message x :: Msg t
x@SimpleResponses{}) (Message y :: Msg t
y@SimpleResponses{}) = Msg t
x Msg t -> Msg t -> Bool
forall a. Eq a => a -> a -> Bool
== Msg t
Msg t
y
  (==) (Message x :: Msg t
x@BasicCard{}) (Message y :: Msg t
y@BasicCard{}) = Msg t
x Msg t -> Msg t -> Bool
forall a. Eq a => a -> a -> Bool
== Msg t
Msg t
y
  (==) (Message x :: Msg t
x@Suggestions{}) (Message y :: Msg t
y@Suggestions{}) = Msg t
x Msg t -> Msg t -> Bool
forall a. Eq a => a -> a -> Bool
== Msg t
Msg t
y
  (==) (Message x :: Msg t
x@LinkOutSuggestion{}) (Message y :: Msg t
y@LinkOutSuggestion{}) = Msg t
x Msg t -> Msg t -> Bool
forall a. Eq a => a -> a -> Bool
== Msg t
Msg t
y
  (==) (Message x :: Msg t
x@ListSelect{}) (Message y :: Msg t
y@ListSelect{}) = Msg t
x Msg t -> Msg t -> Bool
forall a. Eq a => a -> a -> Bool
== Msg t
Msg t
y
  (==) (Message x :: Msg t
x@CarouselSelect{}) (Message y :: Msg t
y@CarouselSelect{}) = Msg t
x Msg t -> Msg t -> Bool
forall a. Eq a => a -> a -> Bool
== Msg t
Msg t
y
  (==) Message
_ Message
_ = Bool
False

-- | An item in 'ListSelect' and 'CarouselSelect'.
data Item = Item
  { Item -> SelectItemInfo
iInfo :: SelectItemInfo -- ^ Additional information about this option
  , Item -> String
iTitle :: String -- ^ The title of the list item
  , Item -> Maybe String
iDescription :: Maybe String -- ^ The main text describing the item
  , Item -> Msg 'MsgImage
iImage :: Msg 'MsgImage -- ^ The image to display
  } deriving (Item -> Item -> Bool
(Item -> Item -> Bool) -> (Item -> Item -> Bool) -> Eq Item
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Item -> Item -> Bool
$c/= :: Item -> Item -> Bool
== :: Item -> Item -> Bool
$c== :: Item -> Item -> Bool
Eq, Int -> Item -> ShowS
[Item] -> ShowS
Item -> String
(Int -> Item -> ShowS)
-> (Item -> String) -> ([Item] -> ShowS) -> Show Item
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Item] -> ShowS
$cshowList :: [Item] -> ShowS
show :: Item -> String
$cshow :: Item -> String
showsPrec :: Int -> Item -> ShowS
$cshowsPrec :: Int -> Item -> ShowS
Show)

instance FromJSON Item where
    parseJSON :: Value -> Parser Item
parseJSON = String -> (Object -> Parser Item) -> Value -> Parser Item
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Item" ((Object -> Parser Item) -> Value -> Parser Item)
-> (Object -> Parser Item) -> Value -> Parser Item
forall a b. (a -> b) -> a -> b
$ \Object
i -> do
      SelectItemInfo
iInfo <- Object
i Object -> Text -> Parser SelectItemInfo
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"info"
      String
iTitle <- Object
i Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"title"
      Maybe String
iDescription <- Object
i Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"description"
      Msg 'MsgImage
iImage <- Object
i Object -> Text -> Parser (Msg 'MsgImage)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"image"
      Item -> Parser Item
forall (m :: * -> *) a. Monad m => a -> m a
return Item :: SelectItemInfo -> String -> Maybe String -> Msg 'MsgImage -> Item
Item{String
Maybe String
Msg 'MsgImage
SelectItemInfo
iImage :: Msg 'MsgImage
iDescription :: Maybe String
iTitle :: String
iInfo :: SelectItemInfo
iImage :: Msg 'MsgImage
iDescription :: Maybe String
iTitle :: String
iInfo :: SelectItemInfo
..}

instance ToJSON Item where
  toJSON :: Item -> Value
toJSON Item{String
Maybe String
Msg 'MsgImage
SelectItemInfo
iImage :: Msg 'MsgImage
iDescription :: Maybe String
iTitle :: String
iInfo :: SelectItemInfo
iImage :: Item -> Msg 'MsgImage
iDescription :: Item -> Maybe String
iTitle :: Item -> String
iInfo :: Item -> SelectItemInfo
..} =
    [Pair] -> Value
noNullObjects [ Text
"info" Text -> SelectItemInfo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SelectItemInfo
iInfo
           , Text
"title" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
iTitle
           , Text
"description" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
iDescription
           , Text
"image" Text -> Msg 'MsgImage -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Msg 'MsgImage
iImage ]