Merge remote-tracking branch 'origin/dev-tree-gql-improvements' into dev-merge

src/Gargantext/API/GraphQL/TreeFirstLevel.hs

@@ -31,6 +31,7 @@ data TreeNode = TreeNode
     name      :: Text
   , id        :: Int
   , node_type :: NodeType
+  , parent_id :: Maybe Int
   } deriving (Generic, GQLType)
 
 data TreeFirstLevel m = TreeFirstLevel
@@ -42,34 +43,37 @@ data TreeFirstLevel m = TreeFirstLevel
 
 type GqlM e env = Resolver QUERY e (GargM env GargError)
 
+type ParentId = Maybe NodeId
+
 resolveTree :: (HasConnectionPool env, HasConfig env, HasMail env) => TreeArgs -> GqlM e env (TreeFirstLevel (GqlM e env))
 resolveTree TreeArgs { root_id } = dbTree root_id
 
 dbTree :: (HasConnectionPool env, HasConfig env, HasMail env) => Int -> GqlM e env (TreeFirstLevel (GqlM e env))
 dbTree root_id = do
-  t <- lift $ T.tree T.TreeFirstLevel (NodeId root_id) allNodeTypes
+  let rId = NodeId root_id
+  t <- lift $ T.tree T.TreeFirstLevel rId allNodeTypes
   n <- lift $ getNode $ NodeId root_id
   let pId = toParentId n
-  pure $ toTree pId t
+  pure $ toTree rId pId t
   where
     toParentId N.Node { _node_parent_id } = _node_parent_id
 
 
-toTree :: (HasConnectionPool env, HasConfig env, HasMail env) => Maybe NodeId -> Tree NodeTree -> TreeFirstLevel (GqlM e env)
-toTree pId TreeN { _tn_node, _tn_children } = TreeFirstLevel
+toTree :: (HasConnectionPool env, HasConfig env, HasMail env) => NodeId -> ParentId -> Tree NodeTree -> TreeFirstLevel (GqlM e env)
+toTree rId pId TreeN { _tn_node, _tn_children } = TreeFirstLevel
   { parent   = resolveParent pId
-  , root     = toTreeNode _tn_node
-  , children = map childrenToTreeNodes _tn_children
+  , root     = toTreeNode pId _tn_node
+  , children = map childrenToTreeNodes $ zip _tn_children $ repeat rId
   }
 
-toTreeNode :: NodeTree -> TreeNode
-toTreeNode NodeTree { _nt_name, _nt_id, _nt_type } = TreeNode { name = _nt_name, id = id2int _nt_id, node_type = _nt_type }
+toTreeNode :: ParentId -> NodeTree -> TreeNode
+toTreeNode pId NodeTree { _nt_name, _nt_id, _nt_type } = TreeNode { name = _nt_name, id = id2int _nt_id, node_type = _nt_type, parent_id = id2int <$> pId}
   where
     id2int :: NodeId -> Int
     id2int (NodeId n) = n
 
-childrenToTreeNodes :: Tree NodeTree -> TreeNode
-childrenToTreeNodes TreeN {_tn_node} = toTreeNode _tn_node
+childrenToTreeNodes :: (Tree NodeTree, NodeId) -> TreeNode
+childrenToTreeNodes (TreeN {_tn_node}, rId) = toTreeNode (Just rId) _tn_node
 
 resolveParent :: (HasConnectionPool env, HasConfig env, HasMail env) => Maybe NodeId -> GqlM e env (Maybe TreeNode)
 resolveParent (Just pId) = do
@@ -82,4 +86,5 @@ nodeToTreeNode :: NN.Node json -> TreeNode
 nodeToTreeNode N.Node {..} = TreeNode { id        = NN.unNodeId _node_id
                                       , name      = _node_name
                                       , node_type = fromNodeTypeId _node_typename
+                                      , parent_id = NN.unNodeId <$> _node_parent_id
                                       }

src/Gargantext/API/GraphQL/UserInfo.hs

@@ -47,7 +47,6 @@ import Gargantext.Prelude
 import GHC.Generics (Generic)
 import Gargantext.API.GraphQL.Utils (AuthStatus(Invalid, Valid), authUser)
 import Gargantext.API.Admin.Types (HasSettings)
-import Gargantext.Database.Admin.Types.Node (unNodeId)
 
 data UserInfo = UserInfo
   { ui_id             :: Int
@@ -152,7 +151,7 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
     uh lens' (Just val) u_hyperdata = u_hyperdata & lens' .~ Just val
     uh' _ Nothing u_hyperdata = u_hyperdata
     uh' lens' (Just val) u_hyperdata = u_hyperdata & lens' .~ val
-    nId Node {_node_id} = unNodeId _node_id
+    nId Node {_node_id} = _node_id
 
 -- | Inner function to fetch the user from DB.
 dbUsers

src/Gargantext/API/GraphQL/Utils.hs

@@ -22,7 +22,7 @@ import Control.Lens.Getter (view)
 import Gargantext.Database.Prelude (Cmd')
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser (AuthenticatedUser, _authUser_id))
 import Data.ByteString (ByteString)
-import Gargantext.Database.Admin.Types.Node (unNodeId)
+import Gargantext.Database.Admin.Types.Node (NodeId)
 
 unPrefix :: T.Text -> GQLTypeOptions -> GQLTypeOptions
 unPrefix prefix options = options { fieldLabelModifier = nflm }
@@ -31,7 +31,7 @@ unPrefix prefix options = options { fieldLabelModifier = nflm }
 
 data AuthStatus = Valid | Invalid
 
-authUser :: (HasSettings env) => Int -> Text -> Cmd' env err AuthStatus
+authUser :: (HasSettings env) => NodeId -> Text -> Cmd' env err AuthStatus
 authUser ui_id token = do
   let token' = encodeUtf8 token
   jwtS <- view $ settings . jwtSettings
@@ -43,7 +43,7 @@ authUser ui_id token = do
         then pure Valid
         else pure Invalid
         where
-          nId AuthenticatedUser {_authUser_id} = unNodeId _authUser_id
+          nId AuthenticatedUser {_authUser_id} = _authUser_id
 
 getUserFromToken :: JWTSettings -> ByteString -> IO (Maybe AuthenticatedUser)
 getUserFromToken = verifyJWT