[graph] some screenshot work

src/Gargantext/API/Prelude.hs

@@ -33,6 +33,10 @@ import Crypto.JOSE.Error as Jose
 import Data.Aeson.Types
 import Data.Typeable
 import Data.Validity
+import Servant
+import Servant.Job.Async
+import Servant.Job.Core (HasServerError(..), serverError)
+
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Admin.Settings
 import Gargantext.API.Ngrams
@@ -41,9 +45,6 @@ import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node.Error (NodeError(..), HasNodeError(..))
 import Gargantext.Database.Query.Tree
 import Gargantext.Prelude
-import Servant
-import Servant.Job.Async (HasJobEnv)
-import Servant.Job.Core (HasServerError(..), serverError)
 
 class HasJoseError e where
   _JoseError :: Prism' e Jose.Error

src/Gargantext/Text/Metrics/TFICF.hs

@@ -23,13 +23,14 @@ module Gargantext.Text.Metrics.TFICF ( TFICF
                                      )
   where
 
-import Data.Text (Text)
-import Gargantext.Prelude
-import Data.Set (Set)
-import Gargantext.Core.Types (Ordering(..))
+import qualified Data.List as List
 import Data.Map.Strict (Map, toList)
 import qualified Data.Ord as DO (Down(..))
-import qualified Data.List as List
+import Data.Set (Set)
+import Data.Text
+
+import Gargantext.Prelude
+import Gargantext.Core.Types (Ordering(..))
 
 path :: Text
 path = "[G.T.Metrics.TFICF]"
@@ -49,7 +50,7 @@ tficf :: TficfContext Count Total
 tficf (TficfInfra (Count ic) (Total it) )
       (TficfSupra (Count sc) (Total st) )
             | it >= ic && st >= sc && it <= st = (ic/it) / log (sc/st)
-            | otherwise            = panic $ "[ERR]" <> path <>" Frequency impossible"
+            | otherwise            = panic $ "[ERR]" <> path <> " Frequency impossible"
 tficf _ _ = panic $ "[ERR]" <> path <> "Undefined for these contexts"
 
 

src/Gargantext/Viz/Graph.hs

@@ -102,6 +102,7 @@ data GraphMetadata =
                 , _gm_corpusId         :: [NodeId]      -- we can map with different corpus
                 , _gm_legend           :: [LegendField] -- legend of the Graph
                 , _gm_list             :: ListForGraph
+                , _gm_startForceAtlas  :: Bool
                 -- , _gm_version       :: Int
                 }
   deriving (Show, Generic)

src/Gargantext/Viz/Graph/API.hs

@@ -55,8 +55,8 @@ import Gargantext.Viz.Graph.Distances (Distance(..), GraphMetric(..))
 -- | There is no Delete specific API for Graph since it can be deleted
 -- as simple Node.
 type GraphAPI   =  Get  '[JSON] Graph
+              :<|> "async" :> GraphAsyncAPI
               :<|> "gexf" :> Get '[XML] (Headers '[Servant.Header "Content-Disposition" Text] Graph)
-              :<|> GraphAsyncAPI
               :<|> "versions" :> GraphVersionsAPI
 
 data GraphVersions =
@@ -70,8 +70,8 @@ instance ToSchema GraphVersions
 
 graphAPI :: UserId -> NodeId -> GargServer GraphAPI
 graphAPI u n = getGraph         u n
-         :<|> getGraphGexf     u n
           :<|> graphAsync       u n
+          :<|> getGraphGexf     u n
           :<|> graphVersionsAPI u n
 
 ------------------------------------------------------------------------
@@ -90,8 +90,10 @@ getGraph _uId nId = do
   case graph of
     Nothing     -> do
         graph' <- computeGraph cId Conditional NgramsTerms repo
