[graphql] add node_children to graphql

Also, fixed breadcrumbs to accept AppRoute.

src/Gargantext/API/GraphQL.hs

@@ -70,6 +70,7 @@ data Query m
     , languages           :: m [GQLNLP.LanguageTuple]
     , nodes               :: GQLNode.NodeArgs -> m [GQLNode.Node]
     , nodes_corpus        :: GQLNode.CorpusArgs -> m [GQLNode.Corpus]
+    , node_children       :: GQLNode.NodeChildrenArgs -> m [GQLNode.Node]
     , node_parent         :: GQLNode.NodeParentArgs -> m [GQLNode.Node]
     , user_infos          :: GQLUserInfo.UserInfoArgs -> m [GQLUserInfo.UserInfo]
     , users               :: GQLUser.UserArgs -> m [GQLUser.User m]
@@ -121,6 +122,7 @@ rootResolver authenticatedUser policyManager =
                             , languages           = GQLNLP.resolveLanguages
                             , nodes               = GQLNode.resolveNodes authenticatedUser policyManager
                             , nodes_corpus        = GQLNode.resolveNodesCorpus
+                            , node_children       = GQLNode.resolveNodeChildren
                             , node_parent         = GQLNode.resolveNodeParent
                             , user_infos          = GQLUserInfo.resolveUserInfos authenticatedUser policyManager
                             , users               = GQLUser.resolveUsers authenticatedUser policyManager

src/Gargantext/API/GraphQL/Node.hs

@@ -14,22 +14,20 @@ Portability : POSIX
 
 module Gargantext.API.GraphQL.Node where
 
-import Data.Aeson
+import Data.Aeson ( fromJSON, Result(..), Value(..) )
 import Data.Aeson.KeyMap qualified as KM
 import Data.Morpheus.Types ( GQLType )
-import Data.Text qualified as T
-import Gargantext.API.Admin.Auth.Types
-import Gargantext.API.Auth.PolicyCheck
+import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser )
+import Gargantext.API.Auth.PolicyCheck ( nodeChecks, AccessPolicyManager )
 import Gargantext.API.GraphQL.PolicyCheck (withPolicy)
-import Gargantext.API.GraphQL.Types
+import Gargantext.API.GraphQL.Types ( GqlM )
 import Gargantext.Database.Admin.Types.Node (NodeType)
 import Gargantext.Database.Admin.Types.Node qualified as NN
 import Gargantext.Database.Prelude (CmdCommon)  -- , JSONB)
-import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, getNode)
+import Gargantext.Database.Query.Table.Node (getClosestChildrenByType, getClosestParentIdByType, getNode)
 import Gargantext.Database.Schema.Node qualified as N
 import Gargantext.Prelude
 import PUBMED.Types qualified as PUBMED
