src/Gargantext/Database/Query/Tree.hs

   1 {-|
   2 Module      : Gargantext.Database.Tree
   3 Description : Tree of Resource Nodes built from Database
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Let a Root Node, return the Tree of the Node as a directed acyclic graph
  11 (Tree).
  12
  13 -- TODO delete node, if not owned, then suppress the link only
  14 -- see Action/Delete.hs
  15 -}
  16
  17 {-# LANGUAGE QuasiQuotes       #-}
  18 {-# LANGUAGE TemplateHaskell   #-}
  19
  20 module Gargantext.Database.Query.Tree
  21   ( module Gargantext.Database.Query.Tree.Error
  22   , isDescendantOf
  23   , isIn
  24   , tree
  25   , TreeMode(..)
  26   , findNodesId
  27   , DbTreeNode(..)
  28   , dt_name
  29   , dt_nodeId
  30   , dt_typeId
  31   , findShared
  32   )
  33   where
  34
  35 import Control.Lens ((^..), at, each, _Just, to, set, makeLenses)
  36 import Control.Monad.Error.Class (MonadError())
  37 import Data.List (tail, concat)
  38 import Data.Map (Map, fromListWith, lookup)
  39 import Data.Text (Text)
  40 import Database.PostgreSQL.Simple
  41 import Database.PostgreSQL.Simple.SqlQQ
  42 import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
  43 import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId, fromNodeTypeId)
  44 import Gargantext.Database.Admin.Types.Node (NodeId, NodeType, DocId, allNodeTypes)
  45 import Gargantext.Database.Admin.Types.Node -- (pgNodeId, NodeType(..))
  46 import Gargantext.Database.Prelude (Cmd, runPGSQuery)
  47 import Gargantext.Database.Query.Table.NodeNode (getNodeNode)
  48 import Gargantext.Database.Query.Tree.Error
  49 import Gargantext.Database.Schema.NodeNode (NodeNodePoly(..))
  50 import Gargantext.Prelude
  51
  52 ------------------------------------------------------------------------
  53 data DbTreeNode = DbTreeNode { _dt_nodeId :: NodeId
  54                              , _dt_typeId :: Int
  55                              , _dt_parentId :: Maybe NodeId
  56                              , _dt_name     :: Text
  57                              } deriving (Show)
  58
  59 makeLenses ''DbTreeNode
  60 ------------------------------------------------------------------------
  61
  62 data TreeMode = Basic | Advanced
  63
  64 -- | Returns the Tree of Nodes in Database
  65 tree :: HasTreeError err
  66        => TreeMode
  67        -> RootId
  68        -> [NodeType]
  69        -> Cmd err (Tree NodeTree)
  70 tree Basic    = tree_basic
  71 tree Advanced = tree_advanced
  72
  73 -- | Tree basic returns the Tree of Nodes in Database
  74 -- (without shared folders)
  75 -- keeping this for teaching purpose only
  76 tree_basic :: HasTreeError err
  77        => RootId
  78        -> [NodeType]
  79        -> Cmd err (Tree NodeTree)
  80 tree_basic r nodeTypes =
  81   (dbTree r nodeTypes <&> toTreeParent) >>= toTree
  82   -- Same as (but easier to read) :
  83   -- toTree =<< (toTreeParent <$> dbTree r nodeTypes)
  84
  85 -- | Advanced mode of the Tree enables shared nodes
  86 tree_advanced :: HasTreeError err
  87        => RootId
  88        -> [NodeType]
  89        -> Cmd err (Tree NodeTree)
  90 tree_advanced r nodeTypes = do
  91   mainRoot    <- dbTree     r nodeTypes
  92   sharedRoots <- findShared r NodeFolderShared nodeTypes sharedTreeUpdate
  93   publicRoots <- findShared r NodeFolderPublic nodeTypes publicTreeUpdate
  94   toTree      $ toTreeParent (mainRoot <> sharedRoots <> publicRoots)
  95
  96 ------------------------------------------------------------------------
  97 -- | Collaborative Nodes in the Tree
  98 findShared :: HasTreeError err
  99            => RootId -> NodeType -> [NodeType] -> UpdateTree err
 100            -> Cmd err [DbTreeNode]
 101 findShared r nt nts fun = do
 102   foldersSharedId <- findNodesId r [nt]
 103   trees       <- mapM (updateTree nts fun) foldersSharedId
 104   pure $ concat trees
 105
 106
 107 updateTree :: HasTreeError err
 108            => [NodeType] -> UpdateTree err -> RootId
 109            -> Cmd err [DbTreeNode]
 110 updateTree nts fun r = do
 111   folders       <- getNodeNode r
 112   nodesSharedId <- mapM (fun r nts)
 113                  $ map _nn_node2_id folders
 114   pure $ concat nodesSharedId
 115
 116
 117 type UpdateTree err = ParentId -> [NodeType] -> NodeId -> Cmd err [DbTreeNode]
 118
 119 sharedTreeUpdate :: HasTreeError err => UpdateTree err
 120 sharedTreeUpdate p nt n = dbTree n nt
 121                <&> map (\n' -> if _dt_nodeId n' == n
 122                                   then set dt_parentId (Just p) n'
 123                                   else n')
 124
 125 publicTreeUpdate :: HasTreeError err => UpdateTree err
 126 publicTreeUpdate p nt n = dbTree n nt
 127                <&> map (\n' -> if _dt_nodeId n' == n
 128                                 -- && (fromNodeTypeId $ _dt_typeId n') /= NodeFolderPublic
 129                                   then set dt_parentId (Just p) n'
 130                                   else n')
 131
 132
 133
 134 -- | findNodesId returns all nodes matching nodeType but the root (Nodeuser)
 135 findNodesId :: RootId -> [NodeType] -> Cmd err [NodeId]
 136 findNodesId r nt = tail
 137                 <$> map _dt_nodeId
 138                 <$> dbTree r nt
 139 ------------------------------------------------------------------------
 140 ------------------------------------------------------------------------
 141 toTree :: ( MonadError e m
 142           , HasTreeError e)
 143        => Map (Maybe ParentId) [DbTreeNode]
 144        -> m (Tree NodeTree)
 145 toTree m =
 146     case lookup Nothing m of
 147         Just [n] -> pure $ toTree' m n
 148         Nothing  -> treeError NoRoot
 149         Just []  -> treeError EmptyRoot
 150         Just _   -> treeError TooManyRoots
 151
 152      where
 153       toTree' :: Map (Maybe ParentId) [DbTreeNode]
 154               -> DbTreeNode
 155               -> Tree NodeTree
 156       toTree' m' n =
 157         TreeN (toNodeTree n) $
 158           m' ^.. at (Just $ _dt_nodeId n) . _Just . each . to (toTree' m')
 159
 160       toNodeTree :: DbTreeNode
 161                  -> NodeTree
 162       toNodeTree (DbTreeNode nId tId _ n) = NodeTree n nodeType nId
 163         where
 164           nodeType = fromNodeTypeId tId
 165 ------------------------------------------------------------------------
 166 toTreeParent :: [DbTreeNode]
 167              -> Map (Maybe ParentId) [DbTreeNode]
 168 toTreeParent = fromListWith (<>) . map (\n -> (_dt_parentId n, [n]))
 169 ------------------------------------------------------------------------
 170 -- | Main DB Tree function
 171 dbTree :: RootId
 172        -> [NodeType]
 173        -> Cmd err [DbTreeNode]
 174 dbTree rootId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n)
 175   <$> runPGSQuery [sql|
 176     WITH RECURSIVE
 177         tree (id, typename, parent_id, name) AS
 178         (
 179           SELECT p.id, p.typename, p.parent_id, p.name
 180           FROM nodes AS p
 181           WHERE p.id = ?
 182
 183           UNION
 184
 185           SELECT c.id, c.typename, c.parent_id, c.name
 186           FROM nodes AS c
 187
 188           INNER JOIN tree AS s ON c.parent_id = s.id
 189            WHERE c.typename IN ?
 190         )
 191     SELECT * from tree;
 192     |] (rootId, In typename)
 193   where
 194     typename = map nodeTypeId ns
 195     ns = case nodeTypes of
 196       [] -> allNodeTypes
 197       _  -> nodeTypes
 198
 199 isDescendantOf :: NodeId -> RootId -> Cmd err Bool
 200 isDescendantOf childId rootId = (== [Only True])
 201   <$> runPGSQuery [sql|
 202                   BEGIN ;
 203                   SET TRANSACTION READ ONLY;
 204                   COMMIT;
 205
 206                   WITH RECURSIVE
 207       tree (id, parent_id) AS
 208       (
 209         SELECT c.id, c.parent_id
 210         FROM nodes AS c
 211         WHERE c.id = ?
 212
 213         UNION
 214
 215         SELECT p.id, p.parent_id
 216         FROM nodes AS p
 217         INNER JOIN tree AS t ON t.parent_id = p.id
 218
 219       )
 220   SELECT COUNT(*) = 1 from tree AS t
 221   WHERE t.id = ?;
 222   |] (childId, rootId)
 223
 224 -- TODO should we check the category?
 225 isIn :: NodeId -> DocId -> Cmd err Bool
 226 isIn cId docId = ( == [Only True])
 227   <$> runPGSQuery [sql| SELECT COUNT(*) = 1
 228     FROM nodes_nodes nn
 229       WHERE nn.node1_id = ?
 230         AND nn.node2_id = ?;
 231   |] (cId, docId)
 232 -----------------------------------------------------