[FEAT] Graph Multipartite connected, need to change the node shape in Graph and tests
[gargantext.git] / src / Gargantext / Core / Text / Corpus / API.hs
index bed64cc35fc34ddfcffd73d6846563735e2e0217..27efc4d0bf6230e17fb7943b01ab31212dd5735f 100644 (file)
@@ -9,40 +9,48 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE InstanceSigs      #-}
-
 module Gargantext.Core.Text.Corpus.API
   ( ExternalAPIs(..)
   , Query
   , Limit
   , get
   , externalAPIs
-  )
-    where
+  ) where
 
+import Conduit
+import Data.Either (Either(..))
 import Data.Maybe
 import Gargantext.API.Admin.Orchestrator.Types (ExternalAPIs(..), externalAPIs)
 import Gargantext.Core (Lang(..))
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
 import Gargantext.Prelude
+import qualified Gargantext.Core.Text.Corpus.API.Arxiv   as Arxiv
 import qualified Gargantext.Core.Text.Corpus.API.Hal     as HAL
 import qualified Gargantext.Core.Text.Corpus.API.Isidore as ISIDORE
 import qualified Gargantext.Core.Text.Corpus.API.Istex   as ISTEX
 import qualified Gargantext.Core.Text.Corpus.API.Pubmed  as PUBMED
+import Servant.Client (ClientError)
 
 -- | Get External API metadata main function
 get :: ExternalAPIs
     -> Lang
     -> Query
     -> Maybe Limit
-    -> IO [HyperdataDocument]
-get PubMed  _la q l = PUBMED.get   q l -- EN only by default
-get HAL      la q l = HAL.get   la q l
-get IsTex    la q l = ISTEX.get la q l
-get Isidore  la q l = ISIDORE.get la (fromIntegral <$> l) (Just q) Nothing
+    -- -> IO [HyperdataDocument]
+    -> IO (Either ClientError (Maybe Integer, ConduitT () HyperdataDocument IO ()))
+get PubMed  _la q limit = PUBMED.get q limit
+  --docs <- PUBMED.get   q default_limit -- EN only by default
+  --pure (Just $ fromIntegral $ length docs, yieldMany docs)
+get Arxiv    la q limit = Arxiv.get la q (fromIntegral <$> limit)
+get HAL      la q limit = HAL.getC  la q limit
+get IsTex    la q limit = do
+  docs <- ISTEX.get la q limit
+  pure $ Right (Just $ fromIntegral $ length docs, yieldMany docs)
+get Isidore  la q limit = do
+  docs <- ISIDORE.get la (fromIntegral <$> limit) (Just q) Nothing
+  pure $ Right (Just $ fromIntegral $ length docs, yieldMany docs)
 get _        _  _ _ = undefined
 
 -- | Some Sugar for the documentation
 type Query = PUBMED.Query
 type Limit = PUBMED.Limit
-