Commit 75b4fd25 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Graph] clean

parent 5ac27a46
...@@ -25,7 +25,6 @@ Portability : POSIX ...@@ -25,7 +25,6 @@ Portability : POSIX
module Gargantext.Viz.Graph.API module Gargantext.Viz.Graph.API
where where
import Control.Concurrent -- (forkIO)
import Control.Lens (set, (^.), _Just, (^?)) import Control.Lens (set, (^.), _Just, (^?))
import Data.Aeson import Data.Aeson
import Debug.Trace (trace) import Debug.Trace (trace)
...@@ -127,19 +126,6 @@ graphAPI u n = getGraph u n ...@@ -127,19 +126,6 @@ graphAPI u n = getGraph u n
------------------------------------------------------------------------ ------------------------------------------------------------------------
{- Model to fork Graph Computation
-- This is not really optimized since it increases the need RAM
-- and freezes the whole system
-- This is mainly for documentation (see a better solution in the function below)
-- Each process has to be tailored
getGraph' :: UserId -> NodeId -> GargServer (Get '[JSON] Graph)
getGraph' u n = do
newGraph <- liftBase newEmptyMVar
g <- getGraph u n
_ <- liftBase $ forkIO $ putMVar newGraph g
g' <- liftBase $ takeMVar newGraph
pure g'
-}
getGraph :: UserId -> NodeId -> GargNoServer Graph getGraph :: UserId -> NodeId -> GargNoServer Graph
getGraph uId nId = do getGraph uId nId = do
nodeGraph <- getNodeWith nId HyperdataGraph nodeGraph <- getNodeWith nId HyperdataGraph
...@@ -175,11 +161,7 @@ getGraph uId nId = do ...@@ -175,11 +161,7 @@ getGraph uId nId = do
-- _ <- updateHyperdata nId (HyperdataGraph $ Just graph'') -- _ <- updateHyperdata nId (HyperdataGraph $ Just graph'')
-- pure graph'' -- pure graph''
pure g
newGraph <- liftBase newEmptyMVar
_ <- liftBase $ forkIO $ putMVar newGraph g
g' <- liftBase $ takeMVar newGraph
pure {- $ trace (show g) $ -} g'
recomputeGraph :: UserId -> NodeId -> GargNoServer Graph recomputeGraph :: UserId -> NodeId -> GargNoServer Graph
...@@ -204,30 +186,18 @@ recomputeGraph uId nId = do ...@@ -204,30 +186,18 @@ recomputeGraph uId nId = do
g <- case graph of g <- case graph of
Nothing -> do Nothing -> do
graph' <- computeGraphAsync cId NgramsTerms repo graph' <- computeGraph cId NgramsTerms repo
_ <- insertGraph cId uId' (HyperdataGraph $ Just graph') _ <- insertGraph cId uId' (HyperdataGraph $ Just graph')
pure $ trace "[recomputeGraph] Graph empty, computing" $ graph' pure $ trace "[recomputeGraph] Graph empty, computing" $ graph'
Just graph' -> if listVersion == Just v Just graph' -> if listVersion == Just v
then pure graph' then pure graph'
else do else do
graph'' <- computeGraphAsync cId NgramsTerms repo graph'' <- computeGraph cId NgramsTerms repo
_ <- updateHyperdata nId (HyperdataGraph $ Just graph'') _ <- updateHyperdata nId (HyperdataGraph $ Just graph'')
pure $ trace "[recomputeGraph] Graph exists, recomputing" $ graph'' pure $ trace "[recomputeGraph] Graph exists, recomputing" $ graph''
pure g pure g
computeGraphAsync :: HasNodeError err
=> CorpusId
-> NgramsType
-> NgramsRepo
-> Cmd err Graph
computeGraphAsync cId nt repo = do
g <- liftBase newEmptyMVar
_ <- forkIO <$> putMVar g <$> computeGraph cId nt repo
g' <- liftBase $ takeMVar g
pure g'
-- TODO use Database Monad only here ? -- TODO use Database Monad only here ?
computeGraph :: HasNodeError err computeGraph :: HasNodeError err
......
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