[GRAPH][OPTIM] store or compute if needed only.

src/Gargantext/API.hs

@@ -351,7 +351,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
      :<|> withAccess  (Proxy :: Proxy TableNgramsApi) Proxy uid <$> PathNode <*> apiNgramsTableDoc
      :<|> count -- TODO: undefined
      :<|> withAccess (Proxy :: Proxy SearchPairsAPI) Proxy uid <$> PathNode <*> searchPairs -- TODO: move elsewhere
-     :<|> withAccess (Proxy :: Proxy GraphAPI)       Proxy uid <$> PathNode <*> graphAPI -- TODO: mock
+     :<|> withAccess (Proxy :: Proxy GraphAPI)       Proxy uid <$> PathNode <*> graphAPI uid -- TODO: mock
      :<|> withAccess (Proxy :: Proxy TreeAPI)        Proxy uid <$> PathNode <*> treeAPI
      :<|> addToCorpus
      :<|> New.api -- TODO-SECURITY

src/Gargantext/Database/Schema/Node.hs

@@ -504,6 +504,12 @@ nodeGraphW maybeName maybeGraph pId = node NodeGraph name graph (Just pId)
     name = maybe "Graph" identity maybeName
     graph = maybe arbitraryGraph identity maybeGraph
 
+mkGraph :: ParentId -> UserId -> Cmd err [GraphId]
+mkGraph p u = insertNodesR [nodeGraphW Nothing Nothing p u]
+
+insertGraph :: ParentId -> UserId -> HyperdataGraph -> Cmd err [GraphId]
+insertGraph p u h = insertNodesR [nodeGraphW Nothing (Just h) p u]
+
 ------------------------------------------------------------------------
 arbitraryPhylo :: HyperdataPhylo
 arbitraryPhylo = HyperdataPhylo Nothing Nothing
@@ -691,11 +697,6 @@ defaultList cId =
 mkNode :: NodeType -> ParentId -> UserId -> Cmd err [NodeId]
 mkNode nt p u = insertNodesR [nodeDefault nt p u]
 
-
-mkGraph :: ParentId -> UserId -> Cmd err [GraphId]
-mkGraph p u = insertNodesR [nodeGraphW Nothing Nothing p u]
-
-
 mkDashboard :: ParentId -> UserId -> Cmd err [NodeId]
 mkDashboard p u = insertNodesR [nodeDashboardW Nothing Nothing p u]
   where

src/Gargantext/Database/Utils.hs

@@ -73,12 +73,13 @@ mkCmd k = do
   conn <- view connection
   liftIO $ k conn
 
-runCmd :: (HasConnection env) => env
-       -> Cmd' env err a
+runCmd :: (HasConnection env)
+       => env -> Cmd' env err a
        -> IO (Either err a)
 runCmd env m = runExceptT $ runReaderT m env
 
-runOpaQuery :: Default FromFields fields haskells => Select fields -> Cmd err [haskells]
+runOpaQuery :: Default FromFields fields haskells
+            => Select fields -> Cmd err [haskells]
 runOpaQuery q = mkCmd $ \c -> runQuery c q
 
 formatPGSQuery :: PGS.ToRow a => PGS.Query -> a -> Cmd err DB.ByteString

src/Gargantext/Viz/Graph/API.hs

@@ -26,7 +26,8 @@ module Gargantext.Viz.Graph.API
 
 import Control.Lens -- (set, (^.), (_Just), (^?))
 import Control.Monad.IO.Class (liftIO)
-import Gargantext.API.Ngrams (currentVersion, listNgramsChangedSince, Versioned(..))
+import Data.Maybe (Maybe(..))
+import Gargantext.API.Ngrams (currentVersion)
 import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Types
 import Gargantext.Core.Types.Main
@@ -34,9 +35,9 @@ import Gargantext.Database.Config
 import Gargantext.Database.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Node.Select
-import Gargantext.Database.Schema.Node (getNode)
-import Gargantext.Database.Schema.Node (defaultList)
+import Gargantext.Database.Schema.Node (getNode, defaultList, insertGraph)
 import Gargantext.Database.Types.Node hiding (node_id) -- (GraphId, ListId, CorpusId, NodeId)
+import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Prelude
 import Gargantext.Viz.Graph
 import Gargantext.Viz.Graph.Tools -- (cooc2graph)
@@ -52,15 +53,15 @@ type GraphAPI   =  Get  '[JSON] Graph
               :<|> Put  '[JSON] Int
 
 
-graphAPI :: NodeId -> GargServer GraphAPI
-graphAPI n =  getGraph  n
+graphAPI :: UserId -> NodeId -> GargServer GraphAPI
+graphAPI u n =  getGraph  u n
          :<|> postGraph n
          :<|> putGraph  n
 
 ------------------------------------------------------------------------
 
-getGraph :: NodeId -> GargServer (Get '[JSON] Graph)
-getGraph nId = do
+getGraph :: UserId -> NodeId -> GargServer (Get '[JSON] Graph)
+getGraph uId nId = do
   nodeGraph <- getNode nId HyperdataGraph
   let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
   let graphVersion = graph ^? _Just
@@ -73,14 +74,22 @@ getGraph nId = do
   let cId = maybe (panic "[ERR:G.V.G.API] Node has no parent")
                   identity
                   $ nodeGraph ^. node_parentId
-
   case graph of
-    Nothing     -> computeGraph 0 nId NgramsTerms v
+    Nothing     -> do
+      graph' <- computeGraph cId NgramsTerms v
+      _ <- insertGraph cId uId (HyperdataGraph $ Just graph')
+      pure graph'
+
     Just graph' -> if graphVersion == Just v
                      then pure graph'
-                     else computeGraph 0 nId NgramsTerms v
-
-computeGraph cId nId nt v = do
+                     else do
+                       graph'' <- computeGraph cId NgramsTerms v
+                       _ <- updateHyperdata nId (HyperdataGraph $ Just graph'')
+                       pure graph''
+
+-- TODO use Database Monad only here ?
+computeGraph :: CorpusId -> NgramsType -> Int -> GargServer (Get '[JSON] Graph)
+computeGraph cId nt v = do
   lId  <- defaultList cId
 
   let metadata = GraphMetadata "Title" [cId]
@@ -99,7 +108,8 @@ computeGraph cId nId nt v = do
                             <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
 
   graph <- liftIO $ cooc2graph 0 myCooc
-  pure $ set graph_metadata (Just metadata) graph
+  let graph' = set graph_metadata (Just metadata) graph
+  pure graph' 
 
 
 
@@ -109,8 +119,3 @@ postGraph = undefined
 putGraph :: NodeId -> GargServer (Put '[JSON] Int)
 putGraph = undefined
 
-
-
-
--- | Instances
-