[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

src/Gargantext/Viz/Graph.hs

@@ -17,6 +17,7 @@ module Gargantext.Viz.Graph
   where
 
 ------------------------------------------------------------------------
+import Control.Lens (makeLenses)
 import GHC.IO (FilePath)
 import GHC.Generics (Generic)
 import Data.Aeson.TH (deriveJSON)
@@ -31,7 +32,7 @@ import qualified Data.Text as T
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 
-import Data.Swagger (ToSchema)
+import Data.Swagger
 
 import Gargantext.Prelude
 import Gargantext.Core.Types (Label)
@@ -48,10 +49,12 @@ data TypeNode = Terms | Unknown
   deriving (Show, Generic)
 
 $(deriveJSON (unPrefix "") ''TypeNode)
+instance ToSchema TypeNode
 
 data Attributes = Attributes { clust_default :: Int }
   deriving (Show, Generic)
 $(deriveJSON (unPrefix "") ''Attributes)
+instance ToSchema Attributes
 
 data Node = Node { node_size  :: Int
                  , node_type  :: TypeNode
@@ -61,6 +64,11 @@ data Node = Node { node_size  :: Int
                  }
   deriving (Show, Generic)
 $(deriveJSON (unPrefix "node_") ''Node)
+instance ToSchema Node where
+  declareNamedSchema =
+    genericDeclareNamedSchema
+      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 5 fieldLabel}
+
 
 data Edge = Edge { edge_source :: Text
                  , edge_target :: Text
@@ -69,22 +77,54 @@ data Edge = Edge { edge_source :: Text
                  }
   deriving (Show, Generic)
 $(deriveJSON (unPrefix "edge_") ''Edge)
+instance ToSchema Edge where
+  declareNamedSchema =
+    genericDeclareNamedSchema
+      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 5 fieldLabel}
+
+---------------------------------------------------------------
+data LegendField = LegendField { _lf_id :: Int
+                               , _lf_color :: Text
+                               , _lf_label :: Text
+   } deriving (Show, Generic)
+$(deriveJSON (unPrefix "_lf_") ''LegendField)
+
+instance ToSchema LegendField where
+  declareNamedSchema =
+    genericDeclareNamedSchema
+      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
+
+makeLenses ''LegendField
+--
+data GraphMetadata = GraphMetadata { _gm_title    :: Text   -- title of the graph
+                                   , _gm_corpusId :: [Int]  -- we can map with different corpus
+                                   , _gm_legend :: [LegendField] -- legend of the Graph
+                                   }
+  deriving (Show, Generic)
+$(deriveJSON (unPrefix "_gm_") ''GraphMetadata)
+instance ToSchema GraphMetadata where
+  declareNamedSchema =
+    genericDeclareNamedSchema
+      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
+makeLenses ''GraphMetadata
 
-data Graph = Graph { graph_nodes :: [Node]
-                   , graph_edges :: [Edge]
+
+data Graph = Graph { _graph_nodes :: [Node]
+                   , _graph_edges :: [Edge]
+                   , _graph_metadata :: Maybe GraphMetadata
                    }
   deriving (Show, Generic)
-$(deriveJSON (unPrefix "graph_") ''Graph)
+$(deriveJSON (unPrefix "_graph_") ''Graph)
+makeLenses ''Graph
+
+instance ToSchema Graph where
+  declareNamedSchema =
+    genericDeclareNamedSchema
+      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 7 fieldLabel}
 
--- | Intances for Swagger documentation
-instance ToSchema Node
-instance ToSchema TypeNode
-instance ToSchema Attributes
-instance ToSchema Edge
-instance ToSchema Graph
 
 defaultGraph :: Graph
-defaultGraph = Graph {graph_nodes = [Node {node_size = 4, node_type = Terms, node_id = pack "0", node_label = pack "animal", node_attributes = Attributes {clust_default = 0}},Node {node_size = 3, node_type = Terms, node_id = pack "1", node_label = pack "bird", node_attributes = Attributes {clust_default = 0}},Node {node_size = 2, node_type = Terms, node_id = pack "2", node_label = pack "boy", node_attributes = Attributes {clust_default = 1}},Node {node_size = 2, node_type = Terms, node_id = pack "3", node_label = pack "dog", node_attributes = Attributes {clust_default = 0}},Node {node_size = 2, node_type = Terms, node_id = pack "4", node_label = pack "girl", node_attributes = Attributes {clust_default = 1}},Node {node_size = 4, node_type = Terms, node_id = pack "5", node_label = pack "human body", node_attributes = Attributes {clust_default = 1}},Node {node_size = 3, node_type = Terms, node_id = pack "6", node_label = pack "object", node_attributes = Attributes {clust_default = 2}},Node {node_size = 2, node_type = Terms, node_id = pack "7", node_label = pack "pen", node_attributes = Attributes {clust_default = 2}},Node {node_size = 2, node_type = Terms, node_id = pack "8", node_label = pack "table", node_attributes = Attributes {clust_default = 2}}], graph_edges = [Edge {edge_source = pack "0", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "0"},Edge {edge_source = pack "1", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "1"},Edge {edge_source = pack "1", edge_target = pack "1", edge_weight = 1.0, edge_id = pack "2"},Edge {edge_source = pack "2", edge_target = pack "2", edge_weight = 1.0, edge_id = pack "3"},Edge {edge_source = pack "2", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "4"},Edge {edge_source = pack "3", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "5"},Edge {edge_source = pack "3", edge_target = pack "1", edge_weight = 1.0, edge_id = pack "6"},Edge {edge_source = pack "3", edge_target = pack "3", edge_weight = 1.0, edge_id = pack "7"},Edge {edge_source = pack "4", edge_target = pack "4", edge_weight = 1.0, edge_id = pack "8"},Edge {edge_source = pack "4", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "9"},Edge {edge_source = pack "5", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "10"},Edge {edge_source = pack "6", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "11"},Edge {edge_source = pack "7", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "12"},Edge {edge_source = pack "7", edge_target = pack "7", edge_weight = 1.0, edge_id = pack "13"},Edge {edge_source = pack "8", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "14"},Edge {edge_source = pack "8", edge_target = pack "7", edge_weight = 1.0, edge_id = pack "15"},Edge {edge_source = pack "8", edge_target = pack "8", edge_weight = 1.0, edge_id = pack "16"}]}
+defaultGraph = Graph {_graph_nodes = [Node {node_size = 4, node_type = Terms, node_id = pack "0", node_label = pack "animal", node_attributes = Attributes {clust_default = 0}},Node {node_size = 3, node_type = Terms, node_id = pack "1", node_label = pack "bird", node_attributes = Attributes {clust_default = 0}},Node {node_size = 2, node_type = Terms, node_id = pack "2", node_label = pack "boy", node_attributes = Attributes {clust_default = 1}},Node {node_size = 2, node_type = Terms, node_id = pack "3", node_label = pack "dog", node_attributes = Attributes {clust_default = 0}},Node {node_size = 2, node_type = Terms, node_id = pack "4", node_label = pack "girl", node_attributes = Attributes {clust_default = 1}},Node {node_size = 4, node_type = Terms, node_id = pack "5", node_label = pack "human body", node_attributes = Attributes {clust_default = 1}},Node {node_size = 3, node_type = Terms, node_id = pack "6", node_label = pack "object", node_attributes = Attributes {clust_default = 2}},Node {node_size = 2, node_type = Terms, node_id = pack "7", node_label = pack "pen", node_attributes = Attributes {clust_default = 2}},Node {node_size = 2, node_type = Terms, node_id = pack "8", node_label = pack "table", node_attributes = Attributes {clust_default = 2}}], _graph_edges = [Edge {edge_source = pack "0", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "0"},Edge {edge_source = pack "1", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "1"},Edge {edge_source = pack "1", edge_target = pack "1", edge_weight = 1.0, edge_id = pack "2"},Edge {edge_source = pack "2", edge_target = pack "2", edge_weight = 1.0, edge_id = pack "3"},Edge {edge_source = pack "2", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "4"},Edge {edge_source = pack "3", edge_target = pack "0", edge_weight = 1.0, edge_id = pack "5"},Edge {edge_source = pack "3", edge_target = pack "1", edge_weight = 1.0, edge_id = pack "6"},Edge {edge_source = pack "3", edge_target = pack "3", edge_weight = 1.0, edge_id = pack "7"},Edge {edge_source = pack "4", edge_target = pack "4", edge_weight = 1.0, edge_id = pack "8"},Edge {edge_source = pack "4", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "9"},Edge {edge_source = pack "5", edge_target = pack "5", edge_weight = 1.0, edge_id = pack "10"},Edge {edge_source = pack "6", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "11"},Edge {edge_source = pack "7", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "12"},Edge {edge_source = pack "7", edge_target = pack "7", edge_weight = 1.0, edge_id = pack "13"},Edge {edge_source = pack "8", edge_target = pack "6", edge_weight = 1.0, edge_id = pack "14"},Edge {edge_source = pack "8", edge_target = pack "7", edge_weight = 1.0, edge_id = pack "15"},Edge {edge_source = pack "8", edge_target = pack "8", edge_weight = 1.0, edge_id = pack "16"}], _graph_metadata = Nothing}
 
 -- | Intances for the mack
 instance Arbitrary Graph where
@@ -127,7 +167,7 @@ data2graph :: [(Label, Int)] -> Map (Int, Int) Int
                              -> Map (Int, Int) Double
                              -> [LouvainNode]
               -> Graph
-data2graph labels coocs distance partitions = Graph nodes edges
+data2graph labels coocs distance partitions = Graph nodes edges Nothing
   where
     community_id_by_node_id = M.fromList [ (n, c) | LouvainNode n c <- partitions ]
     nodes = [ Node { node_size = maybe 0 identity (M.lookup (n,n) coocs)
@@ -147,7 +187,7 @@ data2graph labels coocs distance partitions = Graph nodes edges
 -----------------------------------------------------------
 
 graphV3ToGraph :: GraphV3 -> Graph
-graphV3ToGraph (GraphV3 links nodes) = Graph (map nodeV32node nodes) (zipWith linkV32edge [1..] links)
+graphV3ToGraph (GraphV3 links nodes) = Graph (map nodeV32node nodes) (zipWith linkV32edge [1..] links) Nothing
   where
     nodeV32node :: NodeV3 -> Node
     nodeV32node (NodeV3 no_id' (AttributesV3 cl') no_s' no_lb')