[API] Graph with metadata.

src/Gargantext/API/Node.hs

@@ -32,7 +32,7 @@ module Gargantext.API.Node
   , HyperdataDocumentV3(..)
   ) where
 -------------------------------------------------------------------
-import Control.Lens (prism')
+import Control.Lens (prism', set)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad ((>>))
 --import System.IO (putStrLn, readFile)
@@ -60,7 +60,7 @@ import Gargantext.Database.Tree (treeDB, HasTreeError(..), TreeError(..))
 import Gargantext.Database.Schema.NodeNode (nodesToFavorite, nodesToTrash)
 -- Graph
 --import Gargantext.Text.Flow
-import Gargantext.Viz.Graph (Graph,readGraphFromJson,defaultGraph)
+import Gargantext.Viz.Graph hiding (Node)-- (Graph(_graph_metadata),LegendField(..), GraphMetadata(..),readGraphFromJson,defaultGraph)
 -- import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types (Offset, Limit)
 import Gargantext.Core.Types.Main (Tree, NodeTree, ListId, CorpusId, ContactId)
@@ -246,8 +246,23 @@ type ChartApi = Summary " Chart API"
 ------------------------------------------------------------------------
 type GraphAPI   = Get '[JSON] Graph
 graphAPI :: Connection -> NodeId -> Server GraphAPI
-graphAPI _ _ = do
-  liftIO $ maybe defaultGraph identity <$> readGraphFromJson "purescript-gargantext/dist/examples/imtNew.json"
+graphAPI c nId = liftIO $ graphAPI' c nId
+
+graphAPI' :: Connection -> NodeId -> IO Graph
+graphAPI' c nId = do
+  
+  nodeGraph <- getNode c nId HyperdataGraph
+
+  let metadata = GraphMetadata "Title" [maybe 0 identity $ _node_parentId nodeGraph] 
+                                       [ LegendField 1 "#FFFFFF" "Label 1"
+                                       , LegendField 2 "#0048BA" "Label 2"
+                                       ]
+
+  graph <- set graph_metadata (Just metadata) <$> maybe defaultGraph identity <$> readGraphFromJson "purescript-gargantext/dist/examples/imtNew.json"
+  
+  pure graph
+
+
   -- t <- textFlow (Mono EN) (Contexts contextText)
   -- liftIO $ liftIO $ pure $  maybe t identity maybeGraph
   -- TODO what do we get about the node? to replace contextText

src/Gargantext/Database/Schema/Node.hs

@@ -77,6 +77,10 @@ instance FromField HyperdataList
   where
     fromField = fromField'
 
+instance FromField HyperdataGraph
+  where
+    fromField = fromField'
+
 instance FromField HyperdataAnnuaire
   where
     fromField = fromField'
@@ -105,6 +109,10 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataList
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
+instance QueryRunnerColumnDefault PGJsonb HyperdataGraph
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+
 instance QueryRunnerColumnDefault PGJsonb HyperdataAnnuaire
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn

src/Gargantext/Database/TextSearch.hs

@@ -23,12 +23,13 @@ import Database.PostgreSQL.Simple.ToField
 import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Types.Node (NodeType(..))
 import Gargantext.Prelude
-import Gargantext.Database.Node.Contact
+--import Gargantext.Database.Node.Contact
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.NodeNode
 import Gargantext.Database.Schema.NodeNgram
-import Gargantext.Database.Queries.Join (leftJoin6, leftJoin3')
+import Gargantext.Database.Queries.Join (leftJoin6)
+import Gargantext.Text.Terms.Mono.Stem.En (stemIt)
 import Gargantext.Core.Types
 import Control.Arrow (returnA)
 import qualified Opaleye as O hiding (Order)
@@ -74,14 +75,14 @@ searchInCorpusWithContacts c cId q = runQuery c $ queryInCorpusWithContacts cId
 
 queryInCorpusWithContacts :: CorpusId -> Text -> O.Query ((Column PGInt4, Column PGJsonb), (Column (PGInt4), Column (Nullable PGText)))
 queryInCorpusWithContacts cId q = proc () -> do
-  (docs, (corpusDoc, (docNgrams, (ngrams, (ngramsContact, contacts))))) <- joinInCorpusWithContacts -< ()
+  (docs, (corpusDoc, (docNgrams, (ngrams', (_, contacts))))) <- joinInCorpusWithContacts -< ()
   restrict -< (_ns_search docs)              @@ (pgTSQuery  $ unpack q  )
   restrict -< (_ns_typename docs)           .== (pgInt4 $ nodeTypeId NodeDocument)
   restrict -< (nodeNode_node1_id corpusDoc) .== (toNullable $ pgInt4 cId)
   restrict -< (nodeNgram_type docNgrams)    .== (toNullable $ pgInt4 $ ngramsTypeId Authors)
   restrict -< (_node_typename contacts)     .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
   -- let contact_id    = ifThenElse (isNull $ _node_id contacts) (toNullable $ pgInt4 0) (_node_id contacts)
-  returnA  -< ((_ns_id docs, _ns_hyperdata docs),(fromNullable (pgInt4 0) (_node_id contacts), ngrams_terms ngrams))
+  returnA  -< ((_ns_id docs, _ns_hyperdata docs),(fromNullable (pgInt4 0) (_node_id contacts), ngrams_terms ngrams'))
 
 joinInCorpusWithContacts :: O.Query (NodeSearchRead, (NodeNodeReadNull, (NodeNgramReadNull, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull)))))
 joinInCorpusWithContacts = leftJoin6 queryNodeTable queryNodeNgramTable queryNgramsTable queryNodeNgramTable queryNodeNodeTable queryNodeSearchTable cond12 cond23 cond34 cond45 cond56
@@ -125,7 +126,7 @@ newtype TSQuery = UnsafeTSQuery [Text]
 
 -- | TODO [""] -> panic "error"
 toTSQuery :: [Text] -> TSQuery
-toTSQuery txt = UnsafeTSQuery txt
+toTSQuery txt = UnsafeTSQuery $ map stemIt txt
 
 
 instance IsString TSQuery