[graph] some refactoring of Core.Viz.Graph

gargantext.cabal

 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.1.
+-- This file has been generated from package.yaml by hpack version 0.34.7.
 --
 -- see: https://github.com/sol/hpack
 
 name:           gargantext
-version: 0.0.6.9.1
+version:        0.0.6.9.1
 synopsis:       Search, map, share
 description:    Please see README.md
 category:       Data
@@ -232,6 +232,7 @@ library
       Gargantext.Core.Viz.Graph.FGL
       Gargantext.Core.Viz.Graph.GEXF
       Gargantext.Core.Viz.Graph.Legend
+      Gargantext.Core.Viz.Graph.PatriciaTreeTypes
       Gargantext.Core.Viz.Graph.Tools.Infomap
       Gargantext.Core.Viz.Graph.Types
       Gargantext.Core.Viz.Graph.Utils

src/Gargantext/API/GraphQL/Context.hs

@@ -184,7 +184,7 @@ toHyperdataRowDocumentGQL hyperdata =
                                      , hrd_uniqId             = _hr_uniqId
                                      , hrd_uniqIdBdd          = _hr_uniqIdBdd
                                      }
-    HyperdataRowContact _ _ _ -> Nothing
+    HyperdataRowContact { } -> Nothing
 
 updateNodeContextCategory :: (HasConnectionPool env, HasConfig env, HasMail env, HasSettings env) =>
                              NodeContextCategoryMArgs -> GqlM' e env [Int]

src/Gargantext/API/Node/Update.hs

@@ -29,9 +29,9 @@ import Gargantext.API.Ngrams.List (reIndexWith)
 import Gargantext.API.Prelude (GargM, GargError, simuLogs)
 import Gargantext.Core.Methods.Similarities (GraphMetric(..))
 import Gargantext.Core.Types.Main (ListType(..))
-import Gargantext.Core.Viz.Graph (Strength)
 import Gargantext.Core.Viz.Graph.API (recomputeGraph)
 import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..), BridgenessMethod(..))
+import Gargantext.Core.Viz.Graph.Types (Strength)
 import Gargantext.Core.Viz.Phylo (PhyloSubConfig(..), subConfig2config)
 import Gargantext.Core.Viz.Phylo.API.Tools (flowPhyloAPI)
 import Gargantext.Database.Action.Flow.Pairing (pairing)

src/Gargantext/Core/Viz.hs

@@ -14,4 +14,3 @@ Vizualisation of text stats
 
 module Gargantext.Core.Viz
   where
-

src/Gargantext/Core/Viz/Graph.hs

@@ -9,7 +9,6 @@ Portability : POSIX
 
 -}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE TemplateHaskell      #-}
 
 module Gargantext.Core.Viz.Graph
@@ -17,244 +16,16 @@ module Gargantext.Core.Viz.Graph
 
 import Data.ByteString.Lazy as DBL (readFile, writeFile)
 import Data.HashMap.Strict (HashMap, lookup)
-import Data.HashSet (HashSet)
-import Data.Text (pack)
 import GHC.IO (FilePath)
 import Gargantext.API.Ngrams.Types (NgramsTerm(..), NgramsRepoElement(..), mSetToList)
-import Gargantext.Core.Methods.Similarities (GraphMetric)
-import Gargantext.Core.Types (ListId)
+import Gargantext.Core.Viz.Graph.Types
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude
-import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Prelude
 import qualified Data.Aeson   as DA
-import qualified Data.HashSet as HashSet
 import qualified Data.Text    as Text
 import qualified Text.Read    as Text
 
