[API] External API Pubmed connected.

src/Gargantext/API/Corpus/New.hs

@@ -24,19 +24,21 @@ New corpus means either:
 module Gargantext.API.Corpus.New
       where
 
+import Control.Monad.IO.Class (liftIO)
 import Data.Aeson.TH (deriveJSON)
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
-import Gargantext.Core (Lang(..))
 import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Database.Flow (flowCorpusSearchInDatabase)
 import Gargantext.Database.Types.Node (CorpusId)
+import Gargantext.Text.Terms (TermType(..))
 import Gargantext.Prelude
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
-import Gargantext.Database.Flow (FlowCmdM)
+import Gargantext.Core (Lang(..))
+import Gargantext.Database.Flow (FlowCmdM, flowCorpus)
 import qualified Gargantext.Text.Corpus.API as API
 import Gargantext.Database.Types.Node (UserId)
 
@@ -67,12 +69,15 @@ type Api = Summary "New Corpus endpoint"
         :<|> Get '[JSON] ApiInfo
 
 -- | TODO manage several apis
-api :: FlowCmdM env err m => Query -> m CorpusId
+api :: (FlowCmdM env err m) => Query -> m CorpusId
 api (Query q _ as) = do
   cId <- case head as of
     Nothing      -> flowCorpusSearchInDatabase "user1" EN q
     Just API.All -> flowCorpusSearchInDatabase "user1" EN q
-    Just _   -> undefined
+    Just a   -> do
+      docs <- liftIO $ API.get a q Nothing
+      cId' <- flowCorpus "user1" q (Multi EN) [docs]
+      pure cId'
 
   pure cId
 

src/Gargantext/Core/Flow.hs

@@ -15,7 +15,7 @@ Portability : POSIX
 
 module Gargantext.Core.Flow where
 
