Commit 229f0d44 authored by Nicolas Pouillard's avatar Nicolas Pouillard

ServantJob, addToCorpus

parent 1d31e207
Pipeline #616 failed with stage
...@@ -18,13 +18,14 @@ New corpus means either: ...@@ -18,13 +18,14 @@ New corpus means either:
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
module Gargantext.API.Corpus.New module Gargantext.API.Corpus.New
where where
import Data.Either import Data.Either
import Control.Lens hiding (elements)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Data.Aeson.TH (deriveJSON) import Data.Aeson.TH (deriveJSON)
import Data.Swagger import Data.Swagger
...@@ -35,7 +36,11 @@ import Gargantext.Database.Flow (flowCorpusSearchInDatabase) ...@@ -35,7 +36,11 @@ import Gargantext.Database.Flow (flowCorpusSearchInDatabase)
import Gargantext.Database.Types.Node (CorpusId) import Gargantext.Database.Types.Node (CorpusId)
import Gargantext.Text.Terms (TermType(..)) import Gargantext.Text.Terms (TermType(..))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.API.Settings
import Gargantext.API.Orchestrator.Types
import Servant import Servant
import Servant.Job.Async
-- import Servant.Job.Server
import Test.QuickCheck (elements) import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary import Test.QuickCheck.Arbitrary
import Gargantext.Core (Lang(..)) import Gargantext.Core (Lang(..))
...@@ -95,4 +100,62 @@ instance ToSchema ApiInfo ...@@ -95,4 +100,62 @@ instance ToSchema ApiInfo
info :: FlowCmdM env err m => UserId -> m ApiInfo info :: FlowCmdM env err m => UserId -> m ApiInfo
info _u = pure $ ApiInfo API.externalAPIs info _u = pure $ ApiInfo API.externalAPIs
{-
-- Proposal to replace the Query type which seems to generically named.
data ScraperInput = ScraperInput
{ _scin_query :: !Text
, _scin_corpus_id :: !Int
, _scin_databases :: [API.ExternalAPIs]
}
deriving (Eq, Show, Generic)
makeLenses ''ScraperInput
deriveJSON (unPrefix "_scin_") 'ScraperInput
data ScraperEvent = ScraperEvent
{ _scev_message :: !(Maybe Text)
, _scev_level :: !(Maybe Text)
, _scev_date :: !(Maybe Text)
}
deriving Generic
deriveJSON (unPrefix "_scev_") 'ScraperEvent
data ScraperStatus = ScraperStatus
{ _scst_succeeded :: !(Maybe Int)
, _scst_failed :: !(Maybe Int)
, _scst_remaining :: !(Maybe Int)
, _scst_events :: !(Maybe [ScraperEvent])
}
deriving Generic
deriveJSON (unPrefix "_scst_") 'ScraperStatus
-}
type API_v2 =
Summary "Add to corpus endpoint" :>
"corpus" :>
Capture "id" CorpusId :>
"add" :>
"async" :> ScraperAPI2
-- TODO ScraperInput2 also has a corpus id
addToCorpusJobFunction :: CorpusId -> ScraperInput2 -> (ScraperStatus -> IO ()) -> IO ScraperStatus
addToCorpusJobFunction _cid _input logStatus = do
-- TODO ...
logStatus ScraperStatus { _scst_succeeded = Just 10
, _scst_failed = Just 2
, _scst_remaining = Just 138
, _scst_events = Just []
}
-- TODO ...
pure ScraperStatus { _scst_succeeded = Just 137
, _scst_failed = Just 13
, _scst_remaining = Just 0
, _scst_events = Just []
}
addToCorpus :: Env -> Server API_v2
addToCorpus env cid = do
serveJobsAPI (env ^. scrapers) . JobFunction $ addToCorpusJobFunction cid
...@@ -11,7 +11,7 @@ import Data.Text (Text) ...@@ -11,7 +11,7 @@ import Data.Text (Text)
import GHC.Generics import GHC.Generics
import Servant import Servant
import Servant.Job.Utils (jsonOptions) import Servant.Job.Utils (jsonOptions)
import Servant.Client import Servant.Client.Streaming
import Web.FormUrlEncoded hiding (parseMaybe) import Web.FormUrlEncoded hiding (parseMaybe)
data Schedule = Schedule data Schedule = Schedule
......
...@@ -45,6 +45,35 @@ instance ToSchema a => ToSchema (JobInput a) ...@@ -45,6 +45,35 @@ instance ToSchema a => ToSchema (JobInput a)
instance ToSchema a => ToSchema (JobOutput a) instance ToSchema a => ToSchema (JobOutput a)
-- | Main Types
data ExternalAPIs = All
| PubMed
| HAL_EN
| HAL_FR
| IsTex_EN
| IsTex_FR
| Isidore_EN
| Isidore_FR
-- | IsidoreAuth
deriving (Show, Eq, Enum, Bounded, Generic)
-- | Main Instances
instance FromJSON ExternalAPIs
instance ToJSON ExternalAPIs
externalAPIs :: [ExternalAPIs]
externalAPIs = [minBound..maxBound]
instance Arbitrary ExternalAPIs
where
arbitrary = elements externalAPIs
instance ToSchema ExternalAPIs
data ScraperInput = ScraperInput data ScraperInput = ScraperInput
{ _scin_spider :: !Text { _scin_spider :: !Text
, _scin_query :: !(Maybe Text) , _scin_query :: !(Maybe Text)
...@@ -62,6 +91,19 @@ makeLenses ''ScraperInput ...@@ -62,6 +91,19 @@ makeLenses ''ScraperInput
instance FromJSON ScraperInput where instance FromJSON ScraperInput where
parseJSON = genericParseJSON $ jsonOptions "_scin_" parseJSON = genericParseJSON $ jsonOptions "_scin_"
-- Proposal to replace the Corpus.API.Query type which seems to generically named.
data ScraperInput2 = ScraperInput2
{ _scin2_query :: !Text
, _scin2_corpus :: !Int
, _scin2_databases :: [ExternalAPIs]
}
deriving Generic
makeLenses ''ScraperInput2
instance FromJSON ScraperInput2 where
parseJSON = genericParseJSON $ jsonOptions "_scin2_"
data ScraperEvent = ScraperEvent data ScraperEvent = ScraperEvent
{ _scev_message :: !(Maybe Text) { _scev_message :: !(Maybe Text)
, _scev_level :: !(Maybe Text) , _scev_level :: !(Maybe Text)
...@@ -111,3 +153,4 @@ instance ToParamSchema Limit where ...@@ -111,3 +153,4 @@ instance ToParamSchema Limit where
type ScrapersEnv = JobEnv ScraperStatus ScraperStatus type ScrapersEnv = JobEnv ScraperStatus ScraperStatus
type ScraperAPI = AsyncJobsAPI ScraperStatus ScraperInput ScraperStatus type ScraperAPI = AsyncJobsAPI ScraperStatus ScraperInput ScraperStatus
type ScraperAPI2 = AsyncJobsAPI ScraperStatus ScraperInput2 ScraperStatus
...@@ -90,6 +90,8 @@ makeLenses ''Settings ...@@ -90,6 +90,8 @@ makeLenses ''Settings
class HasSettings env where class HasSettings env where
settings :: Getter env Settings settings :: Getter env Settings
class HasScrapers env where
scrapers :: Getter env ScrapersEnv
devSettings :: FilePath -> IO Settings devSettings :: FilePath -> IO Settings
devSettings jwkFile = do devSettings jwkFile = do
...@@ -163,6 +165,9 @@ instance HasRepo Env where ...@@ -163,6 +165,9 @@ instance HasRepo Env where
instance HasSettings Env where instance HasSettings Env where
settings = env_settings settings = env_settings
instance HasScrapers Env where
scrapers = env_scrapers
data MockEnv = MockEnv data MockEnv = MockEnv
{ _menv_firewall :: !FireWall { _menv_firewall :: !FireWall
} }
......
...@@ -133,6 +133,7 @@ isDescendantOf childId rootId = (== [Only True]) ...@@ -133,6 +133,7 @@ isDescendantOf childId rootId = (== [Only True])
WHERE t.id = ?; WHERE t.id = ?;
|] (childId, rootId) |] (childId, rootId)
-- TODO should we check the category?
isIn :: NodeId -> DocId -> Cmd err Bool isIn :: NodeId -> DocId -> Cmd err Bool
isIn cId docId = ( == [Only True]) isIn cId docId = ( == [Only True])
<$> runPGSQuery [sql| SELECT COUNT(*) = 1 <$> runPGSQuery [sql| SELECT COUNT(*) = 1
......
...@@ -15,39 +15,25 @@ Portability : POSIX ...@@ -15,39 +15,25 @@ Portability : POSIX
{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE InstanceSigs #-}
module Gargantext.Text.Corpus.API module Gargantext.Text.Corpus.API
( ExternalAPIs(..)
, Query
, Limit
, get
, externalAPIs
)
where where
import GHC.Generics (Generic)
import Data.Aeson
import Data.Maybe import Data.Maybe
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core (Lang(..)) import Gargantext.Core (Lang(..))
import Gargantext.API.Orchestrator.Types (ExternalAPIs(..), externalAPIs)
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 Gargantext.Text.Corpus.API.Pubmed as PUBMED import qualified Gargantext.Text.Corpus.API.Pubmed as PUBMED
import qualified Gargantext.Text.Corpus.API.Isidore as ISIDORE import qualified Gargantext.Text.Corpus.API.Isidore as ISIDORE
import qualified Gargantext.Text.Corpus.API.Hal as HAL import qualified Gargantext.Text.Corpus.API.Hal as HAL
import qualified Gargantext.Text.Corpus.API.Istex as ISTEX import qualified Gargantext.Text.Corpus.API.Istex as ISTEX
-- | Main Types
data ExternalAPIs = All
| PubMed
| HAL_EN
| HAL_FR
| IsTex_EN
| IsTex_FR
| Isidore_EN
| Isidore_FR
-- | IsidoreAuth
deriving (Show, Eq, Enum, Bounded, Generic)
-- | Get External API metadata main function -- | Get External API metadata main function
get :: ExternalAPIs -> Query -> Maybe Limit -> IO [HyperdataDocument] get :: ExternalAPIs -> Query -> Maybe Limit -> IO [HyperdataDocument]
get All _ _ = undefined get All _ _ = undefined
...@@ -63,20 +49,6 @@ get IsTex_FR q l = ISTEX.get FR q l ...@@ -63,20 +49,6 @@ get IsTex_FR q l = ISTEX.get FR q l
get Isidore_EN q l = ISIDORE.get EN (fromIntegral <$> l) (Just q) Nothing get Isidore_EN q l = ISIDORE.get EN (fromIntegral <$> l) (Just q) Nothing
get Isidore_FR q l = ISIDORE.get FR (fromIntegral <$> l) (Just q) Nothing get Isidore_FR q l = ISIDORE.get FR (fromIntegral <$> l) (Just q) Nothing
-- | Main Instances
instance FromJSON ExternalAPIs
instance ToJSON ExternalAPIs
externalAPIs :: [ExternalAPIs]
externalAPIs = [minBound..maxBound]
instance Arbitrary ExternalAPIs
where
arbitrary = elements externalAPIs
instance ToSchema ExternalAPIs
-- | Some Sugar for the documentation -- | Some Sugar for the documentation
type Query = PUBMED.Query type Query = PUBMED.Query
type Limit = PUBMED.Limit type Limit = PUBMED.Limit
......
...@@ -35,10 +35,10 @@ extra-deps: ...@@ -35,10 +35,10 @@ extra-deps:
# #
- git: https://gitlab.iscpif.fr/gargantext/patches-class - git: https://gitlab.iscpif.fr/gargantext/patches-class
commit: 746b4ce0af8f9e600d555ad7e5b2973a940cdad9 commit: 746b4ce0af8f9e600d555ad7e5b2973a940cdad9
#- git: https://github.com/np/servant-job.git - git: https://github.com/np/servant-job.git
#commit: ac4227441bbca30c44235582b5ec31340c569021 commit: 9a89bad2785ff97845e9028fc0d97c64a19d3686
- git: https://github.com/delanoe/servant-job.git #- git: https://github.com/delanoe/servant-job.git
commit: ea1746d43c7992a953c1eb4ed2614df2630d98ce #commit: ea1746d43c7992a953c1eb4ed2614df2630d98ce
- git: https://gitlab.iscpif.fr/gargantext/clustering-louvain.git - git: https://gitlab.iscpif.fr/gargantext/clustering-louvain.git
commit: 1c636112b151110408e7c5a28cec39e46657358e commit: 1c636112b151110408e7c5a28cec39e46657358e
- git: https://github.com/np/patches-map - git: https://github.com/np/patches-map
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment