diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Micxjo Funkcio (c) 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Micxjo Funkcio nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/luis-client.cabal b/luis-client.cabal new file mode 100644 --- /dev/null +++ b/luis-client.cabal @@ -0,0 +1,34 @@ +name: luis-client +version: 0.0.1 +cabal-version: >=1.10 +build-type: Simple +license: BSD3 +license-file: LICENSE +copyright: (c) 2016 Micxjo Funkcio +maintainer: Micxjo Funkcio +homepage: https://github.com/micxjo/hs-luis-client +synopsis: An unofficial client for the LUIS NLP service. +description: + Please see README.md +category: Natural Language Processing, Web +author: Micxjo Funkcio + +source-repository head + type: git + location: https://github.com/micxjo/hs-luis-client + +library + exposed-modules: + NLP.LUIS + build-depends: + base >=4.7 && <5, + wreq >=0.4.1.0 && <0.5, + http-client >=0.4.27 && <0.5, + aeson >=0.9.0.1 && <0.10, + lens ==4.13.*, + text >=1.2.2.1 && <1.3, + vector >=0.11.0.0 && <0.12 + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall -fwarn-incomplete-uni-patterns -fwarn-tabs + diff --git a/src/NLP/LUIS.hs b/src/NLP/LUIS.hs new file mode 100644 --- /dev/null +++ b/src/NLP/LUIS.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} +{-| +Module : NLP.LUIS +Description : An unofficial client for the LUIS NLP service. +Copyright : (c) 2016 Micxjo Funkcio +License : BSD3 +Maintainer : micxjo@fastmail.com +Stability : experimental +-} +module NLP.LUIS ( -- * Querying + query + , queryExc + , Credentials(..) + -- * Response Type + , Response + , responseQuery + , responseIntents + , responseEntities + -- * Intent Type + , Intent + , intentType + , intentScore + -- * Entity Type + , Entity + , entityType + , entityScore + , entityText + , entityStartIndex + , entityEndIndex + -- * Errors + , 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 Intent = Intent { _intentType :: !Text + , _intentScore :: !Double + } deriving (Eq, Show, Read, Typeable, Data, Generic) + +makeLenses ''Intent + +instance FromJSON Intent where + parseJSON = withObject "intent" $ \o -> + Intent <$> o .: "intent" <*> o .: "score" + +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 + +-- | Application credentials for a LUIS model. +data Credentials = Credentials + { applicationId :: !Text + , subscriptionKey :: !Text + } deriving (Show, Read, Eq, Typeable, Data, Generic) + +-- | Query a LUIS model. An 'HttpException' or 'JSONError' may be thrown. +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 a LUIS model. +query :: Credentials -> Text -> IO (Either LUISError Response) +query creds str = try (queryExc creds str)