-import Prelude qualified
 
 data Corpus = Corpus
   { id           :: Int
@@ -87,7 +85,13 @@ dbNodesCorpus corpus_id = do
 data NodeParentArgs
   = NodeParentArgs
     { node_id     :: Int
-    , parent_type :: Text
+    , parent_type :: NodeType
+    } deriving (Generic, GQLType)
+
+data NodeChildrenArgs
+  = NodeChildrenArgs
+    { node_id    :: Int
+    , child_type :: NodeType
     } deriving (Generic, GQLType)
 
 resolveNodeParent
@@ -95,16 +99,21 @@ resolveNodeParent
   => NodeParentArgs -> GqlM e env [Node]
 resolveNodeParent NodeParentArgs { node_id, parent_type } = dbParentNodes node_id parent_type
 
+resolveNodeChildren
+  :: (CmdCommon env)
+  => NodeChildrenArgs -> GqlM e env [Node]
+resolveNodeChildren NodeChildrenArgs { node_id, child_type } = dbChildNodes node_id child_type
+
 dbParentNodes
   :: (CmdCommon env)
-  => Int -> Text -> GqlM e env [Node]
-dbParentNodes node_id parent_type = do
-  let mParentType = readEither (T.unpack parent_type) :: Either Prelude.String NodeType
-  case mParentType of
-    Left err -> do
-      lift $ printDebug "[dbParentNodes] error reading parent type" (T.pack err)
-      pure []
-    Right parentType -> do
+  => Int -> NodeType -> GqlM e env [Node]
+dbParentNodes node_id parentType = do
+  -- let mParentType = readEither (T.unpack parent_type) :: Either Prelude.String NodeType
+  -- case mParentType of
+  --   Left err -> do
+  --     lift $ printDebug "[dbParentNodes] error reading parent type" (T.pack err)
+  --     pure []
+  --   Right parentType -> do
       mNodeId <- lift $ getClosestParentIdByType (NN.UnsafeMkNodeId node_id) parentType -- (fromNodeTypeId parent_type_id)
       case mNodeId of
         Nothing -> pure []
@@ -112,6 +121,20 @@ dbParentNodes node_id parent_type = do
           node <- lift $ getNode id
           pure [toNode node]
 
+dbChildNodes
+  :: (CmdCommon env)
+  => Int -> NodeType -> GqlM e env [Node]
+dbChildNodes node_id childType = do
+  -- let mChildType = readEither (T.unpack child_type) :: Either Prelude.String NodeType
+  -- case mChildType of
+  --   Left err -> do
+  --     lift $ printDebug "[dbChildNodes] error reading parent type" (T.pack err)
+  --     pure []
+  --   Right childType -> do
+      childIds <- lift $ getClosestChildrenByType (NN.UnsafeMkNodeId node_id) childType -- (fromNodeTypeId parent_type_id)
+      children <- lift $ mapM getNode childIds
+      pure $ toNode <$> children
+
 toNode :: NN.Node json -> Node
 toNode N.Node { .. } = Node { id = NN.unNodeId _node_id
                             , name = _node_name

src/Gargantext/API/GraphQL/PolicyCheck.hs

@@ -3,11 +3,11 @@ module Gargantext.API.GraphQL.PolicyCheck where
 
 import Prelude
 
-import Control.Monad.Except
-import Gargantext.API.Admin.Auth.Types
-import Gargantext.API.Auth.PolicyCheck
-import Gargantext.API.Errors.Types
-import Gargantext.API.GraphQL.Types
+import Control.Monad.Except (MonadError(..), MonadTrans(..))
+import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser )
+import Gargantext.API.Auth.PolicyCheck ( BoolExpr, AccessCheck, AccessPolicyManager(..), AccessResult(..))
+import Gargantext.API.Errors.Types ( BackendInternalError(..) )
+import Gargantext.API.GraphQL.Types (GqlM)
 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
 
 withPolicy :: (HasConnectionPool env, HasConfig env)

src/Gargantext/API/GraphQL/TreeFirstLevel.hs

@@ -15,18 +15,18 @@ Portability : POSIX
 module Gargantext.API.GraphQL.TreeFirstLevel where
 
 import Data.Morpheus.Types (GQLType)
-import Gargantext.API.Admin.Auth.Types
-import Gargantext.API.Auth.PolicyCheck
-import Gargantext.API.GraphQL.PolicyCheck
-import Gargantext.API.GraphQL.Types
+import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser )
+import Gargantext.API.Auth.PolicyCheck (AccessPolicyManager, nodeChecks)
+import Gargantext.API.GraphQL.PolicyCheck (withPolicy)
+import Gargantext.API.GraphQL.Types ( GqlM )
 import Gargantext.Core (fromDBid)
-import Gargantext.Core.Types (Tree, NodeTree, NodeType)
-import Gargantext.Core.Types.Main ( Tree(TreeN), _tn_node, _tn_children, NodeTree(NodeTree, _nt_id, _nt_type), _nt_name )
+-- import Gargantext.Core.Types (ContextId, CorpusId, ListId)
+import Gargantext.Core.Types.Main ( Tree(..), _tn_node, _tn_children, NodeTree(..), _nt_name )
 import Gargantext.Database.Admin.Config ()
-import Gargantext.Database.Admin.Types.Node (allNodeTypes, NodeId (UnsafeMkNodeId))
+import Gargantext.Database.Admin.Types.Node (allNodeTypes, NodeId(..), NodeType)
 import Gargantext.Database.Admin.Types.Node qualified as NN
 import Gargantext.Database.Prelude (CmdCommon)
-import Gargantext.Database.Query.Table.Node (getNode)
+import Gargantext.Database.Query.Table.Node (getNode, getChildrenByType, getClosestParentIdByType)
 import Gargantext.Database.Query.Tree qualified as T
 import Gargantext.Database.Schema.Node (NodePoly(_node_parent_id))
 import Gargantext.Database.Schema.Node qualified as N
@@ -52,9 +52,45 @@ data TreeFirstLevel m = TreeFirstLevel
   , children :: [TreeNode]
   } deriving (Generic, GQLType)
 
