Skip to content

haskell-gargantext
haskell-gargantext
Verified Commit ed2c6313 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[graph] some refactoring of Core.Viz.Graph

parent ce1cc37a
Pipeline #3604 failed with stage
    in 53 minutes and 46 seconds
    Hide whitespace changes
    Inline Side-by-side
    Showing with 318 additions and 274 deletions
    gargantext.cabal
    View file @ ed2c6313
    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
    View file @ ed2c6313
    ......@@ -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
    View file @ ed2c6313
    ......@@ -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
    View file @ ed2c6313
    ......@@ -14,4 +14,3 @@ Vizualisation of text stats
    module Gargantext.Core.Viz
    where
    src/Gargantext/Core/Viz/Graph.hs
    View file @ ed2c6313
    ......@@ -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
    View file @ ed2c6313
    ......@@ -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
    View file @ ed2c6313
    ......@@ -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 0 → 100644
    View file @ ed2c6313
    {-| 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
    View file @ ed2c6313
    ......@@ -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
    View file @ ed2c6313
    {-| 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
    View file @ ed2c6313
    ......@@ -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
    View file @ ed2c6313
    ......@@ -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
    View file @ ed2c6313
    ......@@ -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
    Markdown is supported
    0% or
    You are about to add 0 people to the discussion. Proceed with caution.
    Finish editing this message first!
    Please register or to comment