-data TypeNode = Terms | Unknown
-  deriving (Show, Generic)
-
-instance ToJSON TypeNode
-instance FromJSON 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  :: NgramsType -- TypeNode -- TODO NgramsType | Person
-                 , node_id    :: Text     -- TODO NgramId
-                 , node_label :: Text
-                 , node_x_coord :: Double
-                 , node_y_coord :: Double
-                 , node_attributes :: Attributes
-                 , node_children :: [Text]
-                 }
-  deriving (Show, Generic)
-$(deriveJSON (unPrefix "node_") ''Node)
-instance ToSchema Node where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "node_")
-
-
-data Edge = Edge { edge_source :: Text
-                 , edge_target :: Text
-                 , edge_weight :: Double
-                 , edge_confluence :: Double
-                 , edge_id     :: Text
-                 }
-  deriving (Show, Generic)
-
-$(deriveJSON (unPrefix "edge_") ''Edge)
-
-instance ToSchema Edge where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "edge_")
-
----------------------------------------------------------------
-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 (unPrefixSwagger "_lf_")
-
-makeLenses ''LegendField
-
----------------------------------------------------------------
-data Partite = Partite { _partite_nodes :: HashSet NgramsTerm
-                       , _partite_type :: NgramsType
-                       }
-  deriving (Show, Generic)
-$(deriveJSON (unPrefix "_partite_") ''Partite)
-instance ToSchema Partite where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_partite_")
-makeLenses ''Partite
-
-
-data MultiPartite = MultiPartite { _multipartite_data1 :: Partite
-                                 , _multipartite_data2 :: Partite
-                                 }
-  deriving (Show, Generic)
-$(deriveJSON (unPrefix "_multipartite_") ''MultiPartite)
-instance ToSchema MultiPartite where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_multipartite_")
-makeLenses ''MultiPartite
-
-defaultMultipartite :: MultiPartite
-defaultMultipartite = MultiPartite a a
-  where
-    a = Partite HashSet.empty NgramsTerms
-
----------------------------------------------------------------
-
-type Version = Int
-data ListForGraph =
-  ListForGraph { _lfg_listId  :: ListId
-               , _lfg_version :: Version
-               } deriving (Show, Generic)
-$(deriveJSON (unPrefix "_lfg_") ''ListForGraph)
-
-instance ToSchema ListForGraph where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_lfg_")
-
-makeLenses ''ListForGraph
-
-data Strength = Strong | Weak
-    deriving (Generic, Eq, Ord, Enum, Bounded, Show)
-
-$(deriveJSON (unPrefix "") ''Strength)
-instance ToSchema Strength where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
-
-instance Arbitrary Strength where
-  arbitrary = elements $ [Strong, Weak]
-
-
-
-data GraphMetadata =
-  GraphMetadata { _gm_title            :: Text          -- title of the graph
-                , _gm_metric           :: GraphMetric
-                , _gm_edgesStrength    :: Maybe Strength
-                , _gm_corpusId         :: [NodeId]      -- we can map with different corpus
-                , _gm_legend           :: [LegendField] -- legend of the Graph
-                , _gm_list             :: ListForGraph
-                , _gm_startForceAtlas  :: Bool
-                -- , _gm_nodesTypes       :: Maybe (NgramsType, NgramsType)
-                -- , _gm_version       :: Int
-                }
-  deriving (Show, Generic)
-$(deriveJSON (unPrefix "_gm_") ''GraphMetadata)
-instance ToSchema GraphMetadata where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_gm_")
-makeLenses ''GraphMetadata
-
-
-
-data Graph = Graph { _graph_nodes    :: [Node]
-                   , _graph_edges    :: [Edge]
-                   , _graph_metadata :: Maybe GraphMetadata
-                   }
-  deriving (Show, Generic)
-$(deriveJSON (unPrefix "_graph_") ''Graph)
-makeLenses ''Graph
-
-instance ToSchema Graph where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_graph_")
-
--- | Intances for the mock
-instance Arbitrary Graph where
-  arbitrary = elements $ [defaultGraph]
-
-defaultGraph :: Graph
-defaultGraph = Graph {_graph_nodes = [Node {node_x_coord=0, node_y_coord=0, node_size = 4, node_type = NgramsTerms, node_id = pack "0", node_label = pack "animal", node_attributes = Attributes {clust_default = 0}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 3, node_type = NgramsTerms, node_id = pack "1", node_label = pack "bird", node_attributes = Attributes {clust_default = 0}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "2", node_label = pack "boy", node_attributes = Attributes {clust_default = 1}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "3", node_label = pack "dog", node_attributes = Attributes {clust_default = 0}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "4", node_label = pack "girl", node_attributes = Attributes {clust_default = 1}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 4, node_type = NgramsTerms, node_id = pack "5", node_label = pack "human body", node_attributes = Attributes {clust_default = 1}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 3, node_type = NgramsTerms, node_id = pack "6", node_label = pack "object", node_attributes = Attributes {clust_default = 2}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "7", node_label = pack "pen", node_attributes = Attributes {clust_default = 2}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "8", node_label = pack "table", node_attributes = Attributes {clust_default = 2}, node_children = []}], _graph_edges = [Edge {edge_source = pack "0", edge_target = pack "0", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "0"},Edge {edge_source = pack "1", edge_target = pack "0", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "1"},Edge {edge_source = pack "1", edge_target = pack "1", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "2"},Edge {edge_source = pack "2", edge_target = pack "2", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "3"},Edge {edge_source = pack "2", edge_target = pack "5", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "4"},Edge {edge_source = pack "3", edge_target = pack "0", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "5"},Edge {edge_source = pack "3", edge_target = pack "1", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "6"},Edge {edge_source = pack "3", edge_target = pack "3", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "7"},Edge {edge_source = pack "4", edge_target = pack "4", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "8"},Edge {edge_source = pack "4", edge_target = pack "5", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "9"},Edge {edge_source = pack "5", edge_target = pack "5", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "10"},Edge {edge_source = pack "6", edge_target = pack "6", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "11"},Edge {edge_source = pack "7", edge_target = pack "6", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "12"},Edge {edge_source = pack "7", edge_target = pack "7", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "13"},Edge {edge_source = pack "8", edge_target = pack "6", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "14"},Edge {edge_source = pack "8", edge_target = pack "7", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "15"},Edge {edge_source = pack "8", edge_target = pack "8", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "16"}], _graph_metadata = Nothing}
-
-
------------------------------------------------------------
--- V3 Gargantext Version
-
-data AttributesV3 = AttributesV3 { cl :: Int }
-  deriving (Show, Generic)
-$(deriveJSON (unPrefix "") ''AttributesV3)
-
-data NodeV3 = NodeV3 { no_id :: Int
-                     , no_at :: AttributesV3
-                     , no_s  :: Int
-                     , no_lb :: Text
-                     }
-  deriving (Show, Generic)
-$(deriveJSON (unPrefix "no_") ''NodeV3)
-
-data EdgeV3 = EdgeV3 { eo_s :: Int
-                     , eo_t :: Int
-                     , eo_w :: Text
-                     }
-  deriving (Show, Generic)
-$(deriveJSON (unPrefix "eo_") ''EdgeV3)
-
-data GraphV3 = GraphV3 { go_links :: [EdgeV3]
-                       , go_nodes :: [NodeV3]
-                       }
-  deriving (Show, Generic)
-$(deriveJSON (unPrefix "go_") ''GraphV3)
-
------------------------------------------------------------
-data Camera = Camera { _camera_angle :: Double
-                     , _camera_ratio :: Double
-                     , _camera_x     :: Double
-                     , _camera_y     :: Double }
-  deriving (Show, Generic)
-$(deriveJSON (unPrefix "_camera_") ''Camera)
-makeLenses ''Camera
-
-instance ToSchema Camera where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_camera_")
-
------------------------------------------------------------
-data HyperdataGraph =
-  HyperdataGraph { _hyperdataGraph :: !(Maybe Graph)
-                 , _hyperdataCamera :: !(Maybe Camera)
-                 } deriving (Show, Generic)
-$(deriveJSON (unPrefix "_") ''HyperdataGraph)
-instance ToSchema HyperdataGraph where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_")
-
-defaultHyperdataGraph :: HyperdataGraph
-defaultHyperdataGraph = HyperdataGraph Nothing Nothing
-
-
-instance Hyperdata HyperdataGraph
-makeLenses ''HyperdataGraph
-
-instance FromField HyperdataGraph
-  where
-    fromField = fromField'
-
-instance DefaultFromField SqlJsonb HyperdataGraph
-  where
-    defaultFromField = fromPGSFromField
-
------------------------------------------------------------
--- This type is used to return graph via API
--- hyperdataGraphAPI field is not a Maybe anymore – graph is always computed
-data HyperdataGraphAPI =
-  HyperdataGraphAPI { _hyperdataAPIGraph  :: Graph
-                    , _hyperdataAPICamera :: !(Maybe Camera)
-                    } deriving (Show, Generic)
-$(deriveJSON (unPrefix "_hyperdataAPI") ''HyperdataGraphAPI)
-instance ToSchema HyperdataGraphAPI where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hyperdataAPI")
-
-makeLenses ''HyperdataGraphAPI
-
-instance FromField HyperdataGraphAPI
-  where
-    fromField = fromField'
-
 -----------------------------------------------------------
 graphV3ToGraph :: GraphV3 -> Graph
 graphV3ToGraph (GraphV3 links nodes) = Graph { _graph_nodes = map nodeV32node nodes
@@ -276,6 +47,7 @@ graphV3ToGraph (GraphV3 links nodes) = Graph { _graph_nodes = map nodeV32node no
     linkV32edge :: Int -> EdgeV3 -> Edge
     linkV32edge n (EdgeV3 eo_s' eo_t' eo_w') =
       Edge { edge_source = cs $ show eo_s'
+           , edge_hidden = Just False
            , edge_target = cs $ show eo_t'
            , edge_weight = (Text.read $ Text.unpack eo_w') :: Double
            , edge_confluence = 0.5

src/Gargantext/Core/Viz/Graph/API.hs

@@ -30,9 +30,9 @@ import Gargantext.API.Prelude
 import Gargantext.Core.Methods.Similarities (Similarity(..), GraphMetric(..), withMetric)
 import Gargantext.Core.NodeStory
 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.Core.Viz.Graph.Types
 import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOnlyUser)
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Action.Node (mkNodeWithParent)

src/Gargantext/Core/Viz/Graph/GEXF.hs

@@ -19,18 +19,17 @@ module Gargantext.Core.Viz.Graph.GEXF
   where
 
 import Gargantext.Prelude
-import Gargantext.Core.Viz.Graph
 import qualified Data.HashMap.Lazy as HashMap
 import qualified Gargantext.Prelude as P
-import qualified Gargantext.Core.Viz.Graph as G
+import qualified Gargantext.Core.Viz.Graph.Types as G
 import qualified Xmlbf as Xmlbf
 import Prelude (error)
 
 -- Converts to GEXF format
 -- See https://gephi.org/gexf/format/
-instance Xmlbf.ToXml Graph where
-  toXml (Graph { _graph_nodes = graphNodes
-                , _graph_edges = graphEdges }) = root graphNodes graphEdges
+instance Xmlbf.ToXml G.Graph where
+  toXml (G.Graph { _graph_nodes = graphNodes
+                 , _graph_edges = graphEdges }) = root graphNodes graphEdges
     where
       root :: [G.Node] -> [G.Edge] -> [Xmlbf.Node]
       root gn ge =
@@ -77,5 +76,5 @@ instance Xmlbf.ToXml Graph where
 
 -- just to be able to derive a client for the entire gargantext API,
 -- we however want to avoid sollicitating this instance
-instance Xmlbf.FromXml Graph where
+instance Xmlbf.FromXml G.Graph where
   fromXml = error "FromXml Graph: not defined, just a placeholder"

src/Gargantext/Core/Viz/Graph/PatriciaTreeTypes.hs

+{-| Module      : Gargantext.Core.Viz.Graph.PatriciaTreeTypes
+Description :
+Copyright   : (c) CNRS, Alexandre Delanoë
+License     : AGPL + CECILL v3
+Maintainer  : contact@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+module Gargantext.Core.Viz.Graph.PatriciaTreeTypes where
+
+import qualified Data.Graph.Inductive.PatriciaTree as DGIP
+-- import Data.IntMap (IntMap)
+-- import qualified Eigen.Matrix as DenseMatrix
+-- import Eigen.SparseMatrix (SparseMatrix)
+
+--import qualified Data.Matrix.Sparse.Static    as Sparse
+-- import qualified Data.Vector.Unboxed          as VU
+-- import qualified Numeric.LinearAlgebra.Static as Dense
+import Protolude hiding (sum, natVal)
+
+-- | Main Types use in this libray
+
+type Dict = IntMap
+
+-- | Use the optimized version of Graph
+type Graph a b = DGIP.Gr a b
+
+-- | Type for Matrix computation optimizations (with Eigen)
+-- type MatrixD          n = Dense.L n n
+-- type MatrixS          n = Sparse.Matrix n n Double

src/Gargantext/Core/Viz/Graph/Tools.hs

@@ -25,11 +25,11 @@ import Gargantext.API.Ngrams.Types (NgramsTerm(..))
 import Gargantext.Core.Methods.Similarities (Similarity(..), measure)
 import Gargantext.Core.Methods.Similarities.Conditional (conditional)
 import Gargantext.Core.Statistics
-import Gargantext.Core.Viz.Graph
 import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Bridgeness(..), Partitions, nodeId2comId)
 import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index, MatrixShape(..))
 import Gargantext.Core.Viz.Graph.Tools.IGraph (mkGraphUfromEdges, spinglass)
 import Gargantext.Core.Viz.Graph.Tools.Infomap (infomap)
+import Gargantext.Core.Viz.Graph.Types (Attributes(..), Edge(..), Graph(..), MultiPartite(..), Node(..), Partite(..), Strength(..))
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Core.Viz.Graph.Utils (edgesFilter, nodesFilter)
 import Gargantext.Prelude
@@ -242,6 +242,7 @@ data2graph multi labels' occurences bridge conf partitions =
     (bridge', toKeep) = nodesFilter (\v -> v > 1) bridge
 
     edges = [ Edge { edge_source = cs (show s)
+                   , edge_hidden = Nothing
                    , edge_target = cs (show t)
                    , edge_weight = weight
                    , edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
@@ -340,7 +341,7 @@ cooc2graph'' distance threshold myCooc = neighbourMap
 -- Quentin
 filterByNeighbours :: Double -> Map (Index, Index) Double -> Map (Index, Index) Double
 filterByNeighbours threshold distanceMap = filteredMap
-  where 
+  where
     indexes :: [Index]
     indexes = List.nub $ List.concat $ map (\(idx,idx') -> [idx,idx'] ) $ Map.keys distanceMap
     filteredMap :: Map (Index, Index) Double
@@ -354,4 +355,3 @@ filterByNeighbours threshold distanceMap = filteredMap
                                        $ Map.filterWithKey (\(from,_) _ -> idx == from) distanceMap
                            in List.take (round threshold) selected
                       ) indexes
-

src/Gargantext/Core/Viz/Graph/Types.hs

-{-| Module      : Graph.Types
-Description :
-Copyright   : (c) CNRS, Alexandre Delanoë
+{-|
+Module      : Gargantext.Core.Viz.Graph.Types
+Description : Graph utils
+Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
-Maintainer  : contact@gargantext.org
+Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
 -}
 
-module Gargantext.Core.Viz.Graph.Types where
+{-# LANGUAGE TemplateHaskell      #-}
 
-import qualified Data.Graph.Inductive.PatriciaTree as DGIP
--- import Data.IntMap (IntMap)
--- import qualified Eigen.Matrix as DenseMatrix
--- import Eigen.SparseMatrix (SparseMatrix)
+module Gargantext.Core.Viz.Graph.Types
+  where
 
---import qualified Data.Matrix.Sparse.Static    as Sparse
--- import qualified Data.Vector.Unboxed          as VU
--- import qualified Numeric.LinearAlgebra.Static as Dense
-import Protolude hiding (sum, natVal)
+import Control.Lens (makeLenses)
+import Database.PostgreSQL.Simple.FromField (FromField(..))
+import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson.TH (deriveJSON)
+import Data.HashSet (HashSet)
+import qualified Data.HashSet as HashSet
+import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
+import Data.Text (Text, pack)
+import Gargantext.API.Ngrams.Types (NgramsTerm)
+import Gargantext.Core.Methods.Similarities (GraphMetric)
+import Gargantext.Core.Types (ListId)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude (Hyperdata)
+import Gargantext.Database.Admin.Types.Node (NodeId)
+import Gargantext.Database.Prelude (fromField')
+import Gargantext.Database.Schema.Ngrams (NgramsType(..))
+import Gargantext.Prelude
+import GHC.Generics (Generic)
+import Opaleye (DefaultFromField(..), SqlJsonb, fromPGSFromField)
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
--- | Main Types use in this libray
 
-type Dict = IntMap
+data TypeNode = Terms | Unknown
+  deriving (Show, Generic)
 
--- | Use the optimized version of Graph
-type Graph a b = DGIP.Gr a b
+instance ToJSON TypeNode
+instance FromJSON TypeNode
+instance ToSchema TypeNode
 
--- | Type for Matrix computation optimizations (with Eigen)
--- type MatrixD          n = Dense.L n n
--- type MatrixS          n = Sparse.Matrix n n Double
+data Attributes = Attributes { clust_default :: Int }
+  deriving (Show, Generic)
+$(deriveJSON (unPrefix "") ''Attributes)
+instance ToSchema Attributes
 
+data Node = Node { node_size  :: Int
+                 , node_type  :: NgramsType -- TypeNode -- TODO NgramsType | Person
+                 , node_id    :: Text     -- TODO NgramId
+                 , node_label :: Text
+                 , node_x_coord :: Double
+                 , node_y_coord :: Double
+                 , node_attributes :: Attributes
+                 , node_children :: [Text]
+                 }
+  deriving (Show, Generic)
+$(deriveJSON (unPrefix "node_") ''Node)
+instance ToSchema Node where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "node_")
+
+
+data Edge = Edge { edge_confluence :: Double
+                 , edge_hidden     :: Maybe Bool
+                 , edge_id         :: Text
+                 , edge_source     :: Text
+                 , edge_target     :: Text
+                 , edge_weight     :: Double
+                 }
+  deriving (Show, Generic)
+
+$(deriveJSON (unPrefix "edge_") ''Edge)
+
+instance ToSchema Edge where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "edge_")
+
+---------------------------------------------------------------
+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 (unPrefixSwagger "_lf_")
+
+makeLenses ''LegendField
+
+---------------------------------------------------------------
+data Partite = Partite { _partite_nodes :: HashSet NgramsTerm
+                       , _partite_type :: NgramsType
+                       }
+  deriving (Show, Generic)
+$(deriveJSON (unPrefix "_partite_") ''Partite)
+instance ToSchema Partite where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_partite_")
+makeLenses ''Partite
+
+
+data MultiPartite = MultiPartite { _multipartite_data1 :: Partite
+                                 , _multipartite_data2 :: Partite
+                                 }
+  deriving (Show, Generic)
+$(deriveJSON (unPrefix "_multipartite_") ''MultiPartite)
+instance ToSchema MultiPartite where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_multipartite_")
+makeLenses ''MultiPartite
+
+---------------------------------------------------------------
+
+type Version = Int
+data ListForGraph =
+  ListForGraph { _lfg_listId  :: ListId
+               , _lfg_version :: Version
+               } deriving (Show, Generic)
+$(deriveJSON (unPrefix "_lfg_") ''ListForGraph)
+
+instance ToSchema ListForGraph where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_lfg_")
+
+makeLenses ''ListForGraph
+
+data Strength = Strong | Weak
+    deriving (Generic, Eq, Ord, Enum, Bounded, Show)
+
+$(deriveJSON (unPrefix "") ''Strength)
+instance ToSchema Strength where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
+
+
+
+data GraphMetadata =
+  GraphMetadata { _gm_title            :: Text          -- title of the graph
+                , _gm_metric           :: GraphMetric
+                , _gm_edgesStrength    :: Maybe Strength
+                , _gm_corpusId         :: [NodeId]      -- we can map with different corpus
+                , _gm_legend           :: [LegendField] -- legend of the Graph
+                , _gm_list             :: ListForGraph
+                , _gm_startForceAtlas  :: Bool
+                -- , _gm_nodesTypes       :: Maybe (NgramsType, NgramsType)
+                -- , _gm_version       :: Int
+                }
+  deriving (Show, Generic)
+$(deriveJSON (unPrefix "_gm_") ''GraphMetadata)
+instance ToSchema GraphMetadata where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_gm_")
+makeLenses ''GraphMetadata
+
+
+
+data Graph = Graph { _graph_nodes    :: [Node]
+                   , _graph_edges    :: [Edge]
+                   , _graph_metadata :: Maybe GraphMetadata
+                   }
+  deriving (Show, Generic)
+$(deriveJSON (unPrefix "_graph_") ''Graph)
+makeLenses ''Graph
+
+instance ToSchema Graph where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_graph_")
+
+
+
+-----------------------------------------------------------
+-- V3 Gargantext Version
+
+data AttributesV3 = AttributesV3 { cl :: Int }
+  deriving (Show, Generic)
+$(deriveJSON (unPrefix "") ''AttributesV3)
+
+data NodeV3 = NodeV3 { no_id :: Int
+                     , no_at :: AttributesV3
+                     , no_s  :: Int
+                     , no_lb :: Text
+                     }
+  deriving (Show, Generic)
+$(deriveJSON (unPrefix "no_") ''NodeV3)
+
+data EdgeV3 = EdgeV3 { eo_s :: Int
+                     , eo_t :: Int
+                     , eo_w :: Text
+                     }
+  deriving (Show, Generic)
+$(deriveJSON (unPrefix "eo_") ''EdgeV3)
+
+data GraphV3 = GraphV3 { go_links :: [EdgeV3]
+                       , go_nodes :: [NodeV3]
+                       }
+  deriving (Show, Generic)
+$(deriveJSON (unPrefix "go_") ''GraphV3)
+
+-----------------------------------------------------------
+data Camera = Camera { _camera_angle :: Double
+                     , _camera_ratio :: Double
+                     , _camera_x     :: Double
+                     , _camera_y     :: Double }
+  deriving (Show, Generic)
+$(deriveJSON (unPrefix "_camera_") ''Camera)
+makeLenses ''Camera
+
+instance ToSchema Camera where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_camera_")
+
+-----------------------------------------------------------
+data HyperdataGraph =
+  HyperdataGraph { _hyperdataGraph :: !(Maybe Graph)
+                 , _hyperdataCamera :: !(Maybe Camera)
+                 } deriving (Show, Generic)
+$(deriveJSON (unPrefix "_") ''HyperdataGraph)
+instance ToSchema HyperdataGraph where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_")
+
+
+
+instance Hyperdata HyperdataGraph
+makeLenses ''HyperdataGraph
+
+instance FromField HyperdataGraph
+  where
+    fromField = fromField'
+
+instance DefaultFromField SqlJsonb HyperdataGraph
+  where
+    defaultFromField = fromPGSFromField
+
+-----------------------------------------------------------
+-- This type is used to return graph via API
+-- hyperdataGraphAPI field is not a Maybe anymore – graph is always computed
+data HyperdataGraphAPI =
+  HyperdataGraphAPI { _hyperdataAPIGraph  :: Graph
+                    , _hyperdataAPICamera :: !(Maybe Camera)
+                    } deriving (Show, Generic)
+$(deriveJSON (unPrefix "_hyperdataAPI") ''HyperdataGraphAPI)
+instance ToSchema HyperdataGraphAPI where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hyperdataAPI")
+
+makeLenses ''HyperdataGraphAPI
+
+instance FromField HyperdataGraphAPI
+  where
+    fromField = fromField'
+
+
+
+
+---------------------- defaults
+
+
+
+
+defaultMultipartite :: MultiPartite
+defaultMultipartite = MultiPartite a a
+  where
+    a = Partite HashSet.empty NgramsTerms
+
+
+defaultGraph :: Graph
+defaultGraph = Graph {_graph_nodes = [Node {node_x_coord=0, node_y_coord=0, node_size = 4, node_type = NgramsTerms, node_id = pack "0", node_label = pack "animal", node_attributes = Attributes {clust_default = 0}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 3, node_type = NgramsTerms, node_id = pack "1", node_label = pack "bird", node_attributes = Attributes {clust_default = 0}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "2", node_label = pack "boy", node_attributes = Attributes {clust_default = 1}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "3", node_label = pack "dog", node_attributes = Attributes {clust_default = 0}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "4", node_label = pack "girl", node_attributes = Attributes {clust_default = 1}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 4, node_type = NgramsTerms, node_id = pack "5", node_label = pack "human body", node_attributes = Attributes {clust_default = 1}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 3, node_type = NgramsTerms, node_id = pack "6", node_label = pack "object", node_attributes = Attributes {clust_default = 2}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "7", node_label = pack "pen", node_attributes = Attributes {clust_default = 2}, node_children = []},Node {node_x_coord=0, node_y_coord=0, node_size = 2, node_type = NgramsTerms, node_id = pack "8", node_label = pack "table", node_attributes = Attributes {clust_default = 2}, node_children = []}], _graph_edges = [Edge {edge_source = pack "0", edge_target = pack "0", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "0", ..},Edge {edge_source = pack "1", edge_target = pack "0", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "1", ..},Edge {edge_source = pack "1", edge_target = pack "1", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "2", ..},Edge {edge_source = pack "2", edge_target = pack "2", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "3", ..},Edge {edge_source = pack "2", edge_target = pack "5", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "4", ..},Edge {edge_source = pack "3", edge_target = pack "0", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "5", ..},Edge {edge_source = pack "3", edge_target = pack "1", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "6", ..},Edge {edge_source = pack "3", edge_target = pack "3", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "7", ..},Edge {edge_source = pack "4", edge_target = pack "4", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "8", ..},Edge {edge_source = pack "4", edge_target = pack "5", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "9", ..},Edge {edge_source = pack "5", edge_target = pack "5", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "10", ..},Edge {edge_source = pack "6", edge_target = pack "6", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "11", ..},Edge {edge_source = pack "7", edge_target = pack "6", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "12", ..},Edge {edge_source = pack "7", edge_target = pack "7", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "13", ..},Edge {edge_source = pack "8", edge_target = pack "6", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "14", ..},Edge {edge_source = pack "8", edge_target = pack "7", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "15", ..},Edge {edge_source = pack "8", edge_target = pack "8", edge_weight = 1.0, edge_confluence=0.5, edge_id = pack "16", ..}], _graph_metadata = Nothing}
+  where
+    edge_hidden = Just False
+
+
+
+defaultHyperdataGraph :: HyperdataGraph
+defaultHyperdataGraph = HyperdataGraph Nothing Nothing
+
+
+
+-- | Intances for the mock
+instance Arbitrary Strength where
+  arbitrary = elements $ [Strong, Weak]
+instance Arbitrary Graph where
+  arbitrary = elements $ [defaultGraph]

src/Gargantext/Database/Admin/Types/Hyperdata.hs

@@ -10,6 +10,7 @@ Portability : POSIX
 -}
 
 
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
 
 module Gargantext.Database.Admin.Types.Hyperdata
   ( module Gargantext.Database.Admin.Types.Hyperdata.Any
@@ -26,7 +27,7 @@ module Gargantext.Database.Admin.Types.Hyperdata
   , module Gargantext.Database.Admin.Types.Hyperdata.Texts
   , module Gargantext.Database.Admin.Types.Hyperdata.Phylo
   , module Gargantext.Database.Admin.Types.Hyperdata.User
-  , module Gargantext.Core.Viz.Graph
+  , module Gargantext.Core.Viz.Graph.Types
   )
   where
 
@@ -44,4 +45,4 @@ import Gargantext.Database.Admin.Types.Hyperdata.Prelude (Hyperdata)
 import Gargantext.Database.Admin.Types.Hyperdata.Texts
 import Gargantext.Database.Admin.Types.Hyperdata.Phylo
 import Gargantext.Database.Admin.Types.Hyperdata.User
-import Gargantext.Core.Viz.Graph (HyperdataGraph(..), defaultHyperdataGraph)
+import Gargantext.Core.Viz.Graph.Types (HyperdataGraph(..), defaultHyperdataGraph)

src/Gargantext/Database/Admin/Types/Hyperdata/Default.hs

@@ -27,7 +27,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Prelude
 
 
 data DefaultHyperdata =
-    DefaultUser    HyperdataUser 
+    DefaultUser    HyperdataUser
   | DefaultContact HyperdataContact
 
   | DefaultCorpus    HyperdataCorpus

src/Gargantext/Database/Admin/Types/Hyperdata/Prelude.hs

@@ -11,7 +11,7 @@ Portability : POSIX
 
 
 module Gargantext.Database.Admin.Types.Hyperdata.Prelude
-  ( module Control.Lens 
+  ( module Control.Lens
   , module Data.Aeson
   , module Data.Aeson.TH
   , module Data.Aeson.Types
@@ -66,8 +66,3 @@ data Chart =
 instance ToJSON Chart
 instance FromJSON Chart
 instance ToSchema Chart
-
-
-
-
-