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

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

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

module Dialogflow.V2.Fulfillment.Webhook.Request where

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

import qualified Data.Map as M

import Dialogflow.Util

-- | Represents an intent.
data Intent =
  Intent { Intent -> String
intentName :: String  -- ^ Intent name.
         , Intent -> String
displayName :: String -- ^ Display name for the intent.
         } deriving (Intent -> Intent -> Bool
(Intent -> Intent -> Bool)
-> (Intent -> Intent -> Bool) -> Eq Intent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Intent -> Intent -> Bool
$c/= :: Intent -> Intent -> Bool
== :: Intent -> Intent -> Bool
$c== :: Intent -> Intent -> Bool
Eq, Int -> Intent -> ShowS
[Intent] -> ShowS
Intent -> String
(Int -> Intent -> ShowS)
-> (Intent -> String) -> ([Intent] -> ShowS) -> Show Intent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Intent] -> ShowS
$cshowList :: [Intent] -> ShowS
show :: Intent -> String
$cshow :: Intent -> String
showsPrec :: Int -> Intent -> ShowS
$cshowsPrec :: Int -> Intent -> ShowS
Show)

instance FromJSON Intent where
  parseJSON :: Value -> Parser Intent
parseJSON = String -> (Object -> Parser Intent) -> Value -> Parser Intent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"intent" ((Object -> Parser Intent) -> Value -> Parser Intent)
-> (Object -> Parser Intent) -> Value -> Parser Intent
forall a b. (a -> b) -> a -> b
$ \Object
i -> do
    String
intentName <- Object
i Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
    String
displayName <- Object
i Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"displayName"
    Intent -> Parser Intent
forall (m :: * -> *) a. Monad m => a -> m a
return Intent :: String -> String -> Intent
Intent {String
displayName :: String
intentName :: String
displayName :: String
intentName :: String
..}

instance ToJSON Intent where
  toJSON :: Intent -> Value
toJSON Intent{String
displayName :: String
intentName :: String
displayName :: Intent -> String
intentName :: Intent -> String
..} =
    [Pair] -> Value
noNullObjects [ Text
"name" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
intentName
           , Text
"displayName" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
displayName ]

-- | Represents a context.
data Context =
  Context { Context -> String
ctxName :: String
          -- ^ The unique identifier of the context.
          , Context -> Maybe Int
ctxLifespanCount :: Maybe Int
          -- ^ The number of conversational query requests after which the
          -- context expires.
          , Context -> Maybe (Map String String)
ctxParameters :: Maybe (M.Map String String)
          -- ^ The collection of parameters associated with this context.
          } deriving (Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq, Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show)

instance FromJSON Context where
  parseJSON :: Value -> Parser Context
parseJSON = String -> (Object -> Parser Context) -> Value -> Parser Context
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"context" ((Object -> Parser Context) -> Value -> Parser Context)
-> (Object -> Parser Context) -> Value -> Parser Context
forall a b. (a -> b) -> a -> b
$ \Object
c -> do
    String
ctxName <- Object
c Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
    Maybe Int
ctxLifespanCount <- Object
c Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"lifespanCount"
    Maybe (Map String String)
ctxParameters <- Object
c Object -> Text -> Parser (Maybe (Map String String))
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"parameters"
    Context -> Parser Context
forall (m :: * -> *) a. Monad m => a -> m a
return Context :: String -> Maybe Int -> Maybe (Map String String) -> Context
Context{String
Maybe Int
Maybe (Map String String)
ctxParameters :: Maybe (Map String String)
ctxLifespanCount :: Maybe Int
ctxName :: String
ctxParameters :: Maybe (Map String String)
ctxLifespanCount :: Maybe Int
ctxName :: String
..}

instance ToJSON Context where
  toJSON :: Context -> Value
toJSON Context{String
Maybe Int
Maybe (Map String String)
ctxParameters :: Maybe (Map String String)
ctxLifespanCount :: Maybe Int
ctxName :: String
ctxParameters :: Context -> Maybe (Map String String)
ctxLifespanCount :: Context -> Maybe Int
ctxName :: Context -> String
..} =
    [Pair] -> Value
noNullObjects [ Text
"name" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
ctxName
           , Text
"lifespanCount" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Int
ctxLifespanCount
           , Text
"parameters" Text -> Maybe (Map String String) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe (Map String String)
ctxParameters ]