+
+data AppRoute =
+    AnnuaireRoute { nodeId :: Int }
+  | ContactPageRoute { annuaireId :: Int
+                     , nodeId     :: Int }
+  | CorpusRoute { nodeId :: Int }
+  | CorpusCodeRoute { nodeId :: Int }
+  | CorpusDocumentRoute  { corpusId   :: Int
+                         , documentId :: Int
+                         , listId     :: Int }
+  | DashboardRoute { nodeId :: Int }
+  | DocumentRoute { documentId :: Int
+                  , listId     :: Int }
+  | FolderRoute { nodeId :: Int }
+  | FolderPrivateRoute { nodeId :: Int }
+  | FolderPublicRoute { nodeId :: Int }
+  | FolderSharedRoute { nodeId :: Int }
+  | ListsRoute { nodeId :: Int }
+  | NodeTextsRoute { nodeId :: Int }
+  | PGraphExplorerRoute { nodeId :: Int }
+  | PhyloExplorerRoute { nodeId :: Int }
+  | RouteFileRoute { nodeId :: Int }
+  | RouteFrameCalcRoute { nodeId :: Int }
+  | RouteFrameCodeRoute { nodeId :: Int }
+  | RouteFrameVisioRoute { nodeId :: Int }
+  | RouteFrameWriteRoute { nodeId :: Int }
+  | TeamRoute { nodeId :: Int }
+  | TreeFlatRoute { nodeId :: Int
+                  , query  :: Text }
+  | UserPageRoute { nodeId :: Int }
+  | ForgotPasswordRoute
+  | HomeRoute
+  | LoginRoute
+  deriving (Generic, GQLType)
+  
+    
 data BreadcrumbArgs = BreadcrumbArgs
   {
-    node_id :: Int
+    route :: AppRoute
   } deriving (Generic, GQLType)
 
 data BreadcrumbInfo = BreadcrumbInfo
@@ -105,31 +141,96 @@ resolveParent Nothing = pure Nothing
 
 
 nodeToTreeNode :: HasCallStack => NN.Node json -> Maybe TreeNode
-nodeToTreeNode N.Node {..} = if (fromDBid _node_typename /= NN.NodeFolderShared) && (fromDBid _node_typename /= NN.NodeTeam)
-                             then
-                             Just TreeNode { id        = NN.unNodeId _node_id
-                                           , name      = _node_name
-                                           , node_type = fromDBid _node_typename
-                                           , parent_id = NN.unNodeId <$> _node_parent_id
-                                           }
-                             else
-                             Nothing
-
-resolveBreadcrumb :: (CmdCommon env) => BreadcrumbArgs -> GqlM e env (BreadcrumbInfo)
-resolveBreadcrumb BreadcrumbArgs { node_id } = dbRecursiveParents node_id
+nodeToTreeNode N.Node {..} =
+ if (fromDBid _node_typename /= NN.NodeFolderShared) && (fromDBid _node_typename /= NN.NodeTeam)
+   then
+     Just TreeNode { id        = NN.unNodeId _node_id
+                   , name      = _node_name
+                   , node_type = fromDBid _node_typename
+                   , parent_id = NN.unNodeId <$> _node_parent_id
+                   }
+   else
+     Nothing
+
+resolveBreadcrumb :: (CmdCommon env) => BreadcrumbArgs -> GqlM e env BreadcrumbInfo
+resolveBreadcrumb BreadcrumbArgs { route } = dbRecursiveParents route
 
 convertDbTreeToTreeNode :: HasCallStack => T.DbTreeNode -> TreeNode
