[Async] back (corpus input test) but still needs work.

src/Gargantext/API/Corpus/New.hs

@@ -257,11 +257,11 @@ addToCorpusWithForm cid (WithForm ft d l _n) logStatus = do
       PresseRIS -> Parser.parseFormat Parser.RisPresse
 
   newDocs <- liftIO newEmptyMVar
-  docs <- liftIO
-        $ splitEvery 500
+  _ <- liftIO $ forkIO
+       <$> putMVar newDocs
+       <$> splitEvery 500
        <$> take 1000000
        <$> parse (cs d)
-  _  <- liftIO $ forkIO $ putMVar newDocs docs
 
   logStatus ScraperStatus { _scst_succeeded = Just 1
                           , _scst_failed    = Just 0
@@ -269,13 +269,14 @@ addToCorpusWithForm cid (WithForm ft d l _n) logStatus = do
                           , _scst_events    = Just []
                           }
 
-  docs' <- liftIO $ takeMVar newDocs
+  docs'  <- liftIO $ takeMVar newDocs
+
   newCid <- liftIO newEmptyMVar
-  cid' <- flowCorpus "user1"
-                     (Right [cid])
-                     (Multi $ fromMaybe EN l)
-                     (map (map toHyperdataDocument) docs')
-  _  <- liftIO $ forkIO $ putMVar newCid cid'
+  _ <- forkIO <$> putMVar newCid
+              <$> flowCorpus "user1"
+                             (Right [cid])
+                             (Multi $ fromMaybe EN l)
+                             (map (map toHyperdataDocument) docs')
 
   cid'' <- liftIO $ takeMVar newCid
   printDebug "cid'" cid''

src/Gargantext/Viz/Graph/API.hs

@@ -158,25 +158,37 @@ recomputeGraph uId nId = do
 
   g <- case graph of
     Nothing     -> do
-      graph' <- computeGraph cId NgramsTerms repo
+      graph' <- computeGraphAsync cId NgramsTerms repo
       _ <- insertGraph cId uId' (HyperdataGraph $ Just graph')
       pure $ trace "[recomputeGraph] Graph empty, computing" $ graph'
 
     Just graph' -> if listVersion == Just v
                      then pure graph'
                      else do
-                       graph'' <- computeGraph cId NgramsTerms repo
+                       graph'' <- computeGraphAsync cId NgramsTerms repo
                        _ <- updateHyperdata nId (HyperdataGraph $ Just graph'')
                        pure $ trace "[recomputeGraph] Graph exists, recomputing" $ graph''
 
-  newGraph  <- liftIO newEmptyMVar
-  _  <- liftIO $ forkIO $ putMVar newGraph g
-  g' <- liftIO $ takeMVar newGraph
+  pure g
+
+computeGraphAsync :: HasNodeError err
+             => CorpusId
+             -> NgramsType
+             -> NgramsRepo
+             -> Cmd err Graph
+computeGraphAsync cId nt repo = do
+  g <- liftIO newEmptyMVar
+  _ <- forkIO <$> putMVar g <$> computeGraph cId nt repo
+  g' <- liftIO $ takeMVar g
   pure g'
 
 
 -- TODO use Database Monad only here ?
-computeGraph :: HasNodeError err => CorpusId -> NgramsType -> NgramsRepo -> Cmd err Graph
+computeGraph :: HasNodeError err
+             => CorpusId
+             -> NgramsType
+             -> NgramsRepo
+             -> Cmd err Graph
 computeGraph cId nt repo = do
   lId  <- defaultList cId
 
@@ -190,12 +202,12 @@ computeGraph cId nt repo = do
   lIds <- selectNodesWithUsername NodeList userMaster
   let ngs = filterListWithRoot GraphTerm $ mapTermListRoot [lId] nt repo
 
-  myCooc <- inMVarIO $ Map.filter (>1)
+  myCooc <- Map.filter (>1)
          <$> getCoocByNgrams (Diagonal False)
          <$> groupNodesByNgrams ngs
          <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
 
-  graph <- liftIO $ inMVar $ cooc2graph 0 myCooc
+  let graph  = cooc2graph 0 myCooc
   let graph' = set graph_metadata (Just metadata) graph
   pure graph'