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