, dt_nodeId
, dt_typeId
, findShared
+ , findNodes
+ , NodeMode(..)
)
where
import Control.Lens ((^..), at, each, _Just, to, set, makeLenses)
import Control.Monad.Error.Class (MonadError())
-import Data.List (tail, concat)
+import Data.List (tail, concat, nub)
import Data.Map (Map, fromListWith, lookup)
import Data.Text (Text)
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.SqlQQ
import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId, fromNodeTypeId)
-import Gargantext.Database.Admin.Types.Node (NodeId, NodeType, DocId, allNodeTypes)
-import Gargantext.Database.Admin.Types.Node -- (pgNodeId, NodeType(..))
+import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd, runPGSQuery)
import Gargantext.Database.Query.Table.NodeNode (getNodeNode)
import Gargantext.Database.Query.Tree.Error
import Gargantext.Prelude
------------------------------------------------------------------------
-data DbTreeNode = DbTreeNode { _dt_nodeId :: NodeId
- , _dt_typeId :: Int
+data DbTreeNode = DbTreeNode { _dt_nodeId :: NodeId
+ , _dt_typeId :: Int
, _dt_parentId :: Maybe NodeId
, _dt_name :: Text
} deriving (Show)
makeLenses ''DbTreeNode
+
+instance Eq DbTreeNode where
+ (==) d1 d2 = (==) (_dt_nodeId d1) (_dt_nodeId d2)
+
------------------------------------------------------------------------
-data TreeMode = Basic | Advanced
+data TreeMode = TreeBasic | TreeAdvanced
-- | Returns the Tree of Nodes in Database
tree :: HasTreeError err
- => TreeMode
- -> RootId
- -> [NodeType]
- -> Cmd err (Tree NodeTree)
-tree Basic = tree_basic
-tree Advanced = tree_advanced
+ => TreeMode
+ -> RootId
+ -> [NodeType]
+ -> Cmd err (Tree NodeTree)
+tree TreeBasic = tree_basic
+tree TreeAdvanced = tree_advanced
-- | Tree basic returns the Tree of Nodes in Database
-- (without shared folders)
-- keeping this for teaching purpose only
tree_basic :: HasTreeError err
- => RootId
- -> [NodeType]
- -> Cmd err (Tree NodeTree)
-tree_basic r nodeTypes =
+ => RootId
+ -> [NodeType]
+ -> Cmd err (Tree NodeTree)
+tree_basic r nodeTypes =
(dbTree r nodeTypes <&> toTreeParent) >>= toTree
-- Same as (but easier to read) :
-- toTree =<< (toTreeParent <$> dbTree r nodeTypes)
-- | Advanced mode of the Tree enables shared nodes
tree_advanced :: HasTreeError err
- => RootId
- -> [NodeType]
- -> Cmd err (Tree NodeTree)
+ => RootId
+ -> [NodeType]
+ -> Cmd err (Tree NodeTree)
tree_advanced r nodeTypes = do
- mainRoot <- dbTree r nodeTypes
- sharedRoots <- findShared r NodeFolderShared nodeTypes sharedTreeUpdate
- publicRoots <- findShared r NodeFolderPublic nodeTypes publicTreeUpdate
+ mainRoot <- findNodes Private r nodeTypes
+ sharedRoots <- findNodes Shared r nodeTypes
+ publicRoots <- findNodes Public r nodeTypes
toTree $ toTreeParent (mainRoot <> sharedRoots <> publicRoots)
+------------------------------------------------------------------------
+data NodeMode = Private | Shared | Public
+
+findNodes :: HasTreeError err
+ => NodeMode
+ -> RootId -> [NodeType]
+ -> Cmd err [DbTreeNode]
+findNodes Private r nt = dbTree r nt
+findNodes Shared r nt = findShared r NodeFolderShared nt sharedTreeUpdate
+findNodes Public r nt = findShared r NodeFolderPublic nt publicTreeUpdate
+
+
------------------------------------------------------------------------
-- | Collaborative Nodes in the Tree
-findShared :: RootId -> NodeType -> [NodeType] -> UpdateTree err -> Cmd err [DbTreeNode]
+findShared :: HasTreeError err
+ => RootId -> NodeType -> [NodeType] -> UpdateTree err
+ -> Cmd err [DbTreeNode]
findShared r nt nts fun = do
- folderSharedId <- maybe (panic "no folder found") identity
- <$> head
- <$> findNodesId r [nt]
- folders <- getNodeNode folderSharedId
- nodesSharedId <- mapM (\child -> fun folderSharedId child nts)
+ foldersSharedId <- findNodesId r [nt]
+ trees <- mapM (updateTree nts fun) foldersSharedId
+ pure $ concat trees
+
+type UpdateTree err = ParentId -> [NodeType] -> NodeId -> Cmd err [DbTreeNode]
+
+updateTree :: HasTreeError err
+ => [NodeType] -> UpdateTree err -> RootId
+ -> Cmd err [DbTreeNode]
+updateTree nts fun r = do
+ folders <- getNodeNode r
+ nodesSharedId <- mapM (fun r nts)
$ map _nn_node2_id folders
pure $ concat nodesSharedId
-type UpdateTree err = ParentId -> NodeId -> [NodeType] -> Cmd err [DbTreeNode]
-
-sharedTreeUpdate :: ParentId -> NodeId -> [NodeType] -> Cmd err [DbTreeNode]
-sharedTreeUpdate p n nt = dbTree n nt
+
+sharedTreeUpdate :: HasTreeError err => UpdateTree err
+sharedTreeUpdate p nt n = dbTree n nt
<&> map (\n' -> if _dt_nodeId n' == n
+ -- && elem (fromNodeTypeId $ _dt_typeId n') [NodeGraph]
+ -- && not (elem (fromNodeTypeId $ _dt_typeId n') [NodeFile])
then set dt_parentId (Just p) n'
else n')
-publicTreeUpdate :: ParentId -> NodeId -> [NodeType] -> Cmd err [DbTreeNode]
-publicTreeUpdate p n nt = dbTree n nt
+publicTreeUpdate :: HasTreeError err => UpdateTree err
+publicTreeUpdate p nt n = dbTree n nt
<&> map (\n' -> if _dt_nodeId n' == n
- -- && (fromNodeTypeId $ _dt_typeId n') /= NodeFolderPublic
+ -- && (fromNodeTypeId $ _dt_typeId n') /= NodeGraph
+ -- && not (elem (fromNodeTypeId $ _dt_typeId n') [NodeFile])
then set dt_parentId (Just p) n'
else n')
------------------------------------------------------------------------
toTreeParent :: [DbTreeNode]
-> Map (Maybe ParentId) [DbTreeNode]
-toTreeParent = fromListWith (<>) . map (\n -> (_dt_parentId n, [n]))
+toTreeParent = fromListWith (\a b -> nub $ a <> b) . map (\n -> (_dt_parentId n, [n]))
------------------------------------------------------------------------
-- | Main DB Tree function
dbTree :: RootId