summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlexanderThiemann <>2017-05-28 00:38:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-05-28 00:38:00 (GMT)
commita11a694fed6efe57d608fc103fdd434cb28821cf (patch)
tree7d1c507bcfcfa24d379c4248b458e9c5f358abae
parentf27099f3a70d4172b16bbb964c57f1a225ed6a18 (diff)
version 0.1.1.0HEAD0.1.1.0master
-rw-r--r--bluemix-sdk.cabal15
-rw-r--r--src/Network/Bluemix/Http.hs5
-rw-r--r--src/Network/Watson/NaturalLanguage.hs30
3 files changed, 36 insertions, 14 deletions
diff --git a/bluemix-sdk.cabal b/bluemix-sdk.cabal
index a5df51a..f53b3e6 100644
--- a/bluemix-sdk.cabal
+++ b/bluemix-sdk.cabal
@@ -1,5 +1,5 @@
name: bluemix-sdk
-version: 0.1.0.0
+version: 0.1.1.0
synopsis: Bindings to Bluemix APIs
description: Bindings to Bluemix APIs
homepage: https://github.com/agrafix/bluemix-sdk#readme
@@ -18,12 +18,13 @@ library
exposed-modules: Network.Watson.NaturalLanguage,
Network.Bluemix.Auth
other-modules: Network.Bluemix.Http
- build-depends: base >= 4.7 && < 5,
- aeson,
- text,
- vector,
- http-types,
- http-client
+ build-depends: base >= 4.7 && < 5
+ , aeson
+ , text
+ , vector
+ , bytestring
+ , http-types
+ , http-client
default-language: Haskell2010
source-repository head
diff --git a/src/Network/Bluemix/Http.hs b/src/Network/Bluemix/Http.hs
index 16062d0..ed4f330 100644
--- a/src/Network/Bluemix/Http.hs
+++ b/src/Network/Bluemix/Http.hs
@@ -11,13 +11,14 @@ import Network.Bluemix.Auth
import Data.Aeson (eitherDecode, encode, ToJSON, FromJSON)
import Network.HTTP.Client
import Network.HTTP.Types
+import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
data Result r
= ROkay r
| RBadResponse !T.Text
- | RBadStatus !Status
+ | RBadStatus !Status !BSL.ByteString
deriving (Show, Eq)
runReq :: (ToJSON req, FromJSON r) => Method -> Auth a -> T.Text -> req -> IO (Result r)
@@ -41,4 +42,4 @@ runReq meth auth url requestObject =
case eitherDecode (responseBody response) of
Left errMsg -> pure (RBadResponse $ T.pack errMsg)
Right ok -> pure (ROkay ok)
- _ -> pure $ RBadStatus rs
+ _ -> pure $ RBadStatus rs (responseBody response)
diff --git a/src/Network/Watson/NaturalLanguage.hs b/src/Network/Watson/NaturalLanguage.hs
index ddb5f01..5f2fb56 100644
--- a/src/Network/Watson/NaturalLanguage.hs
+++ b/src/Network/Watson/NaturalLanguage.hs
@@ -21,9 +21,11 @@ where
import Network.Bluemix.Auth
import Network.Bluemix.Http
+import Control.Monad
import Data.Aeson hiding (Result(..))
import Data.Maybe
import qualified Data.Text as T
+import qualified Data.Traversable as T
import qualified Data.Vector as V
data QueryBody
@@ -50,6 +52,8 @@ data Query
, q_keywords :: !(Maybe KeywordOptions)
, q_categories :: !Bool
, q_concepts :: !(Maybe ConceptOptions)
+ , q_emotion :: !Bool
+ , q_sentiment :: !Bool
} deriving (Show, Eq)
instance ToJSON Query where
@@ -75,6 +79,12 @@ instance ToJSON Query where
[ "limit" .= co_limit cp
]
, if q_categories q then (Just $ "categories" .= object []) else Nothing
+ , if q_emotion q
+ then (Just $ "emotion" .= object ["document" .= True])
+ else Nothing
+ , if q_sentiment q
+ then (Just $ "sentiment" .= object ["document" .= True])
+ else Nothing
]
in object [body, "features" .= feats]
@@ -182,16 +192,26 @@ data Response
, r_keywords :: !(V.Vector Keyword)
, r_concepts :: !(V.Vector Concept)
, r_categories :: !(V.Vector Category)
+ , r_emotion :: !(Maybe Emotion)
+ , r_sentiment :: !(Maybe Sentiment)
} deriving (Show, Eq)
instance FromJSON Response where
parseJSON =
withObject "Response" $ \o ->
- Response
- <$> o .: "language"
- <*> o .:? "keywords" .!= V.empty
- <*> o .:? "concepts" .!= V.empty
- <*> o .:? "categories" .!= V.empty
+ do mEmotion <- o .:? "emotion"
+ mDocEmotion <-
+ T.mapM (flip (.:) "document" >=> flip (.:) "emotion") mEmotion
+ mSentiment <- o .:? "sentiment"
+ mDocSentiment <-
+ T.mapM (.: "document") mSentiment
+ Response
+ <$> o .: "language"
+ <*> o .:? "keywords" .!= V.empty
+ <*> o .:? "concepts" .!= V.empty
+ <*> o .:? "categories" .!= V.empty
+ <*> pure mDocEmotion
+ <*> pure mDocSentiment
data NaturalLanguage