-- | Represents the result of conversational query or event processing.
data QueryResult =
  QueryResult { QueryResult -> String
queryText :: String
              -- ^ The original text of the query.
              , QueryResult -> Map String String
parameters :: M.Map String String
              -- ^ Consists of parameter_name:parameter_value pairs.
              , QueryResult -> Bool
allRequiredParamsPresent :: Bool
              -- ^ Set to false if required parameters are missing in query.
              , QueryResult -> Maybe String
fulfillmentText :: Maybe String
              -- ^ Text to be pronounced to the user or shown on the screen.
              , QueryResult -> Maybe [Context]
outputContexts :: Maybe [Context]
              -- ^ Collection of output contexts.
              , QueryResult -> Maybe Intent
intent :: Maybe Intent
              -- ^ The intent that matched the user's query.
              , QueryResult -> Maybe Float
intentDetectionConfidence :: Maybe Float
              -- ^ Matching score for the intent.
              , QueryResult -> Maybe (Map String String)
diagnosticInfo :: Maybe (M.Map String String)
              -- ^ Free-form diagnostic info.
              , QueryResult -> String
languageCode :: String
              -- ^ The language that was triggered during intent matching.
              } deriving (QueryResult -> QueryResult -> Bool
(QueryResult -> QueryResult -> Bool)
-> (QueryResult -> QueryResult -> Bool) -> Eq QueryResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryResult -> QueryResult -> Bool
$c/= :: QueryResult -> QueryResult -> Bool
== :: QueryResult -> QueryResult -> Bool
$c== :: QueryResult -> QueryResult -> Bool
Eq, Int -> QueryResult -> ShowS
[QueryResult] -> ShowS
QueryResult -> String
(Int -> QueryResult -> ShowS)
-> (QueryResult -> String)
-> ([QueryResult] -> ShowS)
-> Show QueryResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryResult] -> ShowS
$cshowList :: [QueryResult] -> ShowS
show :: QueryResult -> String
$cshow :: QueryResult -> String
showsPrec :: Int -> QueryResult -> ShowS
$cshowsPrec :: Int -> QueryResult -> ShowS
Show)

instance FromJSON QueryResult where
  parseJSON :: Value -> Parser QueryResult
parseJSON = String
-> (Object -> Parser QueryResult) -> Value -> Parser QueryResult
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"queryResult" ((Object -> Parser QueryResult) -> Value -> Parser QueryResult)
-> (Object -> Parser QueryResult) -> Value -> Parser QueryResult
forall a b. (a -> b) -> a -> b
$ \Object
qr -> do
    String
queryText <- Object
qr Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"queryText"
    Map String String
parameters <- Object
qr Object -> Text -> Parser (Map String String)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"parameters"
    Bool
allRequiredParamsPresent <- Object
qr Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"allRequiredParamsPresent"
    Maybe String
fulfillmentText <- Object
qr Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"fulfillmentText"
    Maybe [Context]
outputContexts <- Object
qr Object -> Text -> Parser (Maybe [Context])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"outputContexts"
    Maybe Intent
intent <- Object
qr Object -> Text -> Parser (Maybe Intent)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"intent"
    Maybe Float
intentDetectionConfidence <- Object
qr Object -> Text -> Parser (Maybe Float)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"intentDetectionConfidence"
    Maybe (Map String String)
diagnosticInfo <- Object
qr Object -> Text -> Parser (Maybe (Map String String))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"diagnosticInfo"
    String
languageCode <- Object
qr Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"languageCode"
    QueryResult -> Parser QueryResult
forall (m :: * -> *) a. Monad m => a -> m a
return QueryResult :: String
-> Map String String
-> Bool
-> Maybe String
-> Maybe [Context]
-> Maybe Intent
-> Maybe Float
-> Maybe (Map String String)
-> String
-> QueryResult
QueryResult{Bool
String
Maybe Float
Maybe String
Maybe [Context]
Maybe (Map String String)
Maybe Intent
Map String String
languageCode :: String
diagnosticInfo :: Maybe (Map String String)
intentDetectionConfidence :: Maybe Float
intent :: Maybe Intent
outputContexts :: Maybe [Context]
fulfillmentText :: Maybe String
allRequiredParamsPresent :: Bool
parameters :: Map String String
queryText :: String
languageCode :: String
diagnosticInfo :: Maybe (Map String String)
intentDetectionConfidence :: Maybe Float
intent :: Maybe Intent
outputContexts :: Maybe [Context]
fulfillmentText :: Maybe String
allRequiredParamsPresent :: Bool
parameters :: Map String String
queryText :: String
..}

instance ToJSON QueryResult where
  toJSON :: QueryResult -> Value
toJSON QueryResult{Bool
String
Maybe Float
Maybe String
Maybe [Context]
Maybe (Map String String)
Maybe Intent
Map String String
languageCode :: String
diagnosticInfo :: Maybe (Map String String)
intentDetectionConfidence :: Maybe Float
intent :: Maybe Intent
outputContexts :: Maybe [Context]
fulfillmentText :: Maybe String
allRequiredParamsPresent :: Bool
parameters :: Map String String
queryText :: String
languageCode :: QueryResult -> String
diagnosticInfo :: QueryResult -> Maybe (Map String String)
intentDetectionConfidence :: QueryResult -> Maybe Float
intent :: QueryResult -> Maybe Intent
outputContexts :: QueryResult -> Maybe [Context]
fulfillmentText :: QueryResult -> Maybe String
allRequiredParamsPresent :: QueryResult -> Bool
parameters :: QueryResult -> Map String String
queryText :: QueryResult -> String
..} =
    [Pair] -> Value
