{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

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

This module contains types for Dialogflow webhook response. See the Dialogflow <https://cloud.google.com/dialogflow/docs/reference/rpc/google.cloud.dialogflow.v2#webhookresponse documentation>.
-}

module Dialogflow.V2.Fulfillment.Webhook.Response where

import Data.Aeson ( parseJSON
                  , toJSON
                  , withObject
                  , FromJSON
                  , ToJSON
                  , (.:)
                  , (.=) )
import Dialogflow.Util (noNullObjects)

import qualified Data.Map as M

import Dialogflow.V2.Fulfillment.Webhook.Request (Context)
import Dialogflow.V2.Fulfillment.Message

import qualified Dialogflow.V2.Fulfillment.Payload.Google as G

-- TODO: When this is included, no messages or payload is taken into account.
-- We gotta cover this.
-- | Makes the platform immediately invoke another DetectIntent call internally
-- with the specified event as input. When this field is set, Dialogflow ignores
-- the fulfillment_text, fulfillment_messages, and payload fields.
data EventInput =
  EventInput { EventInput -> String
eventInputName :: String
             , EventInput -> Maybe (Map String String)
eventInputParameters :: Maybe (M.Map String String)
             , EventInput -> String
eventInputLanguageCode :: String
             } deriving (EventInput -> EventInput -> Bool
(EventInput -> EventInput -> Bool)
-> (EventInput -> EventInput -> Bool) -> Eq EventInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventInput -> EventInput -> Bool
$c/= :: EventInput -> EventInput -> Bool
== :: EventInput -> EventInput -> Bool
$c== :: EventInput -> EventInput -> Bool
Eq, Int -> EventInput -> ShowS
[EventInput] -> ShowS
EventInput -> String
(Int -> EventInput -> ShowS)
-> (EventInput -> String)
-> ([EventInput] -> ShowS)
-> Show EventInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventInput] -> ShowS
$cshowList :: [EventInput] -> ShowS
show :: EventInput -> String
$cshow :: EventInput -> String
showsPrec :: Int -> EventInput -> ShowS
$cshowsPrec :: Int -> EventInput -> ShowS
Show)

instance FromJSON EventInput where
  parseJSON :: Value -> Parser EventInput
parseJSON = String
-> (Object -> Parser EventInput) -> Value -> Parser EventInput
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"eventInput" ((Object -> Parser EventInput) -> Value -> Parser EventInput)
-> (Object -> Parser EventInput) -> Value -> Parser EventInput
forall a b. (a -> b) -> a -> b
$ \Object
ei -> do
    String
eventInputName <- Object
ei Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
    Maybe (Map String String)
eventInputParameters <- Object
ei Object -> Text -> Parser (Maybe (Map String String))
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"parameters"
    String
eventInputLanguageCode <- Object
ei Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"language_code"
    EventInput -> Parser EventInput
forall (m :: * -> *) a. Monad m => a -> m a
return EventInput :: String -> Maybe (Map String String) -> String -> EventInput
EventInput{String
Maybe (Map String String)
eventInputLanguageCode :: String
eventInputParameters :: Maybe (Map String String)
eventInputName :: String
eventInputLanguageCode :: String
eventInputParameters :: Maybe (Map String String)
eventInputName :: String
..}

instance ToJSON EventInput where
  toJSON :: EventInput -> Value
toJSON EventInput{String
Maybe (Map String String)
eventInputLanguageCode :: String
eventInputParameters :: Maybe (Map String String)
eventInputName :: String
eventInputLanguageCode :: EventInput -> String
eventInputParameters :: EventInput -> Maybe (Map String String)
eventInputName :: EventInput -> String
..} =
    [Pair] -> Value
noNullObjects [ Text
"name" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
eventInputName
           , Text
"parameters" Text -> Maybe (Map String String) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe (Map String String)
eventInputParameters
           , Text
"language_code" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
eventInputLanguageCode ]

-- | The response message for a webhook call.
data WebhookResponse = WebhookResponse
  { WebhookResponse -> Maybe String
fulfillmentText :: Maybe String
  -- ^ The text to be shown on the screen
  , WebhookResponse -> Maybe [Message]
fulfillmentMessages :: Maybe [Message]
  -- ^ The collection of rich messages to present to the user
  , WebhookResponse -> Maybe String
source :: Maybe String
  -- ^ The webhook source
  , WebhookResponse -> Maybe GooglePayload
payload :: Maybe G.GooglePayload
  -- ^ Webhook payload
  , WebhookResponse -> Maybe [Context]
outputContexts :: Maybe [Context]
  -- ^ The collection of output contexts
  , WebhookResponse -> Maybe EventInput
followupEventInput :: Maybe EventInput
  -- ^ Makes the platform immediately invoke another sessions
  } deriving (WebhookResponse -> WebhookResponse -> Bool
(WebhookResponse -> WebhookResponse -> Bool)
-> (WebhookResponse -> WebhookResponse -> Bool)
-> Eq WebhookResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebhookResponse -> WebhookResponse -> Bool
$c/= :: WebhookResponse -> WebhookResponse -> Bool
== :: WebhookResponse -> WebhookResponse -> Bool
$c== :: WebhookResponse -> WebhookResponse -> Bool
Eq, Int -> WebhookResponse -> ShowS
[WebhookResponse] -> ShowS
WebhookResponse -> String
(Int -> WebhookResponse -> ShowS)
-> (WebhookResponse -> String)
-> ([WebhookResponse] -> ShowS)
-> Show WebhookResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebhookResponse] -> ShowS
$cshowList :: [WebhookResponse] -> ShowS
show :: WebhookResponse -> String
$cshow :: WebhookResponse -> String
showsPrec :: Int -> WebhookResponse -> ShowS
$cshowsPrec :: Int -> WebhookResponse -> ShowS
Show)

instance ToJSON WebhookResponse where
  toJSON :: WebhookResponse -> Value
toJSON WebhookResponse{Maybe String
Maybe [Message]
Maybe [Context]
Maybe GooglePayload
Maybe EventInput
followupEventInput :: Maybe EventInput
outputContexts :: Maybe [Context]
payload :: Maybe GooglePayload
source :: Maybe String
fulfillmentMessages :: Maybe [Message]
fulfillmentText :: Maybe String
followupEventInput :: WebhookResponse -> Maybe EventInput
outputContexts :: WebhookResponse -> Maybe [Context]
payload :: WebhookResponse -> Maybe GooglePayload
source :: WebhookResponse -> Maybe String
fulfillmentMessages :: WebhookResponse -> Maybe [Message]
fulfillmentText :: WebhookResponse -> Maybe String
..} =
    [Pair] -> Value
noNullObjects [ Text
"fulfillmentText" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
fulfillmentText
           , Text
"fulfillmentMessages" Text -> Maybe [Message] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [Message]
fulfillmentMessages
           , Text
"source" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
source
           , Text
"payload" Text -> Maybe GooglePayload -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe GooglePayload
payload
           , Text
"outputContexts" Text -> Maybe [Context] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [Context]
outputContexts
           , Text
"followupEventInput" Text -> Maybe EventInput -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe EventInput
followupEventInput ]