2 Module : Gargantext.API.Corpus.New
3 Description : New corpus API
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
10 New corpus means either:
12 - new data in existing corpus
15 {-# LANGUAGE NoImplicitPrelude #-}
16 {-# LANGUAGE TemplateHaskell #-}
17 {-# LANGUAGE DeriveGeneric #-}
18 {-# LANGUAGE DataKinds #-}
19 {-# LANGUAGE TypeOperators #-}
20 {-# LANGUAGE OverloadedStrings #-}
21 {-# LANGUAGE FlexibleContexts #-}
22 {-# LANGUAGE RankNTypes #-}
24 module Gargantext.API.Corpus.New
27 --import Gargantext.Text.Corpus.Parsers (parseFile, FileFormat(..))
28 import Control.Lens hiding (elements)
29 import Control.Monad.IO.Class (liftIO)
31 import Data.Aeson.TH (deriveJSON)
32 import Data.Maybe (fromMaybe)
35 import Data.Text (Text)
36 import GHC.Generics (Generic)
37 import Gargantext.API.Corpus.New.File
38 import Gargantext.API.Orchestrator.Types
39 import Gargantext.Core (Lang(..))
40 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
41 import Gargantext.Database.Flow (FlowCmdM, flowCorpus)
42 import Gargantext.Database.Flow (flowCorpusSearchInDatabase)
43 import Gargantext.Database.Types.Node (CorpusId)
44 import Gargantext.Database.Types.Node (ToHyperdataDocument(..))
45 import Gargantext.Database.Types.Node (UserId)
46 import Gargantext.Prelude
47 import qualified Gargantext.Text.Corpus.Parsers as Parser (FileFormat(..), parseFormat)
48 import Gargantext.Text.Terms (TermType(..))
50 import Servant.API.Flatten (Flat)
51 import Servant.Job.Core
52 import Servant.Job.Types
53 import Servant.Job.Utils (jsonOptions)
54 import Servant.Multipart
55 import Test.QuickCheck (elements)
56 import Test.QuickCheck.Arbitrary
57 import Web.FormUrlEncoded (FromForm)
58 import qualified Gargantext.Text.Corpus.API as API
60 data Query = Query { query_query :: Text
61 , query_corpus_id :: Int
62 , query_databases :: [API.ExternalAPIs]
64 deriving (Eq, Show, Generic)
66 deriveJSON (unPrefix "query_") 'Query
69 instance Arbitrary Query where
70 arbitrary = elements [ Query q n fs
73 , fs <- take 3 $ repeat API.externalAPIs
76 instance ToSchema Query where
77 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")
79 type Api = Summary "New Corpus endpoint"
80 :> ReqBody '[JSON] Query
81 :> Post '[JSON] CorpusId
82 :<|> Get '[JSON] ApiInfo
84 -- | TODO manage several apis
86 -- TODO this is only the POST
87 api :: (FlowCmdM env err m) => UserId -> Query -> m CorpusId
88 api _uId (Query q _ as) = do
89 cId <- case head as of
90 Nothing -> flowCorpusSearchInDatabase "user1" EN q
91 Just API.All -> flowCorpusSearchInDatabase "user1" EN q
93 docs <- liftIO $ API.get a q (Just 1000)
94 cId' <- flowCorpus "user1" (Left q) (Multi EN) [docs]
99 ------------------------------------------------
100 data ApiInfo = ApiInfo { api_info :: [API.ExternalAPIs]}
102 instance Arbitrary ApiInfo where
103 arbitrary = ApiInfo <$> arbitrary
105 deriveJSON (unPrefix "") 'ApiInfo
107 instance ToSchema ApiInfo
109 info :: FlowCmdM env err m => UserId -> m ApiInfo
110 info _u = pure $ ApiInfo API.externalAPIs
112 ------------------------------------------------------------------------
113 ------------------------------------------------------------------------
114 data WithQuery = WithQuery
116 , _wq_databases :: ![ExternalAPIs]
117 , _wq_lang :: !(Maybe Lang)
121 makeLenses ''WithQuery
122 instance FromJSON WithQuery where
123 parseJSON = genericParseJSON $ jsonOptions "_wq_"
124 instance ToSchema WithQuery where
125 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wq_")
127 -------------------------------------------------------
128 data WithForm = WithForm
129 { _wf_filetype :: !FileType
131 , _wf_lang :: !(Maybe Lang)
132 } deriving (Eq, Show, Generic)
134 makeLenses ''WithForm
135 instance FromForm WithForm
136 instance FromJSON WithForm where
137 parseJSON = genericParseJSON $ jsonOptions "_wf_"
138 instance ToSchema WithForm where
139 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
141 ------------------------------------------------------------------------
142 type AsyncJobs event ctI input output =
143 Flat (AsyncJobsAPI' 'Unsafe 'Safe ctI '[JSON] Maybe event input output)
144 ------------------------------------------------------------------------
146 type Upload = Summary "Corpus Upload endpoint"
148 :> Capture "corpus_id" CorpusId
149 :<|> "addWithquery" :> AsyncJobsAPI ScraperStatus WithQuery ScraperStatus
150 :<|> "addWithfile" :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus
153 type AddWithQuery = Summary "Add with Query to corpus endpoint"
155 :> Capture "corpus_id" CorpusId
159 :> AsyncJobsAPI ScraperStatus WithQuery ScraperStatus
161 type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
163 :> Capture "corpus_id" CorpusId
166 :> MultipartForm Mem (MultipartData Mem)
167 :> QueryParam "fileType" FileType
169 :> AsyncJobs ScraperStatus '[JSON] () ScraperStatus
171 type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
173 :> Capture "corpus_id" CorpusId
177 :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus
179 ------------------------------------------------------------------------
180 -- TODO WithQuery also has a corpus id
181 addToCorpusJobFunction :: FlowCmdM env err m
184 -> (ScraperStatus -> m ())
186 addToCorpusJobFunction _cid (WithQuery _q _dbs _l) logStatus = do
188 logStatus ScraperStatus { _scst_succeeded = Just 10
189 , _scst_failed = Just 2
190 , _scst_remaining = Just 138
191 , _scst_events = Just []
194 pure ScraperStatus { _scst_succeeded = Just 137
195 , _scst_failed = Just 13
196 , _scst_remaining = Just 0
197 , _scst_events = Just []
201 addToCorpusWithFile :: FlowCmdM env err m
205 -> (ScraperStatus -> m ())
207 addToCorpusWithFile cid input filetype logStatus = do
208 logStatus ScraperStatus { _scst_succeeded = Just 10
209 , _scst_failed = Just 2
210 , _scst_remaining = Just 138
211 , _scst_events = Just []
213 _h <- postUpload cid filetype input
215 pure ScraperStatus { _scst_succeeded = Just 137
216 , _scst_failed = Just 13
217 , _scst_remaining = Just 0
218 , _scst_events = Just []
221 addToCorpusWithForm :: FlowCmdM env err m
224 -> (ScraperStatus -> m ())
226 addToCorpusWithForm cid (WithForm ft d l) logStatus = do
232 CSV_HAL -> Parser.parseFormat Parser.CsvHal
233 CSV -> Parser.parseFormat Parser.CsvGargV3
234 WOS -> Parser.parseFormat Parser.WOS
235 PresseRIS -> Parser.parseFormat Parser.RisPresse
242 logStatus ScraperStatus { _scst_succeeded = Just 1
243 , _scst_failed = Just 0
244 , _scst_remaining = Just 1
245 , _scst_events = Just []
247 cid' <- flowCorpus "user1"
249 (Multi $ fromMaybe EN l)
250 (map (map toHyperdataDocument) docs)
252 printDebug "cid'" cid'
254 pure ScraperStatus { _scst_succeeded = Just 2
255 , _scst_failed = Just 0
256 , _scst_remaining = Just 0
257 , _scst_events = Just []