Commit d3d2b646 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[tree] remove printDebug and add comment for shared direct tree

parent 346e64c2
...@@ -44,7 +44,7 @@ import Control.Monad.Error.Class (MonadError()) ...@@ -44,7 +44,7 @@ import Control.Monad.Error.Class (MonadError())
import Data.List (tail, concat, nub) import Data.List (tail, concat, nub)
import qualified Data.List as List import qualified Data.List as List
import Data.Map (Map, fromListWith, lookup) import Data.Map (Map, fromListWith, lookup)
import Data.Monoid (mconcat) -- import Data.Monoid (mconcat)
import Data.Proxy import Data.Proxy
-- import qualified Data.Set as Set -- import qualified Data.Set as Set
import Data.Text (Text) import Data.Text (Text)
...@@ -110,13 +110,13 @@ tree_advanced :: (HasTreeError err, HasNodeError err) ...@@ -110,13 +110,13 @@ tree_advanced :: (HasTreeError err, HasNodeError err)
-> [NodeType] -> [NodeType]
-> Cmd err (Tree NodeTree) -> Cmd err (Tree NodeTree)
tree_advanced r nodeTypes = do 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 mainRoot <- findNodes r Private nodeTypes
printDebug (rPrefix "mainRoot") mainRoot -- printDebug (rPrefix "mainRoot") mainRoot
publicRoots <- findNodes r Public nodeTypes publicRoots <- findNodes r Public nodeTypes
printDebug (rPrefix "publicRoots") publicRoots -- printDebug (rPrefix "publicRoots") publicRoots
sharedRoots <- findNodes r Shared nodeTypes sharedRoots <- findNodes r Shared nodeTypes
printDebug (rPrefix "sharedRoots") sharedRoots -- printDebug (rPrefix "sharedRoots") sharedRoots
toTree $ toTreeParent (mainRoot <> sharedRoots <> publicRoots) toTree $ toTreeParent (mainRoot <> sharedRoots <> publicRoots)
-- | Fetch only first level of tree -- | Fetch only first level of tree
...@@ -125,20 +125,20 @@ tree_first_level :: (HasTreeError err, HasNodeError err) ...@@ -125,20 +125,20 @@ tree_first_level :: (HasTreeError err, HasNodeError err)
-> [NodeType] -> [NodeType]
-> Cmd err (Tree NodeTree) -> Cmd err (Tree NodeTree)
tree_first_level r nodeTypes = do tree_first_level r nodeTypes = do
let rPrefix s = mconcat [ "[tree_first_level] root = " -- let rPrefix s = mconcat [ "[tree_first_level] root = "
, show r -- , show r
, ", nodeTypes = " -- , ", nodeTypes = "
, show nodeTypes -- , show nodeTypes
, " " -- , " "
, s ] -- , s ]
mainRoot <- findNodes r Private nodeTypes mainRoot <- findNodes r Private nodeTypes
printDebug (rPrefix "mainRoot") mainRoot -- printDebug (rPrefix "mainRoot") mainRoot
publicRoots <- findNodes r Public nodeTypes publicRoots <- findNodes r Public nodeTypes
printDebug (rPrefix "publicRoots") publicRoots -- printDebug (rPrefix "publicRoots") publicRoots
sharedRoots <- findNodes r SharedDirect nodeTypes sharedRoots <- findNodes r SharedDirect nodeTypes
printDebug (rPrefix "sharedRoots") sharedRoots -- printDebug (rPrefix "sharedRoots") sharedRoots
ret <- toTree $ toSubtreeParent r (mainRoot <> sharedRoots <> publicRoots) ret <- toTree $ toSubtreeParent r (mainRoot <> sharedRoots <> publicRoots)
printDebug (rPrefix "tree") ret -- printDebug (rPrefix "tree") ret
pure ret pure ret
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -165,27 +165,30 @@ findShared r nt nts fun = do ...@@ -165,27 +165,30 @@ findShared r nt nts fun = do
trees <- mapM (updateTree nts fun) foldersSharedId trees <- mapM (updateTree nts fun) foldersSharedId
pure $ concat trees 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) findSharedDirect :: (HasTreeError err, HasNodeError err)
=> RootId -> NodeType -> [NodeType] -> UpdateTree err => RootId -> NodeType -> [NodeType] -> UpdateTree err
-> Cmd err [DbTreeNode] -> Cmd err [DbTreeNode]
findSharedDirect r nt nts fun = do findSharedDirect r nt nts fun = do
let rPrefix s = mconcat [ "[findSharedDirect] r = " -- let rPrefix s = mconcat [ "[findSharedDirect] r = "
, show r -- , show r
, ", nt = " -- , ", nt = "
, show nt -- , show nt
, ", nts = " -- , ", nts = "
, show nts -- , show nts
, " " -- , " "
, s ] -- , s ]
parent <- getNodeWith r (Proxy :: Proxy HyperdataAny) parent <- getNodeWith r (Proxy :: Proxy HyperdataAny)
let mParent = _node_parentId parent let mParent = _node_parentId parent
case mParent of case mParent of
Nothing -> pure [] Nothing -> pure []
Just parentId -> do Just parentId -> do
foldersSharedId <- findNodesId parentId [nt] foldersSharedId <- findNodesId parentId [nt]
printDebug (rPrefix "foldersSharedId") foldersSharedId -- printDebug (rPrefix "foldersSharedId") foldersSharedId
trees <- mapM (updateTree nts fun) foldersSharedId trees <- mapM (updateTree nts fun) foldersSharedId
printDebug (rPrefix "trees") trees -- printDebug (rPrefix "trees") trees
pure $ concat trees pure $ concat trees
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment