Merge remote-tracking branch 'origin/dev-breadcrumbs-fix' into dev

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,23 +14,21 @@ Portability : POSIX
 
 module Gargantext.API.GraphQL.Node where
 
-import Data.Aeson
+import Data.Aeson ( 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.Core
+import Gargantext.API.GraphQL.Types ( GqlM )
+import Gargantext.Core ( HasDBid(lookupDBid) )
 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
@@ -89,7 +87,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
@@ -97,16 +101,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 []
@@ -114,6 +123,13 @@ 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
+  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 = nid
                             , 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,15 +15,15 @@ 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)
@@ -51,7 +51,8 @@ data TreeFirstLevel m = TreeFirstLevel
   , parent   :: m (Maybe TreeNode)
   , children :: [TreeNode]
   } deriving (Generic, GQLType)
-
+  
+    
 data BreadcrumbArgs = BreadcrumbArgs
   {
     node_id :: Int
@@ -105,31 +106,33 @@ 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)
+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
 
 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) => 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,26 @@ 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
+
+-- | 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 = ?;
     |]
 
 ------------------------------------------------------------------------