noNullObjects [ Text
"queryText" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
queryText
           , Text
"parameters" Text -> Map String String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Map String String
parameters
           , Text
"allRequiredParamsPresent" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
allRequiredParamsPresent
           , Text
"fulfillmentText" Text -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe String
fulfillmentText
           , Text
"outputContexts" Text -> Maybe [Context] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [Context]
outputContexts
           , Text
"intent" Text -> Maybe Intent -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Intent
intent
           , Text
"intentDetectionConfidence" Text -> Maybe Float -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Float
intentDetectionConfidence
           , Text
"diagnosticInfo" Text -> Maybe (Map String String) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe (Map String String)
diagnosticInfo
           , Text
"languageCode" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
languageCode ]

-- | The request message for a webhook call.
data WebhookRequest =
  WebhookRequest { WebhookRequest -> String
responseId :: String
                 -- ^ Unique id for request.
                 , WebhookRequest -> String
session :: String
                 -- ^ Unique session id.
                 , WebhookRequest -> QueryResult
queryResult :: QueryResult
                 -- ^ Result of the conversation query or event processing.
                 } deriving(WebhookRequest -> WebhookRequest -> Bool
(WebhookRequest -> WebhookRequest -> Bool)
-> (WebhookRequest -> WebhookRequest -> Bool) -> Eq WebhookRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebhookRequest -> WebhookRequest -> Bool
$c/= :: WebhookRequest -> WebhookRequest -> Bool
== :: WebhookRequest -> WebhookRequest -> Bool
$c== :: WebhookRequest -> WebhookRequest -> Bool
Eq, Int -> WebhookRequest -> ShowS
[WebhookRequest] -> ShowS
WebhookRequest -> String
(Int -> WebhookRequest -> ShowS)
-> (WebhookRequest -> String)
-> ([WebhookRequest] -> ShowS)
-> Show WebhookRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebhookRequest] -> ShowS
$cshowList :: [WebhookRequest] -> ShowS
show :: WebhookRequest -> String
$cshow :: WebhookRequest -> String
showsPrec :: Int -> WebhookRequest -> ShowS
$cshowsPrec :: Int -> WebhookRequest -> ShowS
Show)

instance FromJSON WebhookRequest where
  parseJSON :: Value -> Parser WebhookRequest
parseJSON = String
-> (Object -> Parser WebhookRequest)
-> Value
-> Parser WebhookRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"webhookRequest" ((Object -> Parser WebhookRequest)
 -> Value -> Parser WebhookRequest)
-> (Object -> Parser WebhookRequest)
-> Value
-> Parser WebhookRequest
forall a b. (a -> b) -> a -> b
$ \Object
wr -> do
    String
responseId <- Object
wr Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"responseId"
    String
session <- Object
wr Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"session"
    QueryResult
queryResult <- Object
wr Object -> Text -> Parser QueryResult
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"queryResult"
    WebhookRequest -> Parser WebhookRequest
forall (m :: * -> *) a. Monad m => a -> m a
return WebhookRequest :: String -> String -> QueryResult -> WebhookRequest
WebhookRequest{String
QueryResult
queryResult :: QueryResult
session :: String
responseId :: String
queryResult :: QueryResult
session :: String
responseId :: String
..}

instance ToJSON WebhookRequest where
  toJSON :: WebhookRequest -> Value
toJSON WebhookRequest{String
QueryResult
queryResult :: QueryResult
session :: String
responseId :: String
queryResult :: WebhookRequest -> QueryResult
session :: WebhookRequest -> String
responseId :: WebhookRequest -> String
..} =
    [Pair] -> Value
noNullObjects [ Text
"responseId" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
responseId
           , Text
"session" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
session
           , Text
"queryResult" Text -> QueryResult -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= QueryResult
queryResult ]

-- TODO: Check if it's possible to have multiple Contexts with the same name
-- or if there's an use-case for that, and update accordingly.
-- | Given a list of 'Context', find the value of a parameter of a context in
-- the list.
getContextParameter :: [Context] -- ^ The list of 'Context'.
                    -> String -- ^ The name of the 'Context'.
                    -> String -- ^ The name of the parameter.
                    -> Maybe String
getContextParameter :: [Context] -> String -> String -> Maybe String
getContextParameter [Context]
ctxs String
ctx String
param =
  case (Context -> Bool) -> [Context] -> [Context]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Context{String
Maybe Int
Maybe (Map String String)
ctxParameters :: Maybe (Map String String)
ctxLifespanCount :: Maybe Int
ctxName :: String
ctxParameters :: Context -> Maybe (Map String String)
ctxLifespanCount :: Context -> Maybe Int
ctxName :: Context -> String
..} -> String
ctxName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
ctx) [Context]
ctxs of
    (Context
x:[Context]
_) -> String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
param (Map String String -> Maybe String)
-> Maybe (Map String String) -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Context -> Maybe (Map String String)
ctxParameters Context
x
    [] -> Maybe String
forall a. Maybe a
Nothing