[FACTO] Type Class and some Instances : Flow Corpus.

package.yaml

@@ -48,6 +48,7 @@ library:
   - Gargantext.Text
   - Gargantext.Text.Context
   - Gargantext.Text.Corpus.Parsers
+  - Gargantext.Text.Corpus.API
   - Gargantext.Text.Corpus.Parsers.CSV
   - Gargantext.Text.Examples
   - Gargantext.Text.List.CSV

src/Gargantext/API/Corpus/New.hs

@@ -33,7 +33,6 @@ import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Database.Flow (flowCorpusSearchInDatabase)
 import Gargantext.Database.Types.Node (CorpusId)
 import Gargantext.Prelude
-import Gargantext.Prelude.Utils (hash)
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
@@ -43,7 +42,7 @@ import Gargantext.Database.Types.Node (UserId)
 
 data Query = Query { query_query      :: Text
                    , query_corpus_id  :: Int
-                   , query_files_id  :: [Text]
+                   , query_databases  :: [API.ExternalAPIs]
                    }
                    deriving (Eq, Show, Generic)
 
@@ -54,7 +53,7 @@ instance Arbitrary Query where
     arbitrary = elements [ Query q n fs
                          | q <- ["a","b"]
                          , n <- [0..10]
-                         , fs <- map (map hash) [["a","b"], ["c","d"]]
+                         , fs <- take 3 $ repeat API.externalAPIs
                          ]
 
 instance ToSchema Query where
@@ -62,19 +61,20 @@ instance ToSchema Query where
     genericDeclareNamedSchema
       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 6 fieldLabel}
 
-
-
 type Api = Summary "New Corpus endpoint"
          :> ReqBody '[JSON] Query
          :> Post '[JSON] CorpusId
         :<|> Get '[JSON] ApiInfo
 
-
+-- | TODO manage several apis
 api :: FlowCmdM env err m => Query -> m CorpusId
-api (Query q _ _) = do
-  cId <- flowCorpusSearchInDatabase "user1" EN q
-  pure cId
+api (Query q _ as) = do
+  cId <- case head as of
+    Nothing      -> flowCorpusSearchInDatabase "user1" EN q
+    Just API.All -> flowCorpusSearchInDatabase "user1" EN q
+    Just _   -> undefined
 
+  pure cId
 
 ------------------------------------------------
 data ApiInfo = ApiInfo { api_info :: [API.ExternalAPIs]}
@@ -90,3 +90,4 @@ info :: FlowCmdM env err m => UserId -> m ApiInfo
 info _u = pure $ ApiInfo API.externalAPIs
 
 
+

src/Gargantext/Core.hs

@@ -12,6 +12,8 @@ Portability : POSIX
 module Gargantext.Core
   where
 
+
+
 ------------------------------------------------------------------------
 -- | Language of a Text
 -- For simplicity, we suppose text has an homogenous language

src/Gargantext/Core/Flow.hs

