-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
{-# LANGUAGE OverloadedLists #-} -- allows to write Map and HashMap as lists
{-# LANGUAGE TypeOperators #-}
import Control.Lens (set, (^.), _Just, (^?))
import Data.Aeson
-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.Job.Async
-import Servant.XML
-
import Gargantext.API.Admin.Orchestrator.Types
-import Gargantext.API.Ngrams (NgramsRepo, r_version)
import Gargantext.API.Ngrams.Tools
+import Gargantext.API.Ngrams.Types (NgramsRepo, r_version)
import Gargantext.API.Prelude
+import Gargantext.Core.Methods.Distances (Distance(..), GraphMetric(..))
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.Node (mkNodeWithParent)
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 (getNodeUser)
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.Ngrams
import Gargantext.Database.Schema.Node (node_parentId, node_hyperdata, node_name, node_userId)
import Gargantext.Prelude
-import Gargantext.Core.Viz.Graph
-import Gargantext.Core.Viz.Graph.GEXF ()
-import Gargantext.Core.Viz.Graph.Tools -- (cooc2graph)
-import Gargantext.Core.Viz.Graph.Distances (Distance(..), GraphMetric(..))
-
+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.
getGraph :: UserId -> NodeId -> GargNoServer HyperdataGraphAPI
getGraph _uId nId = do
nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
- let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
+ let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
let camera = nodeGraph ^. node_hyperdata . hyperdataCamera
repo <- getRepo
mt <- defaultGraphMetadata cId "Title" repo
let graph'' = set graph_metadata (Just mt) graph'
let hg = HyperdataGraphAPI graph'' camera
- _ <- updateHyperdata nId hg
+ -- _ <- updateHyperdata nId hg
+ _ <- updateHyperdata nId (HyperdataGraph (Just graph'') camera)
pure $ trace "[G.V.G.API] Graph empty, computing" hg
Just graph' -> pure $ trace "[G.V.G.API] Graph exists, returning" $
recomputeGraph :: UserId -> NodeId -> Distance -> GargNoServer Graph
recomputeGraph _uId nId d = do
nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
- let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
+ let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
let camera = nodeGraph ^. node_hyperdata . hyperdataCamera
let graphMetadata = graph ^? _Just . graph_metadata . _Just
- let listVersion = graph ^? _Just . graph_metadata . _Just . gm_list . lfg_version
+ let listVersion = graph ^? _Just . graph_metadata . _Just . gm_list . lfg_version
repo <- getRepo
let v = repo ^. r_version
let ngs = filterListWithRoot MapTerm $ mapTermListRoot [lId] nt repo
-- TODO split diagonal
- myCooc <- Map.filter (>1)
+ myCooc <- HashMap.filter (>1)
<$> getCoocByNgrams (Diagonal True)
<$> groupNodesByNgrams ngs
- <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
+ <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
graph <- liftBase $ cooc2graph d 0 myCooc
graphVersionsAPI :: UserId -> NodeId -> GargServer GraphVersionsAPI
graphVersionsAPI u n =
- graphVersions u n
+ graphVersions n
:<|> recomputeVersions u n
-graphVersions :: UserId -> NodeId -> GargNoServer GraphVersions
-graphVersions _uId nId = do
+graphVersions :: NodeId -> GargNoServer GraphVersions
+graphVersions nId = do
nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
let listVersion = graph ^? _Just