Commit ad208ffc authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] Multiple graph fixed, needs cleaning and refactoring

parent 7bc490a3
...@@ -27,47 +27,43 @@ module Gargantext.Viz.Graph.API ...@@ -27,47 +27,43 @@ module Gargantext.Viz.Graph.API
import Control.Lens (set, (^.), _Just, (^?)) import Control.Lens (set, (^.), _Just, (^?))
import Data.Aeson import Data.Aeson
import Debug.Trace (trace)
import qualified Data.Map as Map
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Swagger import Data.Swagger
import Data.Text import Data.Text
import Debug.Trace (trace)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Servant import Gargantext.API.Admin.Orchestrator.Types
import Servant.XML
import Servant.Job.Async
import Gargantext.API.Ngrams (NgramsRepo, r_version) import Gargantext.API.Ngrams (NgramsRepo, r_version)
import Gargantext.API.Ngrams.Tools import Gargantext.API.Ngrams.Tools
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Prelude import Gargantext.API.Prelude
import Gargantext.Core.Types.Main import Gargantext.Core.Types.Main
import Gargantext.Database.Admin.Config
import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser) import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
import Gargantext.Database.Schema.Node (node_userId, node_parentId, node_hyperdata) import Gargantext.Database.Admin.Config
import Gargantext.Database.Schema.Ngrams import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Query.Table.Node.Select import Gargantext.Database.Prelude (Cmd)
import Gargantext.Database.Query.Table.Node import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.User
import Gargantext.Database.Query.Table.Node.Error (HasNodeError) import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Query.Table.Node.Select
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata) import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Prelude (Cmd) import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Schema.Node (node_parentId, node_hyperdata)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Viz.Graph import Gargantext.Viz.Graph
import Gargantext.Viz.Graph.Tools -- (cooc2graph)
import Gargantext.Viz.Graph.GEXF () import Gargantext.Viz.Graph.GEXF ()
import Gargantext.Viz.Graph.Tools -- (cooc2graph)
import Servant
import Servant.Job.Async
import Servant.XML
import qualified Data.Map as Map
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | There is no Delete specific API for Graph since it can be deleted -- | There is no Delete specific API for Graph since it can be deleted
-- as simple Node. -- as simple Node.
type GraphAPI = Get '[JSON] Graph type GraphAPI = Get '[JSON] Graph
:<|> Post '[JSON] [GraphId]
:<|> Put '[JSON] Int
:<|> "gexf" :> Get '[XML] (Headers '[Servant.Header "Content-Disposition" Text] Graph) :<|> "gexf" :> Get '[XML] (Headers '[Servant.Header "Content-Disposition" Text] Graph)
:<|> GraphAsyncAPI :<|> GraphAsyncAPI
:<|> "versions" :> GraphVersionsAPI :<|> "versions" :> GraphVersionsAPI
data GraphVersions = data GraphVersions =
GraphVersions { gv_graph :: Maybe Int GraphVersions { gv_graph :: Maybe Int
, gv_repo :: Int } , gv_repo :: Int }
...@@ -78,16 +74,13 @@ instance ToSchema GraphVersions ...@@ -78,16 +74,13 @@ instance ToSchema GraphVersions
graphAPI :: UserId -> NodeId -> GargServer GraphAPI graphAPI :: UserId -> NodeId -> GargServer GraphAPI
graphAPI u n = getGraph u n graphAPI u n = getGraph u n
:<|> postGraph n
:<|> putGraph n
:<|> getGraphGexf u n :<|> getGraphGexf u n
:<|> graphAsync u n :<|> graphAsync u n
:<|> graphVersionsAPI u n :<|> graphVersionsAPI u n
------------------------------------------------------------------------ ------------------------------------------------------------------------
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
let graph = nodeGraph ^. node_hyperdata . hyperdataGraph let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
-- let listVersion = graph ^? _Just -- let listVersion = graph ^? _Just
...@@ -98,9 +91,8 @@ getGraph uId nId = do ...@@ -98,9 +91,8 @@ getGraph uId nId = do
repo <- getRepo repo <- getRepo
-- let v = repo ^. r_version -- let v = repo ^. r_version
nodeUser <- getNodeUser (NodeId uId) -- nodeUser <- getNodeUser (NodeId uId)
-- let uId' = nodeUser ^. node_userId
let uId' = nodeUser ^. node_userId
let cId = maybe (panic "[ERR:G.V.G.API] Node has no parent") let cId = maybe (panic "[ERR:G.V.G.API] Node has no parent")
identity identity
...@@ -109,7 +101,7 @@ getGraph uId nId = do ...@@ -109,7 +101,7 @@ getGraph uId nId = do
g <- case graph of g <- case graph of
Nothing -> do Nothing -> do
graph' <- computeGraph cId NgramsTerms repo graph' <- computeGraph cId NgramsTerms repo
_ <- insertGraph cId uId' (HyperdataGraph $ Just graph') _ <- updateHyperdata nId (HyperdataGraph $ Just graph')
pure $ trace "Graph empty, computing" $ graph' pure $ trace "Graph empty, computing" $ graph'
Just graph' -> pure $ trace "Graph exists, returning" $ graph' Just graph' -> pure $ trace "Graph exists, returning" $ graph'
...@@ -120,12 +112,11 @@ getGraph uId nId = do ...@@ -120,12 +112,11 @@ getGraph uId nId = do
-- graph'' <- computeGraph cId NgramsTerms repo -- graph'' <- computeGraph cId NgramsTerms repo
-- _ <- updateHyperdata nId (HyperdataGraph $ Just graph'') -- _ <- updateHyperdata nId (HyperdataGraph $ Just graph'')
-- pure graph'' -- pure graph''
pure g pure g
recomputeGraph :: UserId -> NodeId -> GargNoServer Graph recomputeGraph :: UserId -> NodeId -> GargNoServer Graph
recomputeGraph uId nId = do recomputeGraph _uId nId = do
nodeGraph <- getNodeWith nId HyperdataGraph nodeGraph <- getNodeWith nId HyperdataGraph
let graph = nodeGraph ^. node_hyperdata . hyperdataGraph let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
let listVersion = graph ^? _Just let listVersion = graph ^? _Just
...@@ -136,9 +127,9 @@ recomputeGraph uId nId = do ...@@ -136,9 +127,9 @@ recomputeGraph uId nId = do
repo <- getRepo repo <- getRepo
let v = repo ^. r_version let v = repo ^. r_version
nodeUser <- getNodeUser (NodeId uId) -- nodeUser <- getNodeUser (NodeId uId)
let uId' = nodeUser ^. node_userId -- let uId' = nodeUser ^. node_userId
let cId = maybe (panic "[ERR:G.V.G.API] Node has no parent") let cId = maybe (panic "[ERR:G.V.G.API] Node has no parent")
identity identity
...@@ -147,8 +138,8 @@ recomputeGraph uId nId = do ...@@ -147,8 +138,8 @@ recomputeGraph uId nId = do
g <- case graph of g <- case graph of
Nothing -> do Nothing -> do
graph' <- computeGraph cId NgramsTerms repo graph' <- computeGraph cId NgramsTerms repo
_ <- insertGraph cId uId' (HyperdataGraph $ Just graph') _ <- updateHyperdata nId (HyperdataGraph $ Just graph')
pure $ trace "[recomputeGraph] Graph empty, computing" $ graph' pure $ trace "[recomputeGraph] Graph empty, computed" $ graph'
Just graph' -> if listVersion == Just v Just graph' -> if listVersion == Just v
then pure graph' then pure graph'
...@@ -187,15 +178,6 @@ computeGraph cId nt repo = do ...@@ -187,15 +178,6 @@ computeGraph cId nt repo = do
let graph' = set graph_metadata (Just metadata) graph let graph' = set graph_metadata (Just metadata) graph
pure graph' pure graph'
postGraph :: NodeId -> GargServer (Post '[JSON] [NodeId])
postGraph = undefined
putGraph :: NodeId -> GargServer (Put '[JSON] Int)
putGraph = undefined
------------------------------------------------------------ ------------------------------------------------------------
getGraphGexf :: UserId -> NodeId -> GargNoServer (Headers '[Servant.Header "Content-Disposition" Text] Graph) getGraphGexf :: UserId -> NodeId -> GargNoServer (Headers '[Servant.Header "Content-Disposition" Text] Graph)
...@@ -204,7 +186,6 @@ getGraphGexf uId nId = do ...@@ -204,7 +186,6 @@ getGraphGexf uId nId = do
pure $ addHeader (concat [ "attachment; filename=graph.gexf" ]) graph pure $ addHeader (concat [ "attachment; filename=graph.gexf" ]) graph
------------------------------------------------------------ ------------------------------------------------------------
type GraphAsyncAPI = Summary "Update graph" type GraphAsyncAPI = Summary "Update graph"
:> "async" :> "async"
:> AsyncJobsAPI ScraperStatus () ScraperStatus :> AsyncJobsAPI ScraperStatus () ScraperStatus
......
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