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)
  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
  93   publicRoots <- findShared r NodeFolderPublic nodeTypes
  94   toTree      $ toTreeParent (mainRoot <> sharedRoots <> publicRoots)
  95
  96 ------------------------------------------------------------------------
  97 -- | Collaborative Nodes in the Tree
  98 findShared :: RootId -> NodeType -> [NodeType] -> Cmd err [DbTreeNode]
  99 findShared r nt nts = do
 100   folderSharedId <- maybe (panic "no folder found") identity
 101                 <$> head
 102                 <$> findNodesId r [nt]
 103   folders       <- getNodeNode folderSharedId
 104   nodesSharedId <- mapM (\child -> sharedTree folderSharedId child nts)
 105                  $ map _nn_node2_id folders
 106   pure $ concat nodesSharedId
 107
 108 sharedTree :: ParentId -> NodeId -> [NodeType] -> Cmd err [DbTreeNode]
 109 sharedTree p n nt = dbTree n nt
 110                <&> map (\n' -> if _dt_nodeId n' == n
 111                                   then set dt_parentId (Just p) n'
 112                                   else n')
 113
 114 -- | findNodesId returns all nodes matching nodeType but the root (Nodeuser)
 115 findNodesId :: RootId -> [NodeType] -> Cmd err [NodeId]
 116 findNodesId r nt = tail
 117                 <$> map _dt_nodeId
 118                 <$> dbTree r nt
 119 ------------------------------------------------------------------------
 120 ------------------------------------------------------------------------
 121 toTree :: ( MonadError e m
 122           , HasTreeError e)
 123        => Map (Maybe ParentId) [DbTreeNode]
 124        -> m (Tree NodeTree)
 125 toTree m =
 126     case lookup Nothing m of
 127         Just [n] -> pure $ toTree' m n
 128         Nothing  -> treeError NoRoot
 129         Just []  -> treeError EmptyRoot
 130         Just _   -> treeError TooManyRoots
 131
 132      where
 133       toTree' :: Map (Maybe ParentId) [DbTreeNode]
 134               -> DbTreeNode
 135               -> Tree NodeTree
 136       toTree' m' n =
 137         TreeN (toNodeTree n) $
 138           m' ^.. at (Just $ _dt_nodeId n) . _Just . each . to (toTree' m')
 139
 140       toNodeTree :: DbTreeNode
 141                  -> NodeTree
 142       toNodeTree (DbTreeNode nId tId _ n) = NodeTree n nodeType nId
 143         where
 144           nodeType = fromNodeTypeId tId
 145 ------------------------------------------------------------------------
 146 toTreeParent :: [DbTreeNode]
 147              -> Map (Maybe ParentId) [DbTreeNode]
 148 toTreeParent = fromListWith (<>) . map (\n -> (_dt_parentId n, [n]))
 149 ------------------------------------------------------------------------
 150 -- | Main DB Tree function
 151 dbTree :: RootId
 152        -> [NodeType]
 153        -> Cmd err [DbTreeNode]
 154 dbTree rootId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n)
 155   <$> runPGSQuery [sql|
 156     WITH RECURSIVE
 157         tree (id, typename, parent_id, name) AS
 158         (
 159           SELECT p.id, p.typename, p.parent_id, p.name
 160           FROM nodes AS p
 161           WHERE p.id = ?
 162
 163           UNION
 164
 165           SELECT c.id, c.typename, c.parent_id, c.name
 166           FROM nodes AS c
 167
 168           INNER JOIN tree AS s ON c.parent_id = s.id
 169            WHERE c.typename IN ?
 170         )
 171     SELECT * from tree;
 172     |] (rootId, In typename)
 173   where
 174     typename = map nodeTypeId ns
 175     ns = case nodeTypes of
 176       [] -> allNodeTypes
 177       _  -> nodeTypes
 178
 179 isDescendantOf :: NodeId -> RootId -> Cmd err Bool
 180 isDescendantOf childId rootId = (== [Only True])
 181   <$> runPGSQuery [sql|
 182                   BEGIN ;
 183                   SET TRANSACTION READ ONLY;
 184                   COMMIT;
 185
 186                   WITH RECURSIVE
 187       tree (id, parent_id) AS
 188       (
 189         SELECT c.id, c.parent_id
 190         FROM nodes AS c
 191         WHERE c.id = ?
 192
 193         UNION
 194
 195         SELECT p.id, p.parent_id
 196         FROM nodes AS p
 197         INNER JOIN tree AS t ON t.parent_id = p.id
 198
 199       )
 200   SELECT COUNT(*) = 1 from tree AS t
 201   WHERE t.id = ?;
 202   |] (childId, rootId)
 203
 204 -- TODO should we check the category?
 205 isIn :: NodeId -> DocId -> Cmd err Bool
 206 isIn cId docId = ( == [Only True])
 207   <$> runPGSQuery [sql| SELECT COUNT(*) = 1
 208     FROM nodes_nodes nn
 209       WHERE nn.node1_id = ?
 210         AND nn.node2_id = ?;
 211   |] (cId, docId)
 212 -----------------------------------------------------