-convertDbTreeToTreeNode T.DbTreeNode { _dt_name, _dt_nodeId, _dt_typeId, _dt_parentId } = TreeNode
-  { name = _dt_name
-  , id = NN.unNodeId _dt_nodeId
-  , node_type = fromDBid _dt_typeId
-  , parent_id = NN.unNodeId <$> _dt_parentId
-  }
-
-dbRecursiveParents :: (CmdCommon env) => Int -> GqlM e env (BreadcrumbInfo)
-dbRecursiveParents node_id = do
-  let nId = UnsafeMkNodeId node_id
+convertDbTreeToTreeNode T.DbTreeNode { _dt_name, _dt_nodeId, _dt_typeId, _dt_parentId } =
+  TreeNode
+    { name = _dt_name
+    , id = NN.unNodeId _dt_nodeId
+    , node_type = fromDBid _dt_typeId
+    , parent_id = NN.unNodeId <$> _dt_parentId
+    }
+
+dbRecursiveParents :: (CmdCommon env) => AppRoute -> GqlM e env BreadcrumbInfo
+dbRecursiveParents (AnnuaireRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (ContactPageRoute { .. }) = do
+  dbRecursiveParents' annuaireId
+dbRecursiveParents (CorpusRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (CorpusCodeRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (CorpusDocumentRoute { .. }) = do
+  docIds <- lift $ getChildrenByType (UnsafeMkNodeId corpusId) NN.NodeTexts
+  let docId = maybe corpusId NN._NodeId $ head docIds
+  dbRecursiveParents' docId
+dbRecursiveParents (DashboardRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (DocumentRoute { .. }) = do
+  mCorpusId <- lift $ getClosestParentIdByType (UnsafeMkNodeId listId) NN.NodeCorpus
+  let nodeId = maybe listId NN._NodeId mCorpusId
+  dbRecursiveParents' nodeId
+dbRecursiveParents (FolderRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (FolderPrivateRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (FolderPublicRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (FolderSharedRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (ListsRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (NodeTextsRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (PGraphExplorerRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (PhyloExplorerRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (RouteFileRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (RouteFrameCalcRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (RouteFrameCodeRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (RouteFrameVisioRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (RouteFrameWriteRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (TeamRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (TreeFlatRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents (UserPageRoute { .. }) = do
+  dbRecursiveParents' nodeId
+dbRecursiveParents ForgotPasswordRoute = do
+  pure $ BreadcrumbInfo { parents = [] }
+dbRecursiveParents HomeRoute = do
+  pure $ BreadcrumbInfo { parents = [] }
+dbRecursiveParents LoginRoute = do
+  pure $ BreadcrumbInfo { parents = [] }
+  -- let nId = UnsafeMkNodeId node_id
+  -- dbParents <- lift $ T.recursiveParents nId allNodeTypes
+  -- let treeNodes = map convertDbTreeToTreeNode dbParents
+  -- let breadcrumbInfo = BreadcrumbInfo { parents = treeNodes }
+  -- pure breadcrumbInfo  
+
+
+dbRecursiveParents' :: (CmdCommon env) => Int -> GqlM e env BreadcrumbInfo
+dbRecursiveParents' nodeId = do
+  let nId = UnsafeMkNodeId nodeId
   dbParents <- lift $ T.recursiveParents nId allNodeTypes
   let treeNodes = map convertDbTreeToTreeNode dbParents
-  let breadcrumbInfo = BreadcrumbInfo { parents = treeNodes }
-  pure breadcrumbInfo  
+  pure $ BreadcrumbInfo { parents = treeNodes }

src/Gargantext/Database/Query/Table/Node.hs

@@ -173,15 +173,36 @@ getChildrenByType :: HasDBid NodeType
                   -> NodeType
                   -> DBCmd err [NodeId]
 getChildrenByType nId nType = do
-  result <- runPGSQuery query (PGS.Only nId)
-  children_lst <- mapM (\(id, _) -> getChildrenByType id nType) result
-  pure $ concat $ [fst <$> filter (\(_, pTypename) -> pTypename == toDBid nType) result] ++ children_lst
+  childrenFirstLevel <- getClosestChildrenByType nId nType
+  childrenLst <- mapM (\id -> getChildrenByType id nType) childrenFirstLevel
+  pure $ childrenFirstLevel ++ concat childrenLst
+  -- result <- runPGSQuery query (PGS.Only nId)
+  -- children_lst <- mapM (\(id, _) -> getChildrenByType id nType) result
+  -- pure $ concat $ [fst <$> filter (\(_, pTypename) -> pTypename == toDBid nType) result] ++ children_lst
+  -- where
+  --   query :: PGS.Query
+  --   query = [sql|
+  --     SELECT n.id, n.typename
+  --     FROM nodes n
+  --     WHERE n.parent_id = ?;
+  --   |]
+
+-- | Given a node id, find all it's children (only first level) of
+-- given node type.
+getClosestChildrenByType :: HasDBid NodeType
+                         => NodeId
+                         -> NodeType
+                         -> DBCmd err [NodeId]
+getClosestChildrenByType nId nType = do
+  results <- runPGSQuery query (nId, toDBid nType)
+  pure $ (\(PGS.Only nodeId) -> nodeId) <$> results
   where
     query :: PGS.Query
     query = [sql|
-      SELECT n.id, n.typename
+      SELECT n.id
       FROM nodes n
-      WHERE n.parent_id = ?;
+      WHERE n.parent_id = ?
+      AND n.typename = ?;
     |]
 
 ------------------------------------------------------------------------