module NLP.LUIS (
query
, queryExc
, Credentials(..)
, Response
, responseQuery
, responseIntents
, responseEntities
, Intent
, intentType
, intentScore
, intentActions
, Action
, actionName
, actionTriggered
, actionParams
, Param
, paramName
, paramRequired
, paramValues
, ParamValue
, paramValueEntity
, paramValueType
, paramValueScore
, Entity
, entityType
, entityScore
, entityText
, entityStartIndex
, entityEndIndex
, LUISError(..)
) where
import Control.Exception (Exception(..), fromException, try)
import Data.Data (Data)
import Data.Maybe (isJust)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Control.Lens
import Data.Aeson
import Data.Text (Text)
import Data.Vector (Vector)
import Network.HTTP.Client (HttpException)
import Network.Wreq hiding (Response)
data ParamValue = ParamValue
{ _paramValueEntity :: !Text
, _paramValueType :: !Text
, _paramValueScore :: !Double
} deriving (Eq, Show, Read, Typeable, Data, Generic)
makeLenses ''ParamValue
instance FromJSON ParamValue where
parseJSON = withObject "param value" $ \o ->
ParamValue <$> o .: "entity" <*> o .: "type" <*> o .: "score"
data Param = Param { _paramName :: !Text
, _paramRequired :: !Bool
, _paramValues :: !(Maybe (Vector ParamValue))
} deriving (Eq, Show, Read, Typeable, Data, Generic)
makeLenses ''Param
instance FromJSON Param where
parseJSON = withObject "param" $ \o ->
Param <$> o .: "name" <*> o .: "required" <*> o .: "value"
data Action = Action { _actionName :: !Text
, _actionTriggered :: !Bool
, _actionParams :: !(Vector Param)
} deriving (Eq, Show, Read, Typeable, Data, Generic)
makeLenses ''Action
instance FromJSON Action where
parseJSON = withObject "action" $ \o ->
Action <$> o .: "name" <*> o .: "triggered" <*> o .: "parameters"
data Intent = Intent { _intentType :: !Text
, _intentScore :: !Double
, _intentActions :: !(Maybe (Vector Action))
} deriving (Eq, Show, Read, Typeable, Data, Generic)
makeLenses ''Intent
instance FromJSON Intent where
parseJSON = withObject "intent" $ \o ->
Intent <$> o .: "intent" <*> o .: "score" <*> o .: "actions"
data Entity = Entity { _entityText :: !Text
, _entityType :: !Text
, _entityStartIndex :: !Int
, _entityEndIndex :: !Int
, _entityScore :: !Double
} deriving (Eq, Show, Read, Typeable, Data, Generic)
makeLenses ''Entity
instance FromJSON Entity where
parseJSON = withObject "entity" $ \o -> do
_entityText <- o .: "entity"
_entityType <- o .: "type"
_entityStartIndex <- o .: "startIndex"
_entityEndIndex <- o .: "endIndex"
_entityScore <- o .: "score"
pure Entity{..}
data Response = Response { _responseQuery :: !Text
, _responseIntents :: !(Vector Intent)
, _responseEntities :: !(Vector Entity)
} deriving (Eq, Show, Read, Typeable, Data, Generic)
makeLenses ''Response
instance FromJSON Response where
parseJSON = withObject "luisResponse" $ \o ->
Response <$> o .: "query" <*> o .: "intents" <*> o .: "entities"
data LUISError = HttpError HttpException
| ResponseError JSONError
deriving (Show, Typeable, Generic)
instance Exception LUISError where
fromException e = if isJust he then he else je
where he = HttpError <$> fromException e
je = ResponseError <$> fromException e
data Credentials = Credentials
{ applicationId :: !Text
, subscriptionKey :: !Text
} deriving (Show, Read, Eq, Typeable, Data, Generic)
queryExc :: Credentials -> Text -> IO Response
queryExc Credentials{..} str = do
let opts = defaults & param "id" .~ [applicationId]
& param "subscription-key" .~ [subscriptionKey]
& param "q" .~ [str]
resp <- getWith opts "https://api.projectoxford.ai/luis/v1/application"
luisResp <- asJSON resp
return (luisResp ^. responseBody)
query :: Credentials -> Text -> IO (Either LUISError Response)
query creds str = try (queryExc creds str)