Commit 5850ff95 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[ASYNC] for tests

parent 48a8c59d
......@@ -28,7 +28,6 @@ module Gargantext.API.Corpus.New
--import Gargantext.Text.Corpus.Parsers (parseFile, FileFormat(..))
import Control.Lens hiding (elements)
import Control.Monad.IO.Class (liftIO)
import Control.Concurrent
import Data.Aeson
import Data.Aeson.TH (deriveJSON)
import Data.Maybe (fromMaybe)
......@@ -245,23 +244,8 @@ addToCorpusWithForm :: FlowCmdM env err m
-> WithForm
-> (ScraperStatus -> m ())
-> m ScraperStatus
addToCorpusWithForm cid (WithForm ft d l _n) logStatus = do
addToCorpusWithForm cid form logStatus = do
printDebug "ft" ft
let
parse = case ft of
CSV_HAL -> Parser.parseFormat Parser.CsvHal
CSV -> Parser.parseFormat Parser.CsvGargV3
WOS -> Parser.parseFormat Parser.WOS
PresseRIS -> Parser.parseFormat Parser.RisPresse
newDocs <- liftIO newEmptyMVar
_ <- liftIO $ forkIO
<$> putMVar newDocs
<$> splitEvery 500
<$> take 1000000
<$> parse (cs d)
logStatus ScraperStatus { _scst_succeeded = Just 1
, _scst_failed = Just 0
......@@ -269,17 +253,7 @@ addToCorpusWithForm cid (WithForm ft d l _n) logStatus = do
, _scst_events = Just []
}
docs' <- liftIO $ takeMVar newDocs
newCid <- liftIO newEmptyMVar
_ <- forkIO <$> putMVar newCid
<$> flowCorpus "user1"
(Right [cid])
(Multi $ fromMaybe EN l)
(map (map toHyperdataDocument) docs')
cid'' <- liftIO $ takeMVar newCid
printDebug "cid'" cid''
_ <- asyncFlowCorpus cid form
pure ScraperStatus { _scst_succeeded = Just 2
, _scst_failed = Just 0
......@@ -287,3 +261,25 @@ addToCorpusWithForm cid (WithForm ft d l _n) logStatus = do
, _scst_events = Just []
}
asyncFlowCorpus :: FlowCmdM env err m
=> CorpusId
-> WithForm
-> m ()
asyncFlowCorpus cid (WithForm ft d l _n) = do
let
parse = case ft of
CSV_HAL -> Parser.parseFormat Parser.CsvHal
CSV -> Parser.parseFormat Parser.CsvGargV3
WOS -> Parser.parseFormat Parser.WOS
PresseRIS -> Parser.parseFormat Parser.RisPresse
docs <- liftIO $ splitEvery 500
<$> take 1000000
<$> parse (cs d)
_cid' <- flowCorpus "user1"
(Right [cid])
(Multi $ fromMaybe EN l)
(map (map toHyperdataDocument) docs)
pure ()
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