[FIX] removing cLouvain c++ lib
[gargantext.git] / src / Gargantext / Database / Query / Tree.hs
index 4cf0cd678fc0788900b0a89af1d6e7c1b1413a58..919429c4051bfc1d4017e0d4d344fc019391f00f 100644 (file)
@@ -44,7 +44,7 @@ import Control.Monad.Error.Class (MonadError())
 import Data.List (tail, concat, nub)
 import qualified Data.List as List
 import Data.Map (Map, fromListWith, lookup)
-import Data.Monoid (mconcat)
+-- import Data.Monoid (mconcat)
 import Data.Proxy
 -- import qualified Data.Set  as Set
 import Data.Text (Text)
@@ -52,7 +52,7 @@ import Database.PostgreSQL.Simple
 import Database.PostgreSQL.Simple.SqlQQ
 
 import Gargantext.Prelude
-
+import Gargantext.Core
 import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
 import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId, fromNodeTypeId)
 import Gargantext.Database.Admin.Types.Hyperdata.Any (HyperdataAny)
@@ -110,13 +110,13 @@ tree_advanced :: (HasTreeError err, HasNodeError err)
               -> [NodeType]
               -> Cmd err (Tree NodeTree)
 tree_advanced r nodeTypes = do
-  let rPrefix s = "[tree_advanced] root = " <> show r <> " " <> s
+  -- let rPrefix s = "[tree_advanced] root = " <> show r <> " " <> s
   mainRoot    <- findNodes r Private nodeTypes
-  printDebug (rPrefix "mainRoot") mainRoot
+  -- printDebug (rPrefix "mainRoot") mainRoot
   publicRoots <- findNodes r Public  nodeTypes
-  printDebug (rPrefix "publicRoots") publicRoots
+  -- printDebug (rPrefix "publicRoots") publicRoots
   sharedRoots <- findNodes r Shared  nodeTypes
-  printDebug (rPrefix "sharedRoots") sharedRoots
+  -- printDebug (rPrefix "sharedRoots") sharedRoots
   toTree      $ toTreeParent (mainRoot <> sharedRoots <> publicRoots)
 
 -- | Fetch only first level of tree
@@ -125,24 +125,24 @@ tree_first_level :: (HasTreeError err, HasNodeError err)
                  -> [NodeType]
                  -> Cmd err (Tree NodeTree)
 tree_first_level r nodeTypes = do
-  let rPrefix s = mconcat [ "[tree_first_level] root = "
-                          , show r
-                          , ", nodeTypes = "
-                          , show nodeTypes
-                          , " "
-                          , s ]
+  -- let rPrefix s = mconcat [ "[tree_first_level] root = "
+  --                         , show r
+  --                         , ", nodeTypes = "
+  --                         , show nodeTypes
+  --                         , " "
+  --                         , s ]
   mainRoot    <- findNodes r Private nodeTypes
-  printDebug (rPrefix "mainRoot") mainRoot
-  publicRoots <- findNodes r Public  nodeTypes
-  printDebug (rPrefix "publicRoots") publicRoots
+  -- printDebug (rPrefix "mainRoot") mainRoot
+  publicRoots <- findNodes r PublicDirect  nodeTypes
+  -- printDebug (rPrefix "publicRoots") publicRoots
   sharedRoots <- findNodes r SharedDirect  nodeTypes
-  printDebug (rPrefix "sharedRoots") sharedRoots
+  -- printDebug (rPrefix "sharedRoots") sharedRoots
   ret <- toTree $ toSubtreeParent r (mainRoot <> sharedRoots <> publicRoots)
-  printDebug (rPrefix "tree") ret
+  -- printDebug (rPrefix "tree") ret
   pure ret
 
 ------------------------------------------------------------------------
-data NodeMode = Private | Shared | Public | SharedDirect
+data NodeMode = Private | Shared | Public | SharedDirect | PublicDirect
 
 findNodes :: (HasTreeError err, HasNodeError err)
           => RootId