+{-|
+Module      : Gargantext.Core.Flow
+Description : Core Flow main Types
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE ConstraintKinds   #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# LANGUAGE ConstrainedClassMethods #-}
+
+module Gargantext.Core.Flow where
+
+import Control.Lens ((^.), view, Lens', _Just)
+import Data.Map (Map)
+import Data.Text (Text)
+import Gargantext.Text.Terms (TermType)
+import Gargantext.Core (Lang)
+import Gargantext.Database.Schema.Ngrams (Ngrams, NgramsType)
+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)
+
+type FlowCorpus a = ( AddUniqId      a
+                    , UniqId         a
+                    , InsertDb       a
+                    , ExtractNgramsT a
+                    , HasText        a
+                    )
+
+class UniqId a
+  where
+    uniqId :: Lens' a (Maybe HashId)
+
+class ExtractNgramsT h
+  where
+    extractNgramsT :: HasText h => TermType Lang -> h -> Cmd err (Map Ngrams (Map NgramsType Int))
+
+class HasText h
+  where
+    hasText :: h -> [Text]
+
+------------------------------------------------------------------------
+
+instance UniqId HyperdataDocument
+  where
+    uniqId = hyperdataDocument_uniqId
+
+instance UniqId HyperdataContact
+  where
+    uniqId = hc_uniqId
+
+

src/Gargantext/Database/Flow.hs

@@ -18,20 +18,23 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE ConstraintKinds   #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE InstanceSigs      #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes        #-}
+{-# OPTIONS_GHC -fno-warn-orphans        #-}
+
+{-# LANGUAGE ConstraintKinds         #-}
+{-# LANGUAGE RankNTypes              #-}
 {-# LANGUAGE ConstrainedClassMethods #-}
+{-# LANGUAGE ConstraintKinds         #-}
+{-# LANGUAGE DeriveGeneric           #-}
+{-# LANGUAGE FlexibleContexts        #-}
+{-# LANGUAGE InstanceSigs            #-}
+{-# LANGUAGE NoImplicitPrelude       #-}
+{-# LANGUAGE OverloadedStrings       #-}
 
 module Gargantext.Database.Flow -- (flowDatabase, ngrams2list)
     where
 import Prelude (String)
 import Debug.Trace (trace)
-import Control.Lens ((^.), view, Lens', _Just)
+import Control.Lens ((^.), view, _Just)
 import Control.Monad (mapM_)
 import Control.Monad.IO.Class (liftIO)
 import Data.List (concat)
@@ -45,6 +48,7 @@ import Gargantext.API.Ngrams (NgramsElement(..), putListNgrams, RepoCmdM)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types (NodePoly(..), Terms(..))
 import Gargantext.Core.Types.Individu (Username)
+import Gargantext.Core.Flow
 import Gargantext.Core.Types.Main
 import Gargantext.Database.Config (userMaster, corpusMasterName)
 import Gargantext.Database.Flow.Utils (insertDocNgrams)
@@ -81,13 +85,6 @@ type FlowCmdM env err m =
   , HasRepoVar env
   )
 
-type FlowCorpus a = ( AddUniqId a
-                    , UniqId a
-                    , InsertDb a
-                    , ExtractNgramsT a
-                    , HasText a
-                    )
-
 ------------------------------------------------------------------------
 
 data ApiQuery = ApiIsidoreQuery Text | ApiIsidoreAuth Text
@@ -280,19 +277,6 @@ getOrMkRootWithCorpus username cName c = do
 ------------------------------------------------------------------------
 
 
-class UniqId a
-  where
-    uniqId :: Lens' a (Maybe HashId)
-
-
-instance UniqId HyperdataDocument
-  where
-    uniqId = hyperdataDocument_uniqId
-
-instance UniqId HyperdataContact
-  where
-    uniqId = hc_uniqId
-
 viewUniqId' :: UniqId a => a -> (HashId, a)
 viewUniqId' d = maybe err (\h -> (h,d)) (view uniqId d)
       where
@@ -328,14 +312,6 @@ data DocumentIdWithNgrams a = DocumentIdWithNgrams
   } deriving (Show)
 
 
-class ExtractNgramsT h
-  where
-    extractNgramsT :: HasText h => TermType Lang -> h -> Cmd err (Map Ngrams (Map NgramsType Int))
-
-class HasText h
-  where
-    hasText :: h -> [Text]
-
 instance HasText HyperdataContact
   where
     hasText = undefined

src/Gargantext/Text/Corpus/API.hs

@@ -16,29 +16,30 @@ Portability : POSIX
 module Gargantext.Text.Corpus.API
     where
 
---{-
-
 import GHC.Generics (Generic)
 import Data.Aeson
 import Data.Text (Text)
 import Gargantext.Prelude
---import qualified PUBMED as PubMed
+import Gargantext.Core (Lang(..))
+import Gargantext.Core.Flow (FlowCorpus)
+import Gargantext.Database.Types.Node (HyperdataDocument)
 import Test.QuickCheck.Arbitrary
 import Test.QuickCheck (elements)
 import Data.Swagger
---import qualified Gargantext.Text.Corpus.API.Isidore as Isidore
 
+import qualified PUBMED as PubMed
+import qualified PUBMED.Parser as Doc (PubMed)
+import qualified Gargantext.Text.Corpus.API.Isidore as Isidore
 
-data ExternalAPIs = ALL
+data ExternalAPIs = All
                   | PubMed
                   | HAL
-                  | IsTex
+                  -- | IsTex
                   | IsidoreQuery | IsidoreAuth
   deriving (Show, Eq, Enum, Bounded, Generic)
 
 instance FromJSON ExternalAPIs
 instance ToJSON ExternalAPIs
-type Query = Text
 
 externalAPIs :: [ExternalAPIs]
 externalAPIs = [minBound..maxBound]
@@ -48,7 +49,14 @@ instance Arbitrary ExternalAPIs
     arbitrary = elements externalAPIs
 
 instance ToSchema ExternalAPIs
-{-
-crawl :: Crawler -> Query -> IO [PubMed.Doc]
-crawl Pubmed = PubMed.crawler
---}
+
+type Query = Text
+type Limit = PubMed.Limit
+
+get :: FlowCorpus a => ExternalAPIs -> Query -> Maybe Limit -> IO [a]
+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
+

stack.yaml

@@ -23,7 +23,7 @@ extra-deps:
 - git: https://github.com/robstewart57/rdf4h.git
   commit: 4fd2edf30c141600ffad6d730cc4c1c08a6dbce4
 - git: https://gitlab.iscpif.fr/gargantext/crawlers/pubmed.git
-  commit: dcaa0f5dd53f20648f4f5a615d29163582a4219c
+  commit: 06476735cb45c704079f548ac5de9d4ba09cf3fb
 - git: https://gitlab.iscpif.fr/gargantext/crawlers/hal.git
   commit: bf57642f6b66f554fdc0a38ac391cd8200dffcb3
 - git: https://gitlab.iscpif.fr/gargantext/patches-class