From ba3cd903ddc3e13b1c1ff8cdd3465111dba1d4bc Mon Sep 17 00:00:00 2001
From: Przemek Kaminski <pk@intrepidus.pl>
Date: Fri, 18 Dec 2020 14:43:08 +0100
Subject: [PATCH] [temp] some debugging code for the tree reload fix
---
devops/docker/docker-compose.yaml | 4 ++-
src/Gargantext/Database/Query/Tree.hs | 51 +++++++++++++++++++++------
2 files changed, 43 insertions(+), 12 deletions(-)
diff --git a/devops/docker/docker-compose.yaml b/devops/docker/docker-compose.yaml
index 62e5ae33..42d45f41 100644
--- a/devops/docker/docker-compose.yaml
+++ b/devops/docker/docker-compose.yaml
@@ -21,11 +21,13 @@ services:
ports:
- 8081:80
environment:
- PGADMIN_DEFAULT_EMAIL: admin
+ PGADMIN_DEFAULT_EMAIL: admin@localhost
PGADMIN_DEFAULT_PASSWORD: admin
depends_on:
- postgres
+ links:
+ - postgres
corenlp:
image: 'cgenie/corenlp-garg'
diff --git a/src/Gargantext/Database/Query/Tree.hs b/src/Gargantext/Database/Query/Tree.hs
index 217b0860..99f63b6f 100644
--- a/src/Gargantext/Database/Query/Tree.hs
+++ b/src/Gargantext/Database/Query/Tree.hs
@@ -39,7 +39,7 @@ 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)
-import qualified Data.Set as Set
+-- import qualified Data.Set as Set
import qualified Data.List as List
import Data.Text (Text)
import Database.PostgreSQL.Simple
@@ -99,9 +99,13 @@ tree_advanced :: HasTreeError err
-> [NodeType]
-> Cmd err (Tree NodeTree)
tree_advanced r nodeTypes = do
+ let rPrefix s = "[tree_advanced] root = " <> show r <> " " <> s
mainRoot <- findNodes r Private nodeTypes
- sharedRoots <- findNodes r Shared nodeTypes
+ printDebug (rPrefix "mainRoot") mainRoot
publicRoots <- findNodes r Public nodeTypes
+ printDebug (rPrefix "publicRoots") publicRoots
+ sharedRoots <- findNodes r Shared nodeTypes
+ printDebug (rPrefix "sharedRoots") sharedRoots
toTree $ toTreeParent (mainRoot <> sharedRoots <> publicRoots)
-- | Fetch only first level of tree
@@ -110,10 +114,16 @@ tree_first_level :: HasTreeError err
-> [NodeType]
-> Cmd err (Tree NodeTree)
tree_first_level r nodeTypes = do
+ let rPrefix s = "[tree_first_level] root = " <> show r <> " " <> s
mainRoot <- findNodes r Private nodeTypes
- sharedRoots <- findNodes r Shared nodeTypes
+ printDebug (rPrefix "mainRoot") mainRoot
publicRoots <- findNodes r Public nodeTypes
- toTree $ toSubtreeParent (mainRoot <> sharedRoots <> publicRoots)
+ printDebug (rPrefix "publicRoots") publicRoots
+ sharedRoots <- findNodes r Shared nodeTypes
+ printDebug (rPrefix "sharedRoots") sharedRoots
+ ret <- toTree $ toSubtreeParent r (mainRoot <> sharedRoots <> publicRoots)
+ printDebug (rPrefix "tree") ret
+ pure ret
------------------------------------------------------------------------
data NodeMode = Private | Shared | Public
@@ -214,24 +224,43 @@ toTreeParent :: [DbTreeNode]
-> Map (Maybe ParentId) [DbTreeNode]
toTreeParent = fromListWith (\a b -> nub $ a <> b) . map (\n -> (_dt_parentId n, [n]))
------------------------------------------------------------------------
-toSubtreeParent :: [DbTreeNode]
+-- toSubtreeParent' :: [DbTreeNode]
+-- -> Map (Maybe ParentId) [DbTreeNode]
+-- toSubtreeParent' ns = fromListWith (\a b -> nub $ a <> b) . map (\n -> (_dt_parentId n, [n])) $ nullifiedParents
+-- where
+-- nodeIds = Set.fromList $ map (\n -> unNodeId $ _dt_nodeId n) ns
+-- nullifiedParents = map nullifyParent ns
+-- nullifyParent dt@(DbTreeNode { _dt_parentId = Nothing }) = dt
+-- nullifyParent dt@(DbTreeNode { _dt_nodeId = nId
+-- , _dt_parentId = Just pId
+-- , _dt_typeId = tId
+-- , _dt_name = name }) =
+-- if Set.member (unNodeId pId) nodeIds then
+-- dt
+-- else
+-- DbTreeNode { _dt_nodeId = nId
+-- , _dt_typeId = tId
+-- , _dt_parentId = Nothing
+-- , _dt_name = name }
+------------------------------------------------------------------------
+toSubtreeParent :: RootId
+ -> [DbTreeNode]
-> Map (Maybe ParentId) [DbTreeNode]
-toSubtreeParent ns = fromListWith (\a b -> nub $ a <> b) . map (\n -> (_dt_parentId n, [n])) $ nullifiedParents
+toSubtreeParent r ns = fromListWith (\a b -> nub $ a <> b) . map (\n -> (_dt_parentId n, [n])) $ nullifiedParents
where
- nodeIds = Set.fromList $ map (\n -> unNodeId $ _dt_nodeId n) ns
nullifiedParents = map nullifyParent ns
nullifyParent dt@(DbTreeNode { _dt_parentId = Nothing }) = dt
nullifyParent dt@(DbTreeNode { _dt_nodeId = nId
- , _dt_parentId = Just pId
+ , _dt_parentId = _pId
, _dt_typeId = tId
, _dt_name = name }) =
- if Set.member (unNodeId pId) nodeIds then
- dt
- else
+ if r == nId then
DbTreeNode { _dt_nodeId = nId
, _dt_typeId = tId
, _dt_parentId = Nothing
, _dt_name = name }
+ else
+ dt
------------------------------------------------------------------------
-- | Main DB Tree function
dbTree :: RootId
--
2.21.0