@@ -153,6 +153,7 @@ findNodes r Private nt       = dbTree r nt
 findNodes r Shared  nt       = findShared r NodeFolderShared nt sharedTreeUpdate
 findNodes r SharedDirect  nt = findSharedDirect r NodeFolderShared nt sharedTreeUpdate
 findNodes r Public  nt       = findShared r NodeFolderPublic nt publicTreeUpdate
+findNodes r PublicDirect  nt = findSharedDirect r NodeFolderPublic nt publicTreeUpdate
 
 ------------------------------------------------------------------------
 -- | Collaborative Nodes in the Tree
@@ -165,27 +166,30 @@ findShared r nt nts fun = do
   trees           <- mapM (updateTree nts fun) foldersSharedId
   pure $ concat trees
 
+-- | Find shared folders with "direct" access, i.e. when fetching only
+-- first-level subcomponents. This works in a simplified manner: fetch the node
+-- and get the tree for its parent.
 findSharedDirect :: (HasTreeError err, HasNodeError err)
                  => RootId -> NodeType -> [NodeType] -> UpdateTree err
                  -> Cmd err [DbTreeNode]
 findSharedDirect r nt nts fun = do
-  let rPrefix s = mconcat [ "[findSharedDirect] r = "
-                          , show r
-                          , ", nt = "
-                          , show nt
-                          , ", nts = "
-                          , show nts
-                          , " "
-                          , s ]
+  -- let rPrefix s = mconcat [ "[findSharedDirect] r = "
+  --                         , show r
+  --                         , ", nt = "
+  --                         , show nt
+  --                         , ", nts = "
+  --                         , show nts
+  --                         , " "
+  --                         , s ]
   parent <- getNodeWith r (Proxy :: Proxy HyperdataAny)
   let mParent = _node_parentId parent
   case mParent of
     Nothing -> pure []
     Just parentId -> do
       foldersSharedId <- findNodesId parentId [nt]
-      printDebug (rPrefix "foldersSharedId") foldersSharedId
+      -- printDebug (rPrefix "foldersSharedId") foldersSharedId
       trees           <- mapM (updateTree nts fun) foldersSharedId
-      printDebug (rPrefix "trees") trees
+      -- printDebug (rPrefix "trees") trees
       pure $ concat trees
 
 
@@ -204,16 +208,16 @@ updateTree nts fun r = do
 sharedTreeUpdate :: HasTreeError err => UpdateTree err
 sharedTreeUpdate p nt n = dbTree n nt
                <&> map (\n' -> if (view dt_nodeId n') == n
-                                  -- && elem (fromNodeTypeId $ _dt_typeId n') [NodeGraph]
-                                  -- && not (elem (fromNodeTypeId $ _dt_typeId n') [NodeFile])
+                                  -- && elem (fromDBid $ _dt_typeId n') [NodeGraph]
+                                  -- && not (elem (fromDBid $ _dt_typeId n') [NodeFile])
                                   then set dt_parentId (Just p) n'
                                   else n')
 
 publicTreeUpdate :: HasTreeError err => UpdateTree err
 publicTreeUpdate p nt n = dbTree n nt
                <&> map (\n' -> if _dt_nodeId n' == n
-                                  -- && (fromNodeTypeId $ _dt_typeId n') /= NodeGraph
-                                  -- && not (elem (fromNodeTypeId $ _dt_typeId n') [NodeFile])
+                                  -- && (fromDBid $ _dt_typeId n') /= NodeGraph
+                                  -- && not (elem (fromDBid $ _dt_typeId n') [NodeFile])
                                   then set dt_parentId (Just p) n'
                                   else n')
 
@@ -229,7 +233,7 @@ findNodesWithType :: RootId -> [NodeType] -> [NodeType] -> Cmd err [DbTreeNode]
 findNodesWithType root target through =
   filter isInTarget <$> dbTree root through
     where
-      isInTarget n = List.elem (fromNodeTypeId $ view dt_typeId n)
+      isInTarget n = List.elem (fromDBid $ view dt_typeId n)
                    $ List.nub $ target <> through
 
 ------------------------------------------------------------------------