[GRAPH] API update (WIP).

src/Gargantext/API/Ngrams.hs

@@ -83,6 +83,10 @@ module Gargantext.API.Ngrams
   , getNgramsTableMap
   , tableNgramsPull
   , tableNgramsPut
+
+  , Versioned(..)
+  , currentVersion
+  , listNgramsChangedSince
   )
   where
 

src/Gargantext/Database/Schema/Node.hs

@@ -44,6 +44,7 @@ import Gargantext.Database.Queries.Filter (limit', offset')
 import Gargantext.Database.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..))
 import Gargantext.Database.Utils
 import Gargantext.Prelude hiding (sum, head)
+import Gargantext.Viz.Graph (HyperdataGraph(..))
 
 import Opaleye hiding (FromField)
 import Opaleye.Internal.QueryArr (Query)
@@ -266,7 +267,6 @@ type NodeSearchReadNull =
     (Column (Nullable PGJsonb)      )
     (Column (Nullable PGTSVector)   )
 
---{-
 nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
 nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id         = optional "id"
                                       , _ns_typename   = required "typename"
@@ -280,7 +280,6 @@ nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id         = optio
                                       , _ns_search     = optional "search"
                                       }
                             )
---}
 
 queryNodeSearchTable :: Query NodeSearchRead
 queryNodeSearchTable = queryTable nodeTableSearch
