[FIX] email model
[gargantext.git] / src / Gargantext / Database / Query / Tree.hs
index f062a4a551e3aa85fd77b07393237354ed1a71f1..3800b1deaf6fcf76fff85235a4348f2bc0376cd5 100644 (file)
@@ -29,10 +29,12 @@ module Gargantext.Database.Query.Tree
   , 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)
@@ -62,7 +64,7 @@ instance Eq DbTreeNode where
 
 ------------------------------------------------------------------------
 
-data TreeMode = Basic | Advanced
+data TreeMode = TreeBasic | TreeAdvanced
 
 -- | Returns the Tree of Nodes in Database
 tree :: HasTreeError err
@@ -70,8 +72,8 @@ 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)
@@ -91,11 +93,23 @@ tree_advanced :: HasTreeError err
               -> [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
@@ -106,6 +120,7 @@ findShared r nt nts fun = do
   trees           <- mapM (updateTree nts fun) foldersSharedId
   pure $ concat trees
 
+
 type UpdateTree err = ParentId -> [NodeType] -> NodeId -> Cmd err [DbTreeNode]
 
 updateTree :: HasTreeError err
@@ -120,7 +135,7 @@ updateTree nts fun r = do
 
 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'
@@ -160,13 +175,14 @@ toTree m =
               -> 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]