-        _      <- updateHyperdata nId (HyperdataGraph $ Just graph')
-        pure $ trace "[G.V.G.API] Graph empty, computing" graph'
+        mt     <- defaultGraphMetadata cId "Title" repo
+        let graph'' = set graph_metadata (Just mt) graph'
+        _      <- updateHyperdata nId (HyperdataGraph $ Just graph'')
+        pure $ trace "[G.V.G.API] Graph empty, computing" graph''
 
     Just graph' -> pure $ trace "[G.V.G.API] Graph exists, returning" graph'
 
@@ -100,11 +102,8 @@ recomputeGraph :: UserId -> NodeId -> Distance -> GargNoServer Graph
 recomputeGraph _uId nId d = do
   nodeGraph <- getNodeWith nId HyperdataGraph
   let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
-  let listVersion = graph ^? _Just
-                            . graph_metadata
-                            . _Just
-                            . gm_list
-                            . lfg_version
+  let graphMetadata = graph ^? _Just . graph_metadata . _Just
+  let listVersion = graph ^? _Just . graph_metadata . _Just . gm_list . lfg_version
 
   repo <- getRepo
   let v   = repo ^. r_version
@@ -115,15 +114,18 @@ recomputeGraph _uId nId d = do
   case graph of
     Nothing     -> do
       graph' <- computeGraph cId d NgramsTerms repo
-      _ <- updateHyperdata nId (HyperdataGraph $ Just graph')
-      pure $ trace "[G.V.G.API.recomputeGraph] Graph empty, computed" graph'
+      mt     <- defaultGraphMetadata cId "Title" repo
+      let graph'' = set graph_metadata (Just mt) graph'
+      _ <- updateHyperdata nId (HyperdataGraph $ Just graph'')
+      pure $ trace "[G.V.G.API.recomputeGraph] Graph empty, computed" graph''
 
     Just graph' -> if listVersion == Just v
                      then pure graph'
                      else do
                        graph'' <- computeGraph cId d NgramsTerms repo
-                       _ <- updateHyperdata nId (HyperdataGraph $ Just graph'')
-                       pure $ trace "[G.V.G.API] Graph exists, recomputing" graph''
+                       let graph''' = set graph_metadata graphMetadata graph''
+                       _ <- updateHyperdata nId (HyperdataGraph $ Just graph''')
+                       pure $ trace "[G.V.G.API] Graph exists, recomputing" graph'''
 
 
 -- TODO use Database Monad only here ?
@@ -147,38 +149,50 @@ computeGraph cId d nt repo = do
 
   graph <- liftBase $ cooc2graph d 0 myCooc
 
+  pure graph
+
+
+defaultGraphMetadata :: HasNodeError err
+                     => CorpusId
+                     -> Text
+                     -> NgramsRepo
+                     -> Cmd err GraphMetadata
+defaultGraphMetadata cId t repo = do
+  lId  <- defaultList cId
 
-  let metadata = GraphMetadata "Title"
-                               Order1
-                               [cId]
-                               [ LegendField 1 "#FFF" "Cluster1"
+  pure $ GraphMetadata {
+      _gm_title = t
+    , _gm_metric = Order1
+    , _gm_corpusId = [cId]
+    , _gm_legend = [
+          LegendField 1 "#FFF" "Cluster1"
         , LegendField 2 "#FFF" "Cluster2"
         , LegendField 3 "#FFF" "Cluster3"
         , LegendField 4 "#FFF" "Cluster4"
         ]
-                               (ListForGraph lId (repo ^. r_version))
+      , _gm_list = (ListForGraph lId (repo ^. r_version))
+      , _gm_startForceAtlas = True
+    }
                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
 
-  pure $ set graph_metadata (Just metadata) graph
-
 
 ------------------------------------------------------------
-type GraphAsyncAPI = Summary "Update graph"
-                   :> "async"
+type GraphAsyncAPI = Summary "Recompute graph"
+                     :> "recompute"
                      :> AsyncJobsAPI JobLog () JobLog
 
 
 graphAsync :: UserId -> NodeId -> GargServer GraphAsyncAPI
 graphAsync u n =
   serveJobsAPI $
-    JobFunction (\_ log' -> graphAsync' u n (liftBase . log'))
+    JobFunction (\_ log' -> graphRecompute u n (liftBase . log'))
 
 
-graphAsync' :: UserId
+graphRecompute :: UserId
                -> NodeId
                -> (JobLog -> GargNoServer ())
                -> GargNoServer JobLog
-graphAsync' u n logStatus = do
+graphRecompute u n logStatus = do
   logStatus JobLog { _scst_succeeded = Just 0
                    , _scst_failed    = Just 0
                    , _scst_remaining = Just 1