[GRAPH] Async Route

src/Gargantext/API/Corpus/New.hs

@@ -67,7 +67,6 @@ data Query = Query { query_query      :: Text
 
 deriveJSON (unPrefix "query_") 'Query
 
-
 instance Arbitrary Query where
     arbitrary = elements [ Query q n fs
                          | q <- ["a","b"]
@@ -157,7 +156,6 @@ type Upload = Summary "Corpus Upload endpoint"
     :<|> "addWithquery" :> AsyncJobsAPI ScraperStatus                   WithQuery ScraperStatus
     :<|> "addWithfile"  :> AsyncJobs    ScraperStatus '[FormUrlEncoded] WithForm  ScraperStatus
 
-
 type AddWithQuery = Summary "Add with Query to corpus endpoint"
    :> "corpus"
    :> Capture "corpus_id" CorpusId
@@ -205,7 +203,6 @@ addToCorpusJobFunction _cid (WithQuery _q _dbs _l) logStatus = do
                           , _scst_events    = Just []
                           }
 
-
 addToCorpusWithFile :: FlowCmdM env err m
                     => CorpusId
                     -> MultipartData Mem

src/Gargantext/Prelude.hs

@@ -323,5 +323,3 @@ inMVar f = do
   _ <- liftIO $ forkIO $ putMVar mVar zVar
   liftIO $ takeMVar mVar
 
-
-

src/Gargantext/Viz/Graph/API.hs

@@ -24,7 +24,7 @@ Portability : POSIX
 module Gargantext.Viz.Graph.API
   where
 
--- import Debug.Trace (trace)
+import Debug.Trace (trace)
 import Control.Concurrent -- (forkIO)
 import Control.Lens (set, (^.), _Just, (^?))
 import Control.Monad.IO.Class (liftIO)
@@ -45,6 +45,10 @@ import Gargantext.Prelude
 import Gargantext.Viz.Graph
 import Gargantext.Viz.Graph.Tools -- (cooc2graph)
 import Servant
+
+import Gargantext.API.Orchestrator.Types
+import Servant.Job.Types
+import Servant.Job.Async
 import qualified Data.Map as Map
 
 ------------------------------------------------------------------------
@@ -54,12 +58,14 @@ import qualified Data.Map as Map
 type GraphAPI   =  Get  '[JSON] Graph
               :<|> Post '[JSON] [GraphId]
               :<|> Put  '[JSON] Int
+              :<|> GraphAsync
 
 
 graphAPI :: UserId -> NodeId -> GargServer GraphAPI
 graphAPI u n =  getGraph  u n
          :<|> postGraph n
          :<|> putGraph  n
+         :<|> graphAsync u n
 
 ------------------------------------------------------------------------
 
@@ -96,10 +102,9 @@ getGraph uId nId = do
                   identity
                   $ nodeGraph ^. node_parentId
 
-  newGraph  <- liftIO newEmptyMVar
   g <- case graph of
     Nothing     -> do
-      graph' <- inMVarIO $ computeGraph cId NgramsTerms repo
+      graph' <- computeGraph cId NgramsTerms repo
       _ <- insertGraph cId uId' (HyperdataGraph $ Just graph')
       pure graph'
 
@@ -109,6 +114,8 @@ getGraph uId nId = do
                        graph'' <- computeGraph cId NgramsTerms repo
                        _ <- updateHyperdata nId (HyperdataGraph $ Just graph'')
                        pure graph''
+
+  newGraph  <- liftIO newEmptyMVar
   _  <- liftIO $ forkIO $ putMVar newGraph g
   g' <- liftIO $ takeMVar newGraph
   pure {- $ trace (show g) $ -} g'
@@ -129,12 +136,12 @@ computeGraph cId nt repo = do
   lIds <- selectNodesWithUsername NodeList userMaster
   let ngs = filterListWithRoot GraphTerm $ mapTermListRoot [lId] nt repo
 
