textocat-api (empty) → 0.1.0.0
raw patch · 10 files changed
+1033/−0 lines, 10 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, conduit, http-conduit, http-types, resourcet, tasty, tasty-hunit, text, textocat-api, transformers
Files
- LICENSE +202/−0
- Setup.hs +2/−0
- src/Data/Textocat.hs +153/−0
- src/Data/Textocat/Internal.hs +179/−0
- src/Network/Textocat.hs +6/−0
- src/Network/Textocat/Internal.hs +63/−0
- src/Network/Textocat/Monadic.hs +178/−0
- src/Network/Textocat/Simple.hs +108/−0
- test/SimpleIOTest.hs +74/−0
- textocat-api.cabal +68/−0
+ LICENSE view
@@ -0,0 +1,202 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright 2014-2015 Mansur Ziatdinov++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/Textocat.hs view
@@ -0,0 +1,153 @@+{- |+Module : Data.Textocat+Description : Types used in Textocat API+Copyright : (c) Mansur Ziatdinov, 2014--2015+License : Apache-2.0+Maintainer : mz+textocat-api@fosslabs.ru+Stability : experimental+Portability : POSIX++Almost all types represent JSON which is returned from API. 'Config' contains API key, 'ErrorMsg' is simple String with error description. 'ServiceStatus' represent service status++This module uses an <https://www.fpcomplete.com/user/commercial/content/designing-apis-for-extensibility approach to API design> described by Michael Snoyman.++If you really need implementation of all these types, use "Data.Textocat.Internal" module at your own risk+-}++module Data.Textocat (+ -- * API configuration+ Config+ , mkConfig+ -- * Error handling+ , ErrorMsg+ -- * Documents+ , Document+ , mkDocument+ , mkTaggedDocument+ , setTag+ , delTag+ -- * Batch+ , BatchID+ , BatchState (..)+ -- ** Status returned by API+ , BatchStatus+ , getBatchID+ , getBatchState+ -- ** Content+ , Batch+ , getBatchIds+ , getDocuments+ -- * Annotated document+ , AnnotatedDocument+ , getDocumentState+ , getDocumentTag+ , getEntities+ -- ** Document state+ , DocumentState (..)+ -- ** Entity categories+ , Category (..)+ -- ** Entity+ , Entity+ , getSpan+ , getOffsets+ , getCategory+ -- * Search results+ , SearchResult+ , getSearchQuery+ , getFoundDocuments+ -- * Service status+ , ServiceStatus (..)+ ) where++import Data.Textocat.Internal++import Control.Arrow+import Data.ByteString (ByteString)+import Data.Text (Text)++-- | Creates a @Config@ value from API key+mkConfig :: ByteString -- ^ API key+ -> Config+mkConfig key = Config key "http://api.textocat.com"++-- | Get batch identifier @BatchID@ from status returned by API+getBatchID :: BatchStatus -- ^ Status as returned by API+ -> BatchID+getBatchID = BatchID . bs_batchId++-- | Create a @Document@ without tag from text+mkDocument :: Text -- ^ Text+ -> Document+mkDocument t = Document t Nothing++-- | Create a tagged @Document@ from text and tag+mkTaggedDocument :: Text -- ^ Text+ -> Text -- ^ Tag+ -> Document+mkTaggedDocument text tag = Document text $ Just tag++-- | Replace or set a tag+setTag :: Text -- ^ Tag + -> Document -- ^ Document+ -> Document+setTag tag doc = doc { d_tag = Just tag }++-- | Delete tag+delTag :: Document -> Document+delTag doc = doc { d_tag = Nothing }++-- | Get batch status from request call result+getBatchState :: BatchStatus -- ^ Request call result+ -> BatchState+getBatchState = bs_status++-- | Get batch ids from retrieve call result+getBatchIds :: Batch -- ^ Batch+ -> [BatchID]+getBatchIds = b_batchIds++-- | Get annotated documents from retrieve call result+getDocuments :: Batch -- ^ Batch+ -> [AnnotatedDocument]+getDocuments = b_documents++-- | Get annotated document state+getDocumentState :: AnnotatedDocument -- ^ Document+ -> DocumentState+getDocumentState = ad_status++-- | Get annotated document tag+getDocumentTag :: AnnotatedDocument -- ^ Document+ -> Maybe Text+getDocumentTag = ad_tag++-- | Get entities from annotated document+getEntities :: AnnotatedDocument -- ^ Document+ -> [Entity]+getEntities = ad_entities++-- | Get entity span+getSpan :: Entity -- ^ Entity+ -> Text+getSpan = e_span++-- | Get pair of start and end offsets+getOffsets :: Entity -- ^ Entity+ -> (Int, Int)+getOffsets = e_beginOffset &&& e_endOffset++-- | Get entity category+getCategory :: Entity -- ^ Entity+ -> Category+getCategory = e_category++-- | Get search query+getSearchQuery :: SearchResult -- ^ Search call result+ -> Text+getSearchQuery = sr_searchQuery++-- | Get found documents+getFoundDocuments :: SearchResult -- ^ Search call result+ -> [AnnotatedDocument]+getFoundDocuments = sr_documents+
+ src/Data/Textocat/Internal.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Textocat.Internal where++import Data.Aeson+import Data.Aeson.Types+import Data.ByteString (ByteString)+import Data.Char+import qualified Data.Text as T+import Data.Text (Text)+import GHC.Generics++-- | Error message+type ErrorMsg = String++-- | API configuration. Currently only API key is saved+data Config = Config+ { apiKey :: ByteString -- ^ API key+ , hostName :: String -- ^ host name+ } deriving (Eq,Show)++-- | Document sent for analysis+data Document = Document+ { d_text :: Text -- ^ Text (less than 100 KB)+ , d_tag :: Maybe Text -- ^ Tag (say, user identifier of document)+ } deriving (Eq,Show,Generic)++documentOptions = defaultOptions+ { fieldLabelModifier = drop 2+ , constructorTagModifier = map toLower+ , omitNothingFields = True+ }++instance FromJSON Document where+ parseJSON = genericParseJSON documentOptions+instance ToJSON Document where+ toJSON = genericToJSON documentOptions++-- | Batch identifier (you get it after submitting documents)+newtype BatchID = BatchID+ { batch_id :: Text+ } deriving (Eq,Show,Read)++instance FromJSON BatchID where+ parseJSON (String t) = return $ BatchID t+ parseJSON _ = error "Expected string while reading status"+instance ToJSON BatchID where+ toJSON (BatchID x) = String x++-- | States of batch processing+data BatchState+ = FINISHED -- ^ Batch is ready for retrieving+ | IN_PROGRESS -- ^ Batch is being processed+ deriving (Eq,Show,Read)++instance FromJSON BatchState where+ parseJSON (String t) = return $ read $ T.unpack t+ parseJSON _ = error "Expected string while reading status"+instance ToJSON BatchState where+ toJSON x = String $ T.pack $ show x++-- | Status of batch+data BatchStatus = BatchStatus+ { bs_batchId :: Text -- ^ Batch ID+ , bs_status :: BatchState -- ^ Batch status+ } deriving (Eq,Show,Generic)++bsOptions = defaultOptions+ { fieldLabelModifier = drop 3+ , constructorTagModifier = map toLower+ }++instance FromJSON BatchStatus where+ parseJSON = genericParseJSON bsOptions+instance ToJSON BatchStatus where+ toJSON = genericToJSON bsOptions++-- | States of document processing+data DocumentState+ = SUCCESS+ | INPUT_ERROR+ | SERVICE_ERROR+ deriving (Eq,Show,Read)++instance FromJSON DocumentState where+ parseJSON (String t) = return $ read $ T.unpack t+ parseJSON _ = error "Expected string while reading status"+instance ToJSON DocumentState where+ toJSON x = String $ T.pack $ show x++-- | Entity category+data Category+ = PERSON+ | ORGANIZATION+ | GPE+ | LOCATION+ | FACILITY+ | TIME+ | MONEY+ deriving (Eq,Ord,Show,Read)++instance FromJSON Category where+ parseJSON (String t) = return $ read $ T.unpack t+ parseJSON _ = error "Expected string when reading category"+instance ToJSON Category where+ toJSON x = String $ T.pack $ show x++data Entity = Entity+ { e_span :: Text+ , e_beginOffset :: Int+ , e_endOffset :: Int+ , e_category :: Category+ } deriving (Eq,Show,Generic)++entityOptions = defaultOptions+ { fieldLabelModifier = drop 2+ , constructorTagModifier = map toLower+ }++instance FromJSON Entity where+ parseJSON = genericParseJSON entityOptions+instance ToJSON Entity where+ toJSON = genericToJSON entityOptions++data AnnotatedDocument = AnnotatedDocument+ { ad_status :: DocumentState+ , ad_tag :: Maybe Text+ , ad_entities :: [Entity]+ } deriving (Eq,Show,Generic)++adOptions = defaultOptions+ { fieldLabelModifier = drop 3+ , constructorTagModifier = map toLower+ , omitNothingFields = True+ }++instance FromJSON AnnotatedDocument where+ parseJSON = genericParseJSON adOptions+instance ToJSON AnnotatedDocument where+ toJSON = genericToJSON adOptions++data Batch = Batch+ { b_batchIds :: [BatchID]+ , b_documents :: [AnnotatedDocument]+ } deriving (Eq,Show,Generic)++batchOptions = defaultOptions+ { fieldLabelModifier = drop 2+ , constructorTagModifier = map toLower+ }++instance FromJSON Batch where+ parseJSON = genericParseJSON batchOptions+instance ToJSON Batch where+ toJSON = genericToJSON batchOptions++data SearchResult = SearchResult+ { sr_searchQuery :: Text+ , sr_documents :: [AnnotatedDocument]+ } deriving (Eq,Show,Generic)++srOptions = defaultOptions+ { fieldLabelModifier = drop 3+ , constructorTagModifier = map toLower+ , omitNothingFields = True+ }++instance FromJSON SearchResult where+ parseJSON = genericParseJSON srOptions+instance ToJSON SearchResult where+ toJSON = genericToJSON srOptions+ +data ServiceStatus+ = ServiceOK+ | ServiceUnavailable+ deriving (Eq,Show)+
+ src/Network/Textocat.hs view
@@ -0,0 +1,6 @@+module Network.Textocat+ ( module Network.Textocat.Simple+ ) where++import Network.Textocat.Simple+
+ src/Network/Textocat/Internal.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Textocat.Internal where++import Data.Textocat.Internal++import Control.Monad.Trans.Resource+import Data.Aeson+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy.Char8 as BS+import Data.Char+import Data.Conduit+import Data.Maybe+import qualified Data.Text as T+import Network.HTTP.Conduit+import Network.HTTP.Types++-- | Make call to API endpoint, send parameter and get answer+makeConn :: (FromJSON b)+ => Config -- ^ API config+ -> String -- ^ URL endpoint+ -> StdMethod -- ^ HTTP method+ -> B.ByteString -- ^ parameter name; @"body"@ means send in request body+ -> [B.ByteString] -- ^ parameter values+ -> IO (Either ErrorMsg b)+makeConn (Config apiKey urlHead) urlTail mtd param infos = do+ req' <- parseUrl $ urlHead ++ urlTail+ let params = [("auth_token", Just apiKey)] +++ (if param /= "body"+ then map (\info -> (param, Just info)) infos+ else [])+ body = if param == "body"+ then head infos+ else ""+ req = setQueryString params $+ req'+ { checkStatus = \_ _ _ ->+ Nothing+ , requestBody = RequestBodyBS body+ , method = renderStdMethod mtd+ , requestHeaders = [("Content-Type", "application/json")]+ }+ print req+ resp <- withManager $ httpLbs req+ print $ responseStatus resp+ -- TODO: insert response status handling here+ BS.putStrLn $ responseBody resp+ return $ eitherDecode $ responseBody resp++-- | Check service status. We cannot do it usual way by calling 'makeConn'+checkServiceStatus :: Config -- ^ Config+ -> IO ServiceStatus+checkServiceStatus (Config apiKey urlHead) = do+ req' <- parseUrl $ urlHead ++ "/status"+ let params = [("auth_token", Just apiKey)]+ req = setQueryString params $ req' { checkStatus = \_ _ _ -> Nothing+ , method = renderStdMethod GET+ , requestHeaders = [("Content-Type", "application/json")]}+ resp <- withManager $ httpLbs req+ return $ case statusCode $ responseStatus resp of+ 200 -> ServiceOK+ 503 -> ServiceUnavailable+
+ src/Network/Textocat/Monadic.hs view
@@ -0,0 +1,178 @@+{- |+Module : Network.Textocat.Monadic+Description : Monadic binding for Textocat API+Copyright : (c) Mansur Ziatdinov, 2014--2015+License : Apache-2.0+Maintainer : mz+textocat-api@fosslabs.ru+Stability : experimental+Portability : POSIX++There are two kind of functions in this module. Functions that have apostrophe+in their names send data to server every time you call them. Functions without+them call server only if necessary (e.g. you requested it)++This monadic interface is experimental. If you know how to improve it, please+contact author+-}+{-# LANGUAGE DeriveFunctor #-}++module Network.Textocat.Monadic+ ( -- * Monad wrappers+ -- ** General monad transformer+ TextocatM+ , runTextocatM+ -- ** Monad over IO+ , Textocat+ , runTextocat+ -- * API operations with explicit calls+ , queue'+ , request'+ , retrieve'+ , search'+ , status+ -- ** Helpers+ , wait'+ -- * API operations with implicit calls+ , queue+ , queue1+ , force+ , request+ , retrieve+ ) where++import Data.Textocat+import Network.Textocat.Simple++import Control.Applicative+import Control.Arrow+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Trans.RWS+import Data.ByteString (ByteString)+import Data.Either+import Data.Text (Text)++initialSt :: [Document]+initialSt = []++-- | TextocatM is a monad transformer to use Textocat API+-- over some monad @m@ and return result @a@+newtype TextocatM m a = TextocatM+ { unTextocatM :: RWST Config () [Document] m a+ } deriving (Functor)++instance (Functor m, Monad m) => Applicative (TextocatM m) where+ pure x = TextocatM $ pure x+ TextocatM f <*> TextocatM x = TextocatM $ f <*> x++instance (Functor m, MonadIO m) => Monad (TextocatM m) where+ return = pure+ TextocatM ma >>= f = TextocatM $ ma >>= unTextocatM . f++instance MonadTrans TextocatM where+ lift action = TextocatM $ lift action++instance (Functor m, MonadIO m) => MonadIO (TextocatM m) where+ liftIO = TextocatM . liftIO++type Textocat = TextocatM IO++-- | Executes TextocatM actions with given API key+runTextocatM :: (Functor m, MonadIO m)+ => ByteString -- ^ API key+ -> TextocatM m a -- ^ TextocatM action+ -> m a+runTextocatM apiKey ma = fmap fst $ evalRWST (unTextocatM ma) (mkConfig apiKey) initialSt++-- | Executes Textocat actions with given API key+runTextocat :: ByteString -- ^ API key+ -> Textocat a -- ^ Textocat action+ -> IO a+runTextocat = runTextocatM++-- | Run function that depends on 'Config' in TextocatM monad,+-- reading 'Config' from Reader+withConfig :: (Functor m, MonadIO m)+ => (Config -> b -> IO a) -- ^ Function that depends on Config and something else+ -> b -- ^ Something else+ -> TextocatM m a+withConfig f b = TextocatM $ ask >>= liftIO . flip f b++-- | Queues given documents. No requests go to server until 'force',+-- 'request' of 'retrieve' is called+queue :: (Functor m, MonadIO m)+ => [Document] -- ^ Documents to queue+ -> TextocatM m ()+queue docs = TextocatM $ modify (docs++)++-- | Queues single document. No requests go to server until 'force',+-- 'request' of 'retrieve' is called+queue1 :: (Functor m, MonadIO m)+ => Document -- ^ Document to queue+ -> TextocatM m ()+queue1 doc = TextocatM $ modify (doc:)++-- | Queues documents. Actually, makes call to 'entityQueue' with+-- collections divided by 50 documents at most+queue' :: (Functor m, MonadIO m) => [Document] -> TextocatM m [Either ErrorMsg BatchStatus]+queue' docs | null docs = return []+ | length docs <= 50 = fmap pure $ withConfig entityQueue docs+ | otherwise = do+ let (d,rest) = splitAt 50 docs+ b <- withConfig entityQueue d+ fmap (b:) $ queue' rest++-- | Actually sends documents that were added by 'queue' and 'queue1' calls+-- to the API server.+-- If there are more than 50 documents, they will be sent in several calls,+-- each call will have 50 document at most (API limitation)+force :: (Functor m, MonadIO m) => TextocatM m [Either ErrorMsg BatchStatus]+force = TextocatM $ get >>= unTextocatM . queue'++-- | Requests batch status+request' :: (Functor m, MonadIO m)+ => BatchID -- ^ Batch+ -> TextocatM m (Either ErrorMsg BatchStatus)+request' = withConfig entityRequest++-- | Retrieves batches+retrieve' :: (Functor m, MonadIO m)+ => [BatchID] -- ^ Batches+ -> TextocatM m (Either ErrorMsg Batch)+retrieve' = withConfig entityRetrieve++-- | Search all collections+search' :: (Functor m, MonadIO m)+ => Text -- ^ Search query+ -> TextocatM m (Either ErrorMsg SearchResult)+search' = withConfig entitySearch++-- | Waits while batch processing is finished+wait' :: (Functor m, MonadIO m)+ => BatchID+ -> TextocatM m ()+wait' = withConfig waitForFinished++-- | Check service status+status :: (Functor m, MonadIO m) => TextocatM m ServiceStatus+status = TextocatM $ ask >>= liftIO . serviceStatus++-- | Request all documents that were added by 'queue' and 'queue1' calls.+-- Can create several batches, if there are more than 50 documents+request :: (Functor m, MonadIO m) => TextocatM m [Either ErrorMsg BatchStatus]+request = force >>= mapM makeRequest+ where makeRequest (Left error) = return $ Left error+ makeRequest (Right batchStatus) = request' $ getBatchID batchStatus++-- | Retrieve all documents that were added by 'queue' and 'queue1' calls.+-- Can create several batches, if there are more than 50 documents.+-- Blocks until processing of all batches is finished+retrieve :: (Functor m, MonadIO m) => TextocatM m [Either ErrorMsg Batch]+retrieve = request >>= mapM makeWait >>= uncurry (liftM2 (++)) . ret+ where+ ret = (return . map Left *** fmap pure . retrieve') . partitionEithers+ makeWait (Left error) = return $+ Left error+ makeWait (Right batchStatus) = let bId = getBatchID batchStatus+ in wait' bId >> return (Right bId)
+ src/Network/Textocat/Simple.hs view
@@ -0,0 +1,108 @@+{- |+Module : Network.Textocat.Simple+Description : Simple binding for Textocat API+Copyright : (c) Mansur Ziatdinov, 2014--2015+License : Apache-2.0+Maintainer : mz+textocat-api@fosslabs.ru+Stability : experimental+Portability : POSIX++Functions in this module are in one-to-one correspondence with API calls.+However, there are two helpers which can help in your application++You have to pass 'Config' everywhere. If you think that it is inconvenient,+you can use "Network.Textocat.Monadic" instead. However, monadic interface+is experimental+-}+{-# LANGUAGE OverloadedStrings #-}++module Network.Textocat.Simple (+ -- * Entity API calls+ entityQueue+ , entityRequest+ , entityRetrieve+ , entitySearch+ -- * Status API call+ , serviceStatus+ -- * Helper functions+ , waitForFinished+ , queueRetrieve+ ) where++import Data.Textocat+import Data.Textocat.Internal+import Network.Textocat.Internal++import Control.Applicative+import Control.Concurrent+import Data.Aeson+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy.Char8 as BS+import Data.Text (Text)+import qualified Data.Text.Encoding as E+import Network.HTTP.Types++-- | Convert 'BatchID' to ByteString+fromBatchId :: BatchID -- ^ BatchID+ -> B.ByteString+fromBatchId = E.encodeUtf8 . batch_id++-- | Queue documents+entityQueue :: Config -- ^ 'Config'+ -> [Document] -- ^ List of documents, should be less than 50+ -> IO (Either ErrorMsg BatchStatus)+entityQueue cfg = makeConn cfg "/entity/queue" POST "body" . pure . BS.toStrict . encode++-- | Request status of batch+entityRequest :: Config -- ^ @Config@+ -> BatchID -- ^ Batch ID to request+ -> IO (Either ErrorMsg BatchStatus)+entityRequest cfg = makeConn cfg "/entity/request" GET "batch_id" . pure . fromBatchId++-- | Retrieve documents from finished batches+entityRetrieve :: Config -- ^ @Config@+ -> [BatchID] -- ^ Batches to retrieve+ -> IO (Either ErrorMsg Batch)+entityRetrieve cfg = makeConn cfg "/entity/retrieve" GET "batch_id" . map fromBatchId++-- | Search text in all documents in collection+entitySearch :: Config -- ^ @Config@+ -> Text -- ^ Search query+ -> IO (Either ErrorMsg SearchResult)+entitySearch cfg = makeConn cfg "/entity/search" GET "search_query" . pure . E.encodeUtf8++-- * Helpers++-- | Blocks until batch is finished. Repeats every 0.1 sec.+waitForFinished :: Config -- ^ Config+ -> BatchID -- ^ Batch+ -> IO ()+waitForFinished cfg batch = do+ mtres <- entityRequest cfg batch+ case mtres of+ Left err -> error $ "Something went wrong: " ++ err+ Right tres -> let status = bs_status tres+ in if status == FINISHED+ then return ()+ else do+ threadDelay 100000+ waitForFinished cfg batch++-- | Queue documents and wait until they are finished. Returns all entities+queueRetrieve :: Config -- ^ Config+ -> [Document] -- ^ Documents+ -> IO [[Entity]]+queueRetrieve cfg docs = do+ ebatch <- entityQueue cfg docs+ case ebatch of+ Left err -> return []+ Right batch -> do+ let id = getBatchID batch+ waitForFinished cfg id+ fmap (either (const []) (map ad_entities . b_documents)) $ entityRetrieve cfg [id]++-- | Check status of service+serviceStatus :: Config -- ^ Config+ -> IO ServiceStatus+serviceStatus cfg = checkServiceStatus cfg+
+ test/SimpleIOTest.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import System.Exit+import Test.Tasty+import Test.Tasty.HUnit++import Data.Textocat+import Network.Textocat.Simple++import Data.Either++cfg = mkConfig "API-KEY"++-- | We cannot test too much actually, and we don't need to.+-- Haskell takes care about types. All we need is to test that+-- Textocat API is consistent with implemented Read/FromJSON+-- and Show/ToJSON instances+main :: IO ()+main = defaultMain tests++tests = testGroup "Textocat API"+ [ serviceStatusTest+ , workflowTest+ ]++serviceStatusTest = testCase "Textocat Status 200" $ do+ status <- serviceStatus cfg+ status @?= ServiceOK++workflowTest = testCaseSteps "Test workflow" $ \step -> do+ step "Queue documents"+ ebs1 <- entityQueue cfg docs+ assertBool "Batch was not queued" $ isRight ebs1+ let Right bs1 = ebs1++ step "Request status"+ ebs2 <- entityRequest cfg $ getBatchID bs1+ assertBool "Batch was not requested" $ isRight ebs2+ let Right bs2 = ebs2+ assertEqual "Request returned other Batch" (getBatchID bs2) (getBatchID bs1)++ step "Wait until finished"+ waitForFinished cfg $ getBatchID bs2++ step "Retrieve documents"+ -- we retrieve both bs1 and bs2 to test whether API works correctly+ -- with several documents+ eres <- entityRetrieve cfg $ map getBatchID [bs1, bs2]+ assertBool "Batch was not retrieved" $ isRight eres+ let Right res = eres+ ads = getDocuments res++ step "Check entities retrieved"+ -- cannot check. There are no standard examples with known categories++ step "Search documents"+ efound <- entitySearch cfg "Путин"+ assertBool "Search failed" $ isRight efound+ let Right found = efound+ assertBool "We found nothing" $ not $ null $ getFoundDocuments found+ ++docs = map (\t -> mkTaggedDocument t "test")+ [ "Путин"+ , "ООО \"Рога и копыта\""+ , "Уганда"+ , "Таганрог"+ , "Мордор" -- FACILITY???+ , "прошлое лето"+ , "100500 долларов"+ ]+
+ textocat-api.cabal view
@@ -0,0 +1,68 @@+-- Initial textocat-api.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: textocat-api+version: 0.1.0.0+synopsis: Unofficial Haskell SDK for Textocat API -- http://textocat.com+description: Unofficial Haskell SDK for Textocat API -- http://textocat.com+ .+ Textocat is "catalyst of text analytics". It focuses on Russian texts, mainly news+homepage: https://github.com/gltronred/textocat-api-haskell+license: Apache-2.0+license-file: LICENSE+author: Mansur Ziatdinov+maintainer: mz@fosslabs.ru+copyright: Copyright 2015 Mansur Ziatdinov+category: API, Network, Natural Language Processing+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++library+ exposed-modules: Data.Textocat+ , Network.Textocat+ , Network.Textocat.Simple+ , Network.Textocat.Monadic+ , Data.Textocat.Internal+ , Network.Textocat.Internal+ -- other-modules:+ -- other-extensions: + build-depends: base >=4.7 && <4.8+ , aeson >=0.8 && <0.9+ , bytestring >=0.10 && <0.11+ , conduit >=1.2 && <1.3+ , http-conduit >=2.1 && <2.2+ , http-types >=0.8 && <0.9+ , resourcet >=1.1 && <1.2+ , text >=1.2 && <1.3+ , transformers >=0.4 && <0.5+ hs-source-dirs: src+ default-language: Haskell2010++test-suite simple-io-test+ type: exitcode-stdio-1.0+ hs-source-dirs: src, test+ build-depends: base >=4.7 && <4.8+ , textocat-api+ , tasty >=0.10 && <0.11+ , tasty-hunit >=0.9 && <0.10+ , aeson >=0.8 && <0.9+ , bytestring >=0.10 && <0.11+ , conduit >=1.2 && <1.3+ , http-conduit >=2.1 && <2.2+ , http-types >=0.8 && <0.9+ , resourcet >=1.1 && <1.2+ , text >=1.2 && <1.3+ , transformers >=0.4 && <0.5+ main-is: SimpleIOTest.hs+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/gltronred/textocat-api-haskell++source-repository this+ type: git+ location: git://github.com/gltronred/textocat-api-haskell.git+ tag: 0.1+