-import Control.Lens ((^.), view, Lens', _Just)
+import Control.Lens (Lens')
 import Data.Map (Map)
 import Data.Text (Text)
 import Gargantext.Text.Terms (TermType)
@@ -25,7 +25,7 @@ import Gargantext.Core.Types.Main (HashId)
 import Gargantext.Database.Types.Node -- (HyperdataDocument(..))
 import Gargantext.Database.Node.Contact -- (HyperdataContact(..))
 import Gargantext.Database.Node.Document.Insert (AddUniqId, InsertDb)
-import Gargantext.Database.Utils (Cmd, CmdM)
+import Gargantext.Database.Utils (Cmd)
 
 type FlowCorpus a = ( AddUniqId      a
                     , UniqId         a

src/Gargantext/Database/Flow.hs

@@ -110,7 +110,6 @@ flowCorpusApi u n tt l q = do
 
 ------------------------------------------------------------------------
 
-
 flowAnnuaire :: FlowCmdM env ServantErr m 
              => Username -> CorpusName -> (TermType Lang) -> FilePath -> m AnnuaireId
 flowAnnuaire u n l filePath = do
@@ -151,25 +150,33 @@ flowCorpusSearchInDatabase u la q = do
   flowCorpusUser la u q (Nothing :: Maybe HyperdataCorpus) ids
 
 
-flowCorpusSearchInDatabase' :: FlowCmdM env ServantErr m
+flowCorpusSearchInDatabaseApi :: FlowCmdM env ServantErr m
           => Username -> Lang -> Text -> m CorpusId
-flowCorpusSearchInDatabase' u la q = do
+flowCorpusSearchInDatabaseApi u la q = do
   (_masterUserId, _masterRootId, cId) <- getOrMkRootWithCorpus userMaster "" (Nothing :: Maybe HyperdataCorpus)
   ids <-  map fst <$> searchInDatabase cId (stemIt q)
   flowCorpusUser la u q (Nothing :: Maybe HyperdataCorpus) ids
 
 ------------------------------------------------------------------------
+-- | TODO improve the needed type to create/update a corpus
+data UserInfo = Username Text
+              | UserId   NodeId
+data CorpusInfo = CorpusName Lang Text
+                | CorpusId   Lang NodeId
+
 
-flow :: (FlowCmdM env ServantErr m, FlowCorpus a, MkCorpus c)
+flow :: (FlowCmdM env err m, FlowCorpus a, MkCorpus c)
      => Maybe c -> Username -> CorpusName -> TermType Lang -> [[a]] -> m CorpusId
 flow c u cn la docs = do
   ids <- mapM (insertMasterDocs c la ) docs
   flowCorpusUser (la ^. tt_lang) u cn c (concat ids)
 
-flowCorpus :: (FlowCmdM env ServantErr m, FlowCorpus a)
+flowCorpus :: (FlowCmdM env err m, FlowCorpus a)
      => Username -> CorpusName -> TermType Lang -> [[a]] -> m CorpusId
 flowCorpus = flow (Nothing :: Maybe HyperdataCorpus)
 
+------------------------------------------------------------------------
+
 
 flowCorpusUser :: (FlowCmdM env err m, MkCorpus c)
                => Lang -> Username -> CorpusName -> Maybe c -> [NodeId] -> m CorpusId
@@ -198,7 +205,7 @@ flowCorpusUser l userName corpusName ctype ids = do
   pure userCorpusId
 
 
-insertMasterDocs :: ( FlowCmdM env ServantErr m
+insertMasterDocs :: ( FlowCmdM env err m
                     , FlowCorpus a
                     , MkCorpus   c
                     )

src/Gargantext/Text/Corpus/API.hs

@@ -18,18 +18,19 @@ module Gargantext.Text.Corpus.API
 
 import GHC.Generics (Generic)
 import Data.Aeson
+import Data.Maybe
 import Data.Text (Text)
 import Gargantext.Prelude
 import Gargantext.Core (Lang(..))
-import Gargantext.Core.Flow (FlowCorpus)
-import Gargantext.Database.Types.Node (HyperdataDocument)
+import Gargantext.Database.Types.Node (HyperdataDocument(..))
 import Test.QuickCheck.Arbitrary
 import Test.QuickCheck (elements)
 import Data.Swagger
+import qualified Data.Text as Text
 
 import qualified PUBMED as PubMed
-import qualified PUBMED.Parser as Doc (PubMed)
-import qualified Gargantext.Text.Corpus.API.Isidore as Isidore
+import qualified PUBMED.Parser as Doc
+--import qualified Gargantext.Text.Corpus.API.Isidore as Isidore
 
 data ExternalAPIs = All
                   | PubMed
@@ -53,10 +54,41 @@ instance ToSchema ExternalAPIs
 type Query = Text
 type Limit = PubMed.Limit
 
-get :: FlowCorpus a => ExternalAPIs -> Query -> Maybe Limit -> IO [a]
+get :: ExternalAPIs -> Query -> Maybe Limit -> IO [HyperdataDocument]
 get PubMed q l = either (\e -> panic $ "CRAWL: PubMed" <> e) (map (toDoc EN)) <$> PubMed.crawler q l
 get _ _ _ = undefined
 
-toDoc :: FlowCorpus a => Lang -> Doc.PubMed -> a
-toDoc = undefined
+toDoc :: Lang -> Doc.PubMed -> HyperdataDocument
+toDoc l (Doc.PubMed (Doc.PubMedArticle t j as aus)
+                    (Doc.PubMedDate a y m d)
+          ) = HyperdataDocument (Just "PubMed")
+                                 Nothing
+                                 Nothing
+                                 Nothing
+                                 Nothing
+                                 Nothing
+                                 t
+                                 (authors aus)
+                                 Nothing
+                                 j
+                                 (abstract as)
+                                 (Just $ Text.pack $ show a)
+                                 (Just $ fromIntegral y)
+                                 (Just m)
+                                 (Just d)
+                                 Nothing
+                                 Nothing
+                                 Nothing
+                                 (Just $ (Text.pack . show) l)
+      where
+        authors :: Maybe [Doc.Author] -> Maybe Text
+        authors aus' = case aus' of
+            Nothing -> Nothing
+            Just au -> Just $ (Text.intercalate ", ") $ catMaybes $ map Doc.foreName au
+
+        abstract :: Maybe [Text] -> Maybe Text
+        abstract as' = fmap (Text.intercalate ", ") as'
+
+
+
 

src/Gargantext/Text/Corpus/API/Isidore.hs

@@ -92,3 +92,11 @@ isidoreToDoc l (IsidoreDoc t a d u s as) = do
                  (Just $ (Text.pack . show) l)
 
 
+
+
+
+
+
+
+
+