@@ -434,7 +433,6 @@ nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name annuaire (Jus
     name     = maybe "Annuaire" identity maybeName
     annuaire = maybe defaultAnnuaire identity maybeAnnuaire
 
-
 ------------------------------------------------------------------------
 
 {-
@@ -498,7 +496,7 @@ nodeListModelW maybeName maybeListModel pId = node NodeListModel name list (Just
 
 ------------------------------------------------------------------------
 arbitraryGraph :: HyperdataGraph
-arbitraryGraph = HyperdataGraph (Just "Preferences")
+arbitraryGraph = HyperdataGraph Nothing
 
 nodeGraphW :: Maybe Name -> Maybe HyperdataGraph -> ParentId -> UserId -> NodeWrite
 nodeGraphW maybeName maybeGraph pId = node NodeGraph name graph (Just pId)
@@ -518,10 +516,8 @@ nodePhyloW maybeName maybePhylo pId = node NodePhylo name graph (Just pId)
 
 
 ------------------------------------------------------------------------
-
 arbitraryDashboard :: HyperdataDashboard
 arbitraryDashboard = HyperdataDashboard (Just "Preferences")
-
 ------------------------------------------------------------------------
 
 node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite

src/Gargantext/Database/Types/Node.hs

@@ -62,13 +62,13 @@ import           Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import           Gargantext.Viz.Phylo (Phylo)
 --import Gargantext.Database.Utils
 ------------------------------------------------------------------------
+
 newtype NodeId = NodeId Int
   deriving (Show, Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON)
 
 instance ToField NodeId where
   toField (NodeId n) = toField n
 
-
 instance FromField NodeId where
   fromField field mdata = do
     n <- fromField field mdata
@@ -78,6 +78,7 @@ instance FromField NodeId where
 
 instance ToSchema NodeId
 
+
 type NodeTypeId   = Int
 type NodeName     = Text
 type TSVector     = Text
@@ -103,7 +104,6 @@ $(makeLenses ''NodePoly)
 type Node json   = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
 
 
-
 ------------------------------------------------------------------------
 
 
@@ -401,13 +401,6 @@ $(deriveJSON (unPrefix "hyperdataDashboard_") ''HyperdataDashboard)
 
 instance Hyperdata HyperdataDashboard
 
--- TODO add the Graph Structure here
-data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences   :: !(Maybe Text)
-                                   } deriving (Show, Generic)
-$(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
-
-instance Hyperdata HyperdataGraph
-
 ------------------------------------------------------------------------
 
 -- TODO add the Graph Structure here

src/Gargantext/Viz/Graph.hs

@@ -9,6 +9,7 @@ Portability : POSIX
 
 -}
 
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE DeriveGeneric     #-}
@@ -26,7 +27,7 @@ import GHC.Generics (Generic)
 import GHC.IO (FilePath)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Core.Types (ListId)
-import Gargantext.Database.Types.Node (NodeId)
+import Gargantext.Database.Types.Node (NodeId, Hyperdata)
 import Gargantext.Prelude
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
@@ -87,6 +88,7 @@ data GraphMetadata = GraphMetadata { _gm_title    :: Text   -- title of the grap
                                    , _gm_corpusId :: [NodeId]  -- we can map with different corpus
                                    , _gm_legend :: [LegendField] -- legend of the Graph
                                    , _gm_listId :: ListId
+                                   , _gm_version :: Int
                                    }
   deriving (Show, Generic)
 $(deriveJSON (unPrefix "_gm_") ''GraphMetadata)
@@ -143,6 +145,15 @@ data GraphV3 = GraphV3 { go_links :: [EdgeV3]
 $(deriveJSON (unPrefix "go_") ''GraphV3)
 
 -----------------------------------------------------------
+
+data HyperdataGraph = HyperdataGraph { _hyperdataGraph :: !(Maybe Graph)
+                                   } deriving (Show, Generic)
+$(deriveJSON (unPrefix "") ''HyperdataGraph)
+
+instance Hyperdata HyperdataGraph
+makeLenses ''HyperdataGraph
+
+
 -----------------------------------------------------------
 
 graphV3ToGraph :: GraphV3 -> Graph

src/Gargantext/Viz/Graph/API.hs

@@ -24,8 +24,9 @@ Portability : POSIX
 module Gargantext.Viz.Graph.API
   where
 
-import Control.Lens (set)
+import Control.Lens -- (set, (^.), (_Just), (^?))
 import Control.Monad.IO.Class (liftIO)
+import Gargantext.API.Ngrams (currentVersion, listNgramsChangedSince, Versioned(..))
 import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Types
 import Gargantext.Core.Types.Main
@@ -61,30 +62,47 @@ graphAPI n =  getGraph  n
 getGraph :: NodeId -> GargServer (Get '[JSON] Graph)
 getGraph nId = do
   nodeGraph <- getNode nId HyperdataGraph
-  -- get HyperdataGraphp from Database
-  -- if Nothing else if version == current version then compute
+  let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
+  let graphVersion = graph ^? _Just
+                            . graph_metadata
+                            . _Just
+                            . gm_version
 
-  let cId = maybe (panic "no parentId") identity $ _node_parentId nodeGraph
+  v <- currentVersion
+
+  let cId = maybe (panic "[ERR:G.V.G.API] Node has no parent")
+                  identity
+                  $ nodeGraph ^. node_parentId
+
+  case graph of
+    Nothing     -> computeGraph 0 nId NgramsTerms v
+    Just graph' -> if graphVersion == Just v
+                     then pure graph'
+                     else computeGraph 0 nId NgramsTerms v
+
+computeGraph cId nId nt v = do
   lId  <- defaultList cId
 
-  let metadata = GraphMetadata "Title" [maybe 0 identity $ _node_parentId nodeGraph]
+  let metadata = GraphMetadata "Title" [cId]
                                      [ LegendField 1 "#FFF" "Cluster"
                                      , LegendField 2 "#FFF" "Cluster"
                                      ]
                                 lId
+                                v
                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
 
   lIds <- selectNodesWithUsername NodeList userMaster
-  ngs  <- filterListWithRoot GraphTerm <$> mapTermListRoot [lId] NgramsTerms
+  ngs  <- filterListWithRoot GraphTerm <$> mapTermListRoot [lId] nt
 
   myCooc <- Map.filter (>1) <$> getCoocByNgrams (Diagonal False)
                             <$> groupNodesByNgrams ngs
-                            <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) NgramsTerms (Map.keys ngs)
+                            <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
 
   graph <- liftIO $ cooc2graph 0 myCooc
   pure $ set graph_metadata (Just metadata) graph
 
 
+
 postGraph :: NodeId -> GargServer (Post '[JSON] [NodeId])
 postGraph = undefined