-  myCooc <- Map.filter (>1)
-         <$> getCoocByNgrams (Diagonal True)
+  myCooc <- inMVarIO $ Map.filter (>1)
+         <$> getCoocByNgrams (Diagonal False)
          <$> groupNodesByNgrams ngs
          <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
 
-  graph <- liftIO $ inMVarIO $ cooc2graph 0 myCooc
+  graph <- liftIO $ inMVar $ cooc2graph 0 myCooc
   let graph' = set graph_metadata (Just metadata) graph
   pure graph'
 
@@ -146,3 +153,31 @@ postGraph = undefined
 putGraph :: NodeId -> GargServer (Put '[JSON] Int)
 putGraph = undefined
 
+------------------------------------------------------------
+
+type GraphAsync = Summary "Update graph"
+                :> "async"
+                :> AsyncJobsAPI ScraperStatus () ScraperStatus
+
+graphAsync :: UserId -> NodeId -> GargServer GraphAsync
+graphAsync u n =
+  serveJobsAPI $
+    JobFunction (\_ log' -> graphAsync' u n (liftIO . log'))
+
+
+graphAsync' :: UserId
+           -> NodeId
+           -> (ScraperStatus -> GargNoServer ())
+           -> GargNoServer ScraperStatus
+graphAsync' u n logStatus = do
+  logStatus ScraperStatus { _scst_succeeded = Just 1
+                          , _scst_failed    = Just 0
+                          , _scst_remaining = Just 1
+                          , _scst_events    = Just []
+                          }
+  _g <- trace (show u) $ getGraph u n
+  pure  ScraperStatus { _scst_succeeded = Just 1
+                          , _scst_failed    = Just 0
+                          , _scst_remaining = Just 1
+                          , _scst_events    = Just []
+                          }

src/Gargantext/Viz/Phylo/Aggregates.hs

@@ -27,7 +27,7 @@ import Gargantext.Viz.Phylo
 import Gargantext.Viz.Phylo.Tools
 
 import Debug.Trace (trace)
- 
+
 import Data.List    (partition, concat, nub, elem, sort, (++), null, union)
 import Data.Map     (Map, fromList, fromListWith, adjust, filterWithKey, elems, keys, unionWith, mapWithKey)
 import Data.Set     (size)

src/Gargantext/Viz/Phylo/PhyloTools.hs

@@ -492,4 +492,4 @@ traceTemporalMatching groups =
 
 traceGroupsProxi :: Map (PhyloGroupId,PhyloGroupId) Double -> Map (PhyloGroupId,PhyloGroupId) Double
 traceGroupsProxi m = 
-    trace ( "\n" <> "-- | " <> show(Map.size m) <> " computed pairs of groups proximity" <> "\n") m
+    trace ( "\n" <> "-- | " <> show(Map.size m) <> " computed pairs of groups proximity" <> "\n") m
\ No newline at end of file

src/Gargantext/Viz/Phylo/TemporalMatching.hs

@@ -543,4 +543,4 @@ adaptativeTemporalMatching elevation phylo = updatePhyloGroups 1
                          (traceTemporalMatching $ getGroupsFromLevel 1 phylo)
     --------------------------------------
     thr :: Double
-    thr = toThreshold elevation (phylo ^. phylo_groupsProxi)
+    thr = toThreshold elevation (phylo ^. phylo_groupsProxi)
\ No newline at end of file

src/Gargantext/Viz/Phylo/View/ViewMaker.hs

@@ -170,4 +170,4 @@ traceView pv = trace ("------------\n--| View |--\n------------\n\n"
                              <> show (percentile 75 (VS.fromList lst)) <> " (75%) "
                              <> show (percentile 90 (VS.fromList lst)) <> " (90%)\n") pv
   where 
-    lst = sort $ map (fromIntegral . length . snd) $ getNodesByBranches pv
+    lst = sort $ map (fromIntegral . length . snd) $ getNodesByBranches pv
\ No newline at end of file