[graphql] remove ethercalc endpoint
[gargantext.git] / src / Gargantext / Core / Viz / Graph / API.hs
index 396bcc1d387455ff7d22385ab078c1952faa8377..a34011c37564e9f0d090d960c34e2cdcbdc2041a 100644 (file)
@@ -9,30 +9,30 @@ Portability : POSIX
 
 -}
 
-
 {-# LANGUAGE OverloadedLists   #-}   -- allows to write Map and HashMap as lists
 {-# LANGUAGE TypeOperators     #-}
 
 module Gargantext.Core.Viz.Graph.API
   where
 
-import Control.Lens (set, (^.), _Just, (^?))
+import Control.Lens (set, (^.), _Just, (^?), at)
 import Data.Aeson
 import Data.Maybe (fromMaybe)
 import Data.Swagger
-import Data.Text
+import Data.Text hiding (head)
 import Debug.Trace (trace)
 import GHC.Generics (Generic)
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Ngrams.Tools
-import Gargantext.API.Ngrams.Types (NgramsRepo, r_version)
 import Gargantext.API.Prelude
 import Gargantext.Core.Methods.Distances (Distance(..), GraphMetric(..), withMetric)
+import Gargantext.Core.NodeStory
 import Gargantext.Core.Types.Main
 import Gargantext.Core.Viz.Graph
 import Gargantext.Core.Viz.Graph.GEXF ()
 import Gargantext.Core.Viz.Graph.Tools -- (cooc2graph)
 import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
+import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Config
 import Gargantext.Database.Admin.Types.Node
@@ -42,13 +42,14 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.Select
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Query.Table.Node.User (getNodeUser)
+import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.Ngrams
-import Gargantext.Database.Schema.Node (node_parentId, node_hyperdata, node_name, node_userId)
 import Gargantext.Prelude
 import Servant
 import Servant.Job.Async
 import Servant.XML
 import qualified Data.HashMap.Strict as HashMap
+
 ------------------------------------------------------------------------
 -- | There is no Delete specific API for Graph since it can be deleted
 -- as simple Node.
@@ -77,17 +78,24 @@ graphAPI u n = getGraph         u n
           :<|> graphVersionsAPI u n
 
 ------------------------------------------------------------------------
-getGraph :: UserId -> NodeId -> GargNoServer HyperdataGraphAPI
+--getGraph :: UserId -> NodeId -> GargServer HyperdataGraphAPI
+getGraph :: FlowCmdM env err m
+         => UserId
+         -> NodeId
+         -> m HyperdataGraphAPI
 getGraph _uId nId = do
   nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
-  repo <- getRepo
 
   let
     graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
     camera = nodeGraph ^. node_hyperdata . hyperdataCamera
-    cId = maybe (panic "[G.V.G.API] Node has no parent")
-                  identity
-                  $ nodeGraph ^. node_parentId
+    
+  mcId <- getClosestParentIdByType nId NodeCorpus
+  let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
+
+  printDebug "[getGraph] getting list for cId" cId
+  listId <- defaultList cId
+  repo <- getRepo' [listId]
 
   -- TODO Distance in Graph params
   case graph of
@@ -106,7 +114,12 @@ getGraph _uId nId = do
         HyperdataGraphAPI graph' camera
 
 
-recomputeGraph :: UserId -> NodeId -> Maybe GraphMetric -> GargNoServer Graph
+--recomputeGraph :: UserId -> NodeId -> Maybe GraphMetric -> GargNoServer Graph
+recomputeGraph :: FlowCmdM env err m
+               => UserId
+               -> NodeId
+               -> Maybe GraphMetric
+               -> m Graph
 recomputeGraph _uId nId maybeDistance = do
   nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
   let
@@ -117,17 +130,17 @@ recomputeGraph _uId nId maybeDistance = do
     graphMetric   = case maybeDistance of
                       Nothing -> graph ^? _Just . graph_metadata . _Just . gm_metric
                       _       -> maybeDistance
-
-  repo <- getRepo
-  let
-    v   = repo ^. r_version
-    cId = maybe (panic "[G.V.G.API.recomputeGraph] Node has no parent")
-                  identity
-                  $ nodeGraph ^. node_parentId
     similarity = case graphMetric of
-                   Nothing -> withMetric Order2
+                   Nothing -> withMetric Order1
                    Just m  -> withMetric m
 
+  mcId <- getClosestParentIdByType nId NodeCorpus
+  let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
+
+  listId  <- defaultList cId
+  repo <- getRepo' [listId]
+  let v   = repo ^. unNodeStory . at listId . _Just . a_version
+
   case graph of
     Nothing     -> do
       graph' <- computeGraph cId similarity NgramsTerms repo
@@ -145,13 +158,12 @@ recomputeGraph _uId nId maybeDistance = do
                        pure $ trace "[G.V.G.API] Graph exists, recomputing" graph'''
 
 
--- TODO use Database Monad only here ?
-computeGraph :: HasNodeError err
+computeGraph :: FlowCmdM env err m
              => CorpusId
              -> Distance
              -> NgramsType
-             -> NgramsRepo
-             -> Cmd err Graph
+             -> NodeListStory
+             -> m Graph
 computeGraph cId d nt repo = do
   lId  <- defaultList cId
   lIds <- selectNodesWithUsername NodeList userMaster
@@ -160,20 +172,28 @@ computeGraph cId d nt repo = do
           $ mapTermListRoot [lId] nt repo
 
   myCooc <- HashMap.filter (>1) -- Removing the hapax (ngrams with 1 cooc)
+         -- <$> HashMap.filterWithKey (\(x,y) _ -> x /= y)
+         -- <$> getCoocByNgrams (if d == Conditional then Diagonal True else Diagonal False)
          <$> getCoocByNgrams (Diagonal True)
          <$> groupNodesByNgrams ngs
          <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
 
   -- printDebug "myCooc" myCooc
+  -- saveAsFileDebug "debug/my-cooc" myCooc
+
+  listNgrams <- getListNgrams [lId] nt
 
+  -- graph <- liftBase $ cooc2graphWith Bac d 0 myCooc
   graph <- liftBase $ cooc2graphWith Spinglass d 0 myCooc
-  pure graph
+  -- saveAsFileDebug "debug/graph" graph
+
+  pure $ mergeGraphNgrams graph (Just listNgrams)
 
 
 defaultGraphMetadata :: HasNodeError err
                      => CorpusId
                      -> Text
-                     -> NgramsRepo
+                     -> NodeListStory
                      -> GraphMetric
                      -> Cmd err GraphMetadata
 defaultGraphMetadata cId t repo gm = do
@@ -189,12 +209,11 @@ defaultGraphMetadata cId t repo gm = do
         , LegendField 3 "#FFF" "Cluster3"
         , LegendField 4 "#FFF" "Cluster4"
         ]
-      , _gm_list = (ListForGraph lId (repo ^. r_version))
+      , _gm_list = (ListForGraph lId (repo ^. unNodeStory . at lId . _Just . a_version))
       , _gm_startForceAtlas = True
     }
                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
 
-
 ------------------------------------------------------------
 type GraphAsyncAPI = Summary "Recompute graph"
                      :> "recompute"
@@ -207,10 +226,15 @@ graphAsync u n =
     JobFunction (\_ log' -> graphRecompute u n (liftBase . log'))
 
 
-graphRecompute :: UserId
+--graphRecompute :: UserId
+--               -> NodeId
+--               -> (JobLog -> GargNoServer ())
+--               -> GargNoServer JobLog
+graphRecompute :: FlowCmdM env err m
+               => UserId
                -> NodeId
-               -> (JobLog -> GargNoServer ())
-               -> GargNoServer JobLog
+               -> (JobLog -> m ())
+               -> m JobLog
 graphRecompute u n logStatus = do
   logStatus JobLog { _scst_succeeded = Just 0
                    , _scst_failed    = Just 0
@@ -232,11 +256,11 @@ type GraphVersionsAPI = Summary "Graph versions"
 
 graphVersionsAPI :: UserId -> NodeId -> GargServer GraphVersionsAPI
 graphVersionsAPI u n =
-           graphVersions n
+           graphVersions n
       :<|> recomputeVersions u n
 
-graphVersions :: NodeId -> GargNoServer GraphVersions
-graphVersions nId = do
+graphVersions :: Int -> NodeId -> GargNoServer GraphVersions
+graphVersions n nId = do
   nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
   let
     graph =  nodeGraph
@@ -250,13 +274,28 @@ graphVersions nId = do
                 . gm_list
                 . lfg_version
 
-  repo <- getRepo
-  let v = repo ^. r_version
+  mcId <- getClosestParentIdByType nId NodeCorpus
+  let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
 
-  pure $ GraphVersions { gv_graph = listVersion
-                       , gv_repo = v }
+  maybeListId <- defaultListMaybe cId
+  case maybeListId of
+    Nothing     -> if n <= 2
+                      then graphVersions (n+1) cId
+                      else panic "[G.V.G.API] list not found after iterations"
 
-recomputeVersions :: UserId -> NodeId -> GargNoServer Graph
+    Just listId -> do
+      repo <- getRepo' [listId]
+      let v = repo ^. unNodeStory . at listId . _Just . a_version
+      printDebug "graphVersions" v
+
+      pure $ GraphVersions { gv_graph = listVersion
+                           , gv_repo = v }
+
+--recomputeVersions :: UserId -> NodeId -> GargNoServer Graph
+recomputeVersions :: FlowCmdM env err m
+                  => UserId
+                  -> NodeId
+                  -> m Graph
 recomputeVersions uId nId = recomputeGraph uId nId Nothing
 
 ------------------------------------------------------------
@@ -269,7 +308,7 @@ graphClone uId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph
   let nodeType = NodeGraph
   nodeUser <- getNodeUser (NodeId uId)
   nodeParent <- getNodeWith pId (Proxy :: Proxy HyperdataGraph)
-  let uId' = nodeUser ^. node_userId
+  let uId' = nodeUser ^. node_user_id
   nIds <- mkNodeWithParent nodeType (Just pId) uId' $ nodeParent ^. node_name
   case nIds of
     [] -> pure pId
@@ -282,9 +321,14 @@ graphClone uId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph
       pure nId
 
 ------------------------------------------------------------
-getGraphGexf :: UserId
+--getGraphGexf :: UserId
+--             -> NodeId
+--             -> GargNoServer (Headers '[Servant.Header "Content-Disposition" Text] Graph)
+getGraphGexf :: FlowCmdM env err m
+             => UserId
              -> NodeId
-             -> GargNoServer (Headers '[Servant.Header "Content-Disposition" Text] Graph)
+             -> m (Headers '[Servant.Header "Content-Disposition" Text] Graph)
 getGraphGexf uId nId = do
   HyperdataGraphAPI { _hyperdataAPIGraph = graph } <- getGraph uId nId
   pure $ addHeader "attachment; filename=graph.gexf" graph
+