[API][FLOW][Upload] just for CsvHal
[gargantext.git] / src / Gargantext / Viz / Graph / API.hs
index 38b53d0170995be185e3ff198bcbde0705e957cd..0a7d1a817eaeaa63678c4ffc876c00da3ffc3442 100644 (file)
@@ -12,26 +12,34 @@ Portability : POSIX
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-{-# LANGUAGE RankNTypes         #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}   -- allows to write Text literals
 {-# LANGUAGE OverloadedLists   #-}   -- allows to write Map and HashMap as lists
-{-# LANGUAGE DataKinds            #-}
-{-# LANGUAGE TypeOperators      #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE TypeOperators     #-}
 
 module Gargantext.Viz.Graph.API
   where
 
-import Control.Lens (set)
+import Debug.Trace (trace)
+import Control.Lens (set, (^.), _Just, (^?))
 import Control.Monad.IO.Class (liftIO)
+import Data.Maybe (Maybe(..))
+import Gargantext.API.Ngrams (NgramsRepo, r_version)
 import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Types
 import Gargantext.Core.Types.Main
+import Gargantext.Database.Config
 import Gargantext.Database.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
 import Gargantext.Database.Schema.Ngrams
-import Gargantext.Database.Schema.Node ( getNode)
-import Gargantext.Database.Schema.Node (defaultList)
-import Gargantext.Database.Types.Node -- (GraphId, ListId, CorpusId, NodeId)
+import Gargantext.Database.Node.Select
+import Gargantext.Database.Schema.Node (getNodeWith, defaultList, insertGraph, HasNodeError)
+import Gargantext.Database.Types.Node hiding (node_id) -- (GraphId, ListId, CorpusId, NodeId)
+import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
+import Gargantext.Database.Utils (Cmd)
 import Gargantext.Prelude
 import Gargantext.Viz.Graph
 import Gargantext.Viz.Graph.Tools -- (cooc2graph)
@@ -47,32 +55,72 @@ type GraphAPI   =  Get  '[JSON] Graph
               :<|> Put  '[JSON] Int
 
 
-graphAPI :: NodeId -> GargServer GraphAPI
-graphAPI n =  getGraph  n
+graphAPI :: UserId -> NodeId -> GargServer GraphAPI
+graphAPI u n =  getGraph  u n
          :<|> postGraph n
          :<|> putGraph  n
 
 ------------------------------------------------------------------------
 
-getGraph :: NodeId -> GargServer (Get '[JSON] Graph)
-getGraph nId = do
-  nodeGraph <- getNode nId HyperdataGraph
-
-  let metadata = GraphMetadata "Title" [maybe 0 identity $ _node_parentId nodeGraph]
+getGraph :: UserId -> NodeId -> GargServer (Get '[JSON] Graph)
+getGraph uId nId = do
+  nodeGraph <- getNodeWith nId HyperdataGraph
+  let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
+  let listVersion = graph ^? _Just
+                            . graph_metadata
+                            . _Just
+                            . gm_list
+                            . lfg_version
+
+  repo <- getRepo
+  let v = repo ^. r_version
+  nodeUser <- getNodeWith (NodeId uId) HyperdataUser
+
+  let uId' = nodeUser ^. node_userId
+
+  let cId = maybe (panic "[ERR:G.V.G.API] Node has no parent")
+                  identity
+                  $ nodeGraph ^. node_parentId
+
+  g <- case graph of
+    Nothing     -> do
+      graph' <- computeGraph cId NgramsTerms repo
+      _ <- insertGraph cId uId' (HyperdataGraph $ Just graph')
+      pure graph'
+
+    Just graph' -> if listVersion == Just v
+                     then pure graph'
+                     else do
+                       graph'' <- computeGraph cId NgramsTerms repo
+                       _ <- updateHyperdata nId (HyperdataGraph $ Just graph'')
+                       pure graph''
+  pure $ trace ("salut" <> show g) $ g
+
+
+-- TODO use Database Monad only here ?
+computeGraph :: HasNodeError err => CorpusId -> NgramsType -> NgramsRepo -> Cmd err Graph
+computeGraph cId nt repo = do
+  lId  <- defaultList cId
+
+  let metadata = GraphMetadata "Title" [cId]
                                      [ LegendField 1 "#FFF" "Cluster"
                                      , LegendField 2 "#FFF" "Cluster"
                                      ]
+                                (ListForGraph lId (repo ^. r_version))
                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
-  let cId = maybe (panic "no parentId") identity $ _node_parentId nodeGraph
 
-  lId <- defaultList cId
-  ngs    <- filterListWithRoot GraphTerm <$> mapTermListRoot [lId] NgramsTerms
+  lIds <- selectNodesWithUsername NodeList userMaster
+  let ngs = filterListWithRoot GraphTerm $ mapTermListRoot [lId] nt repo
+
+  myCooc <- Map.filter (>1)
+         <$> getCoocByNgrams (Diagonal True)
+         <$> groupNodesByNgrams ngs
+         <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
 
-  myCooc <- Map.filter (>1) <$> getCoocByNgrams (Diagonal False)
-                            <$> groupNodesByNgrams ngs
-                            <$> getNodesByNgramsOnlyUser cId NgramsTerms (Map.keys ngs)
+  graph <- liftIO $ cooc2graph 0 myCooc
+  let graph' = set graph_metadata (Just metadata) graph
+  pure graph'
 
-  liftIO $ set graph_metadata (Just metadata) <$> cooc2graph myCooc
 
 
 postGraph :: NodeId -> GargServer (Post '[JSON] [NodeId])
@@ -81,8 +129,3 @@ postGraph = undefined
 putGraph :: NodeId -> GargServer (Put '[JSON] Int)
 putGraph = undefined
 
-
-
-
--- | Instances
-