diff --git a/src/Gargantext/Database/Config.hs b/src/Gargantext/Database/Config.hs index cfd32955d8e384956f02126f2aabc9826f58e025..00a15cf955520a74cfad8668eb685dc1a636bf7b 100644 --- a/src/Gargantext/Database/Config.hs +++ b/src/Gargantext/Database/Config.hs @@ -49,6 +49,9 @@ nodeTypes = [ (NodeUser , 1) -- , (MapList , 8) ---- Scores , (Occurrences , 10) + , (Graph , 9) + , (Dashboard , 5) + , (Chart , 51) -- , (Cooccurrences , 9) -- -- , (Specclusion , 11) diff --git a/src/Gargantext/Database/Tree.hs b/src/Gargantext/Database/Tree.hs new file mode 100644 index 0000000000000000000000000000000000000000..171652d365f55b6b3ea04b6f207649505b4b06ad --- /dev/null +++ b/src/Gargantext/Database/Tree.hs @@ -0,0 +1,103 @@ +{-| +Module : Gargantext.Database.Tree +Description : Tree of Resource Nodes built from Database +Copyright : (c) CNRS, 2017-Present +License : AGPL + CECILL v3 +Maintainer : team@gargantext.org +Stability : experimental +Portability : POSIX + +Let a Root Node, return the Tree of the Node as a directed acyclic graph +(Tree). + +-} + +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE QuasiQuotes #-} + +module Gargantext.Database.Tree (treeDB) where + +import Data.Map (Map, fromListWith, lookup) +import Data.Text (Text, pack) +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.SqlQQ + +import Gargantext.Prelude +import Gargantext.Core.Types.Main (NodeTree(..), Tree(..)) +import Gargantext.Database.Config (typeId2node) +------------------------------------------------------------------------ +-- import Gargantext (connectGargandb) +-- import Control.Monad ((>>=)) +-- treeTest :: IO (Tree NodeTree) +-- treeTest = connectGargandb "gargantext.ini" >>= \c -> treeDB c 347474 +------------------------------------------------------------------------ +-- | Returns the Tree of Nodes in Database +treeDB :: Connection -> RootId -> IO (Tree NodeTree) +treeDB c r = toTree <$> toTreeParent <$> dbTree c r + +type RootId = Int +type ParentId = Int +------------------------------------------------------------------------ +toTree :: Map (Maybe ParentId) [DbTreeNode] -> Tree NodeTree +toTree m = toTree' m n + where + n = case lookup Nothing m of + Nothing -> panic $ pack "no root" + Just [] -> panic $ pack "empty root" + Just [n'] -> n' + Just _ -> panic $ pack "too many roots" + +toTree' :: Map (Maybe ParentId) [DbTreeNode] -> DbTreeNode -> Tree NodeTree +toTree' m n = case lookup (Just $ dt_nodeId n) m of + Nothing -> TreeN (toNodeTree n) [] + Just ns -> TreeN (toNodeTree n) (map (toTree' m) ns) + +------------------------------------------------------------------------ +toNodeTree :: DbTreeNode -> NodeTree +toNodeTree (DbTreeNode nId tId _ n) = NodeTree n nodeType nId + where + nodeType = typeId2node tId +------------------------------------------------------------------------ +toTreeParent :: [DbTreeNode] -> Map (Maybe ParentId) [DbTreeNode] +toTreeParent = fromListWith (<>) . map (\n -> (dt_parentId n, [n])) +------------------------------------------------------------------------ +data DbTreeNode = DbTreeNode { dt_nodeId :: Int + , dt_typeId :: Int + , dt_parentId :: Maybe Int + , dt_name :: Text + } deriving (Show) + + +dbTree :: Connection -> RootId -> IO [DbTreeNode] +dbTree conn rootId = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n) <$> query conn [sql| + WITH RECURSIVE + -- starting node(s) + starting (id, typename, parent_id, name) AS + ( + SELECT n.id, n.typename, n.parent_id, n.name + FROM nodes AS n + WHERE n.parent_id = ? -- this can be arbitrary + ), + descendants (id, typename, parent_id, name) AS + ( + SELECT id, typename, parent_id, name + FROM starting + UNION ALL + SELECT n.id, n.typename, n.parent_id, n.name + FROM nodes AS n JOIN descendants AS d ON n.parent_id = d.id + where n.typename in (2,3,31) + ), + ancestors (id, typename, parent_id, name) AS + ( + SELECT n.id, n.typename, n.parent_id, n.name + FROM nodes AS n + WHERE n.id IN (SELECT parent_id FROM starting) + UNION ALL + SELECT n.id, n.typename, n.parent_id, n.name + FROM nodes AS n JOIN ancestors AS a ON n.id = a.parent_id + ) + TABLE ancestors + UNION ALL + TABLE descendants ; + |] (Only rootId) + diff --git a/src/Gargantext/Database/Types/Node.hs b/src/Gargantext/Database/Types/Node.hs index 7eb28fa27b59ab5ea34db513ad1e8c9f59533450..3c36ee051806ba0ad6b4f531d8cc6e466284d76e 100644 --- a/src/Gargantext/Database/Types/Node.hs +++ b/src/Gargantext/Database/Types/Node.hs @@ -274,11 +274,12 @@ type NodeCorpus = Node HyperdataCorpus type Document = Node HyperdataDocument ------------------------------------------------------------------------ -data NodeType = NodeUser | Folder +data NodeType = NodeUser + | Project | Folder | NodeCorpus | Annuaire - | Document | Individu - | UserPage | DocumentCopy | Favorites - | Dashboard | Graph + | Document | Individu + | UserPage | Favorites + | Graph | Dashboard | Chart | Classification | Lists | Metrics | Occurrences