, dt_nodeId
, dt_typeId
, findShared
+ , findNodes
+ , NodeMode(..)
)
where
-import Control.Lens ((^..), at, each, _Just, to, set, makeLenses)
+import Control.Lens (view, toListOf, at, each, _Just, to, set, makeLenses)
import Control.Monad.Error.Class (MonadError())
import Data.List (tail, concat, nub)
import Data.Map (Map, fromListWith, lookup)
------------------------------------------------------------------------
-data TreeMode = Basic | Advanced
+data TreeMode = TreeBasic | TreeAdvanced
-- | Returns the Tree of Nodes in Database
tree :: HasTreeError err
-> RootId
-> [NodeType]
-> Cmd err (Tree NodeTree)
-tree Basic = tree_basic
-tree Advanced = tree_advanced
+tree TreeBasic = tree_basic
+tree TreeAdvanced = tree_advanced
-- | Tree basic returns the Tree of Nodes in Database
-- (without shared folders)
-> [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 r Private nodeTypes
+ sharedRoots <- findNodes r Shared nodeTypes
+ publicRoots <- findNodes r Public nodeTypes
toTree $ toTreeParent (mainRoot <> sharedRoots <> publicRoots)
+------------------------------------------------------------------------
+data NodeMode = Private | Shared | Public
+
+findNodes :: HasTreeError err
+ => RootId
+ -> NodeMode
+ -> [NodeType]
+ -> Cmd err [DbTreeNode]
+findNodes r Private nt = dbTree r nt
+findNodes r Shared nt = findShared r NodeFolderShared nt sharedTreeUpdate
+findNodes r Public nt = findShared r NodeFolderPublic nt publicTreeUpdate
+
------------------------------------------------------------------------
-- | Collaborative Nodes in the Tree
findShared :: HasTreeError err
trees <- mapM (updateTree nts fun) foldersSharedId
pure $ concat trees
+
type UpdateTree err = ParentId -> [NodeType] -> NodeId -> Cmd err [DbTreeNode]
updateTree :: HasTreeError err
sharedTreeUpdate :: HasTreeError err => UpdateTree err
sharedTreeUpdate p nt n = dbTree n nt
- <&> map (\n' -> if _dt_nodeId n' == n
+ <&> map (\n' -> if (view dt_nodeId n') == n
-- && elem (fromNodeTypeId $ _dt_typeId n') [NodeGraph]
-- && not (elem (fromNodeTypeId $ _dt_typeId n') [NodeFile])
then set dt_parentId (Just p) n'
-> Tree NodeTree
toTree' m' n =
TreeN (toNodeTree n) $
- m' ^.. at (Just $ _dt_nodeId n) . _Just . each . to (toTree' m')
+ -- | Lines below are equivalent computationally but not semantically
+ -- m' ^.. at (Just $ _dt_nodeId n) . _Just . each . to (toTree' m')
+ toListOf (at (Just $ _dt_nodeId n) . _Just . each . to (toTree' m')) m'
toNodeTree :: DbTreeNode
-> NodeTree
- toNodeTree (DbTreeNode nId tId _ n) = NodeTree n nodeType nId
- where
- nodeType = fromNodeTypeId tId
+ toNodeTree (DbTreeNode nId tId _ n) = NodeTree n (fromNodeTypeId tId) nId
+
------------------------------------------------------------------------
toTreeParent :: [DbTreeNode]
-> Map (Maybe ParentId) [DbTreeNode]