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
  45 import Gargantext.Database.Prelude (Cmd, runPGSQuery)
  46 import Gargantext.Database.Query.Table.NodeNode (getNodeNode)
  47 import Gargantext.Database.Query.Tree.Error
  48 import Gargantext.Database.Schema.NodeNode (NodeNodePoly(..))
  49 import Gargantext.Prelude
  50
  51 ------------------------------------------------------------------------
  52 data DbTreeNode = DbTreeNode { _dt_nodeId :: NodeId
  53                              , _dt_typeId :: Int
  54                              , _dt_parentId :: Maybe NodeId
  55                              , _dt_name     :: Text
  56                              } deriving (Show)
  57
  58 makeLenses ''DbTreeNode
  59 ------------------------------------------------------------------------
  60
  61 data TreeMode = Basic | Advanced
  62
  63 -- | Returns the Tree of Nodes in Database
  64 tree :: HasTreeError err
  65        => TreeMode
  66        -> RootId
  67        -> [NodeType]
  68        -> Cmd err (Tree NodeTree)
  69 tree Basic    = tree_basic
  70 tree Advanced = tree_advanced
  71
  72 -- | Tree basic returns the Tree of Nodes in Database
  73 -- (without shared folders)
  74 -- keeping this for teaching purpose only
  75 tree_basic :: HasTreeError err
  76        => RootId
  77        -> [NodeType]
  78        -> Cmd err (Tree NodeTree)
  79 tree_basic r nodeTypes =
  80   (dbTree r nodeTypes <&> toTreeParent) >>= toTree
  81   -- Same as (but easier to read) :
  82   -- toTree =<< (toTreeParent <$> dbTree r nodeTypes)
  83
  84 -- | Advanced mode of the Tree enables shared nodes
  85 tree_advanced :: HasTreeError err
  86        => RootId
  87        -> [NodeType]
  88        -> Cmd err (Tree NodeTree)
  89 tree_advanced r nodeTypes = do
  90   mainRoot    <- dbTree     r nodeTypes
  91   sharedRoots <- findShared r NodeFolderShared nodeTypes sharedTreeUpdate
  92   publicRoots <- findShared r NodeFolderPublic nodeTypes publicTreeUpdate
  93   toTree      $ toTreeParent (mainRoot <> sharedRoots <> publicRoots)
  94
  95 ------------------------------------------------------------------------
  96 -- | Collaborative Nodes in the Tree
  97 findShared :: HasTreeError err
  98            => RootId -> NodeType -> [NodeType] -> UpdateTree err
  99            -> Cmd err [DbTreeNode]
 100 findShared r nt nts fun = do
 101   foldersSharedId <- findNodesId r [nt]
 102   trees       <- mapM (updateTree nts fun) foldersSharedId
 103   pure $ concat trees
 104
 105
 106 updateTree :: HasTreeError err
 107            => [NodeType] -> UpdateTree err -> RootId
 108            -> Cmd err [DbTreeNode]
 109 updateTree nts fun r = do
 110   folders       <- getNodeNode r
 111   nodesSharedId <- mapM (fun r nts)
 112                  $ map _nn_node2_id folders
 113   pure $ concat nodesSharedId
 114
 115
 116 type UpdateTree err = ParentId -> [NodeType] -> NodeId -> Cmd err [DbTreeNode]
 117
 118 sharedTreeUpdate :: HasTreeError err => UpdateTree err
 119 sharedTreeUpdate p nt n = dbTree n nt
 120                <&> map (\n' -> if _dt_nodeId n' == n
 121                                   then set dt_parentId (Just p) n'
 122                                   else n')
 123
 124 publicTreeUpdate :: HasTreeError err => UpdateTree err
 125 publicTreeUpdate p nt n = dbTree n nt
 126                <&> map (\n' -> if _dt_nodeId n' == n
 127                                 -- && (fromNodeTypeId $ _dt_typeId n') /= NodeFolderPublic
 128                                   then set dt_parentId (Just p) n'
 129                                   else n')
 130
 131
 132
 133 -- | findNodesId returns all nodes matching nodeType but the root (Nodeuser)
 134 findNodesId :: RootId -> [NodeType] -> Cmd err [NodeId]
 135 findNodesId r nt = tail
 136                 <$> map _dt_nodeId
 137                 <$> dbTree r nt
 138 ------------------------------------------------------------------------
 139 ------------------------------------------------------------------------
 140 toTree :: ( MonadError e m
 141           , HasTreeError e)
 142        => Map (Maybe ParentId) [DbTreeNode]
 143        -> m (Tree NodeTree)
 144 toTree m =
 145     case lookup Nothing m of
 146         Just [n] -> pure $ toTree' m n
 147         Nothing  -> treeError NoRoot
 148         Just []  -> treeError EmptyRoot
 149         Just _   -> treeError TooManyRoots
 150
 151      where
 152       toTree' :: Map (Maybe ParentId) [DbTreeNode]
 153               -> DbTreeNode
 154               -> Tree NodeTree
 155       toTree' m' n =
 156         TreeN (toNodeTree n) $
 157           m' ^.. at (Just $ _dt_nodeId n) . _Just . each . to (toTree' m')
 158
 159       toNodeTree :: DbTreeNode
 160                  -> NodeTree
 161       toNodeTree (DbTreeNode nId tId _ n) = NodeTree n nodeType nId
 162         where
 163           nodeType = fromNodeTypeId tId
 164 ------------------------------------------------------------------------
 165 toTreeParent :: [DbTreeNode]
 166              -> Map (Maybe ParentId) [DbTreeNode]
 167 toTreeParent = fromListWith (<>) . map (\n -> (_dt_parentId n, [n]))
 168 ------------------------------------------------------------------------
 169 -- | Main DB Tree function
 170 dbTree :: RootId
 171        -> [NodeType]
 172        -> Cmd err [DbTreeNode]
 173 dbTree rootId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n)
 174   <$> runPGSQuery [sql|
 175     WITH RECURSIVE
 176         tree (id, typename, parent_id, name) AS
 177         (
 178           SELECT p.id, p.typename, p.parent_id, p.name
 179           FROM nodes AS p
 180           WHERE p.id = ?
 181
 182           UNION
 183
 184           SELECT c.id, c.typename, c.parent_id, c.name
 185           FROM nodes AS c
 186
 187           INNER JOIN tree AS s ON c.parent_id = s.id
 188            WHERE c.typename IN ?
 189         )
 190     SELECT * from tree;
 191     |] (rootId, In typename)
 192   where
 193     typename = map nodeTypeId ns
 194     ns = case nodeTypes of
 195       [] -> allNodeTypes
 196       _  -> nodeTypes
 197
 198 isDescendantOf :: NodeId -> RootId -> Cmd err Bool
 199 isDescendantOf childId rootId = (== [Only True])
 200   <$> runPGSQuery [sql|
 201                   BEGIN ;
 202                   SET TRANSACTION READ ONLY;
 203                   COMMIT;
 204
 205                   WITH RECURSIVE
 206       tree (id, parent_id) AS
 207       (
 208         SELECT c.id, c.parent_id
 209         FROM nodes AS c
 210         WHERE c.id = ?
 211
 212         UNION
 213
 214         SELECT p.id, p.parent_id
 215         FROM nodes AS p
 216         INNER JOIN tree AS t ON t.parent_id = p.id
 217
 218       )
 219   SELECT COUNT(*) = 1 from tree AS t
 220   WHERE t.id = ?;
 221   |] (childId, rootId)
 222
 223 -- TODO should we check the category?
 224 isIn :: NodeId -> DocId -> Cmd err Bool
 225 isIn cId docId = ( == [Only True])
 226   <$> runPGSQuery [sql| SELECT COUNT(*) = 1
 227     FROM nodes_nodes nn
 228       WHERE nn.node1_id = ?
 229         AND nn.node2_id = ?;
 230   |] (cId, docId)
 231 -----------------------------------------------------