[DB|Query] clean Root funs

src/Gargantext/Core/Types/Main.hs

@@ -39,6 +39,7 @@ import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import Text.Read (read)
 
+type CorpusName = Text
 ------------------------------------------------------------------------
 data NodeTree = NodeTree { _nt_name :: Text
                          , _nt_type :: NodeType
@@ -74,7 +75,7 @@ type ListTypeId = Int
 listTypeId :: ListType -> ListTypeId
 listTypeId StopTerm      = 0
 listTypeId CandidateTerm = 1
-listTypeId GraphTerm       = 2
+listTypeId GraphTerm     = 2
 
 fromListTypeId :: ListTypeId -> Maybe ListType
 fromListTypeId i = lookup i $ fromList [ (listTypeId l, l) | l <- [minBound..maxBound]]
@@ -95,7 +96,7 @@ type Offset   = Int
 type IsTrash  = Bool
 
 ------------------------------------------------------------------------
--- All the Database is structred like a hierarchical Tree
+-- All the Database is structured as a hierarchical Tree
 data Tree a = TreeN { _tn_node :: a, _tn_children :: [Tree a] }
   deriving (Show, Read, Eq, Generic, Ord)
 

src/Gargantext/Database/Action/Flow.hs

@@ -50,20 +50,19 @@ import Data.Tuple.Extra (first, second)
 import Debug.Trace (trace)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Flow.Types
-import Gargantext.Core.Types (NodePoly(..), Terms(..))
+import Gargantext.Core.Types (Terms(..))
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Types.Main
 import Gargantext.Database.Action.Flow.List
 import Gargantext.Database.Action.Flow.Types
-import Gargantext.Database.Action.Flow.Utils (insertDocNgrams, getUserId)
+import Gargantext.Database.Action.Flow.Utils (insertDocNgrams)
 import Gargantext.Database.Action.Query.Node
 import Gargantext.Database.Action.Query.Node.Contact -- (HyperdataContact(..), ContactWho(..))
 import Gargantext.Database.Action.Query.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
-import Gargantext.Database.Action.Query.Tree.Root (getRoot)
-import Gargantext.Database.Action.Query.Tree (mkRoot)
+import Gargantext.Database.Action.Query.Tree.Root (getOrMkRoot, getOrMk_RootWithCorpus)
 import Gargantext.Database.Action.Search (searchInDatabase)
 import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
-import Gargantext.Database.Admin.Types.Errors (HasNodeError(..), NodeError(..), nodeError)
+import Gargantext.Database.Admin.Types.Errors (HasNodeError(..))
 import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
 import Gargantext.Database.Admin.Utils (Cmd)
 import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams,  NgramsType(..), text2ngrams, ngramsTypeId)
@@ -311,54 +310,6 @@ withLang (Unsupervised l n s m) ns = Unsupervised l n s m'
 withLang l _ = l
 
 
-
-type CorpusName = Text
-
-getOrMkRoot :: (HasNodeError err)
-            => User
-            -> Cmd err (UserId, RootId)
-getOrMkRoot user = do
-  userId <- getUserId user
-
-  rootId' <- map _node_id <$> getRoot user
-
-  rootId'' <- case rootId' of
-        []  -> mkRoot user
-        n   -> case length n >= 2 of
-            True  -> nodeError ManyNodeUsers
-            False -> pure rootId'
-
-  rootId <- maybe (nodeError NoRootFound) pure (head rootId'')
-  pure (userId, rootId)
-
-
-getOrMk_RootWithCorpus :: (HasNodeError err, MkCorpus a)
-                      => User
-                      -> Either CorpusName [CorpusId]
-                      -> Maybe a
-                      -> Cmd err (UserId, RootId, CorpusId)
-getOrMk_RootWithCorpus user cName c = do
-  (userId, rootId) <- getOrMkRoot user
-  corpusId'' <- if user == UserName userMaster
-                  then do
-                    ns <- getCorporaWithParentId rootId
-                    pure $ map _node_id ns
-                  else
-                    pure $ fromRight [] cName
-
-  corpusId' <- if corpusId'' /= []
-                  then pure corpusId''
-                  else do
-                    c' <- mk (Just $ fromLeft "Default" cName) c rootId userId
-                    _tId <- case head c' of
-                              Nothing -> pure [0]
-                              Just c'' -> mkNode NodeTexts c'' userId
-                    pure c'
-
-  corpusId <- maybe (nodeError NoCorpusFound) pure (head corpusId')
-  pure (userId, rootId, corpusId)
-
-
 ------------------------------------------------------------------------
 viewUniqId' :: UniqId a
             => a

src/Gargantext/Database/Action/Query/Tree.hs

@@ -27,46 +27,13 @@ import Data.Map (Map, fromListWith, lookup)
 import Data.Text (Text)
 import Database.PostgreSQL.Simple
 import Database.PostgreSQL.Simple.SqlQQ
-import Gargantext.Core.Types.Individu
 import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
 import Gargantext.Database.Admin.Types.Node -- (pgNodeId, NodeType(..))
-import Gargantext.Database.Action.Query
-import Gargantext.Database.Action.Flow.Utils (getUserId)
 import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId)
-import Gargantext.Database.Admin.Types.Errors
 import Gargantext.Database.Admin.Types.Node (NodeId, NodeType, DocId, allNodeTypes)
 import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery)
 import Gargantext.Prelude
 
-------------------------------------------------------------------------
--- import Gargantext.Database.Utils (runCmdDev)
--- treeTest :: IO (Tree NodeTree)
--- treeTest = runCmdDev $ treeDB 347474
-------------------------------------------------------------------------
-
-mkRoot :: HasNodeError err
-       => User
-       -> Cmd err [RootId]
-mkRoot user = do
-
-  uid <- getUserId user
-
-  let una = "username"
-
-  case uid > 0 of
-     False -> nodeError NegativeId
-     True  -> do
-       rs <- mkNodeWithParent NodeUser Nothing uid una
-       _ <- case rs of
-         [r] -> do
-           _ <- mkNodeWithParent NodeFolderPrivate (Just r) uid una
-           _ <- mkNodeWithParent NodeFolderShared  (Just r) uid una
-           _ <- mkNodeWithParent NodeFolderPublic  (Just r) uid una
-           pure rs
-         _   -> pure rs
-       pure rs
-
-
 ------------------------------------------------------------------------
 data TreeError = NoRoot | EmptyRoot | TooManyRoots
   deriving (Show)
@@ -74,16 +41,24 @@ data TreeError = NoRoot | EmptyRoot | TooManyRoots
 class HasTreeError e where
   _TreeError :: Prism' e TreeError
 
-treeError :: (MonadError e m, HasTreeError e) => TreeError -> m a
+treeError :: ( MonadError e m
+             , HasTreeError e)
+             => TreeError
+             -> m a
 treeError te = throwError $ _TreeError # te
 
 -- | Returns the Tree of Nodes in Database
-treeDB :: HasTreeError err => RootId -> [NodeType] -> Cmd err (Tree NodeTree)
+treeDB :: HasTreeError err
+       => RootId
+       -> [NodeType]
+       -> Cmd err (Tree NodeTree)
 treeDB r nodeTypes = toTree =<< (toTreeParent <$> dbTree r nodeTypes)
 
 ------------------------------------------------------------------------
-toTree :: (MonadError e m, HasTreeError e)
-       => Map (Maybe ParentId) [DbTreeNode] -> m (Tree NodeTree)
+toTree :: ( MonadError e m
+          , HasTreeError e)
+       => Map (Maybe ParentId) [DbTreeNode]
+       -> m (Tree NodeTree)
 toTree m =
     case lookup Nothing m of
         Just [n] -> pure $ toTree' m n
@@ -91,18 +66,22 @@ toTree m =
         Just []  -> treeError EmptyRoot
         Just _   -> treeError TooManyRoots
 
-toTree' :: Map (Maybe ParentId) [DbTreeNode] -> DbTreeNode -> Tree NodeTree
+toTree' :: Map (Maybe ParentId) [DbTreeNode]
+        -> DbTreeNode
+        -> Tree NodeTree
 toTree' m n =
   TreeN (toNodeTree n) $
     m ^.. at (Just $ dt_nodeId n) . _Just . each . to (toTree' m)
 
 ------------------------------------------------------------------------
-toNodeTree :: DbTreeNode -> NodeTree
+toNodeTree :: DbTreeNode
+           -> NodeTree
 toNodeTree (DbTreeNode nId tId _ n) = NodeTree n nodeType nId
   where
     nodeType = fromNodeTypeId tId
 ------------------------------------------------------------------------
-toTreeParent :: [DbTreeNode] -> Map (Maybe ParentId) [DbTreeNode]
+toTreeParent :: [DbTreeNode]
+             -> Map (Maybe ParentId) [DbTreeNode]
 toTreeParent = fromListWith (<>) . map (\n -> (dt_parentId n, [n]))
 ------------------------------------------------------------------------
 data DbTreeNode = DbTreeNode { dt_nodeId :: NodeId
@@ -113,7 +92,9 @@ data DbTreeNode = DbTreeNode { dt_nodeId :: NodeId
 
 -- | Main DB Tree function
 -- TODO add typenames as parameters
-dbTree :: RootId -> [NodeType] -> Cmd err [DbTreeNode]
+dbTree :: RootId
+       -> [NodeType]
+       -> Cmd err [DbTreeNode]
 dbTree rootId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n)
   <$> runPGSQuery [sql|
     WITH RECURSIVE

src/Gargantext/Database/Action/Query/Tree/Root.hs

@@ -27,12 +27,19 @@ Portability : POSIX
 module Gargantext.Database.Action.Query.Tree.Root
   where
 
+import Data.Either (Either, fromLeft, fromRight)
 import Control.Arrow (returnA)
+import Gargantext.Core.Types.Main (CorpusName)
 import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Admin.Config (nodeTypeId)
+import Gargantext.Database.Admin.Config (nodeTypeId, userMaster)
+import Gargantext.Database.Admin.Types.Errors
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Action.Query.Node
 import Gargantext.Database.Action.Query.Node.User (HyperdataUser)
+import Gargantext.Database.Action.Flow.Utils (getUserId)
 import Gargantext.Database.Schema.Node (NodeRead)
 import Gargantext.Database.Schema.Node (queryNodeTable)
+import Gargantext.Database.Action.Query
 import Gargantext.Database.Schema.User (UserPoly(..))
 import Gargantext.Database.Action.Query.User (queryUserTable)
 import Gargantext.Database.Admin.Types.Node (Node, NodePoly(..), NodeType(NodeUser), pgNodeId)
@@ -41,6 +48,83 @@ import Gargantext.Prelude
 import Opaleye (restrict, (.==), Query)
 import Opaleye.PGTypes (pgStrictText, pgInt4)
 
+
+
+getOrMkRoot :: (HasNodeError err)
+            => User
+            -> Cmd err (UserId, RootId)
+getOrMkRoot user = do
+  userId <- getUserId user
+
+  rootId' <- map _node_id <$> getRoot user
+
+  rootId'' <- case rootId' of
+        []  -> mkRoot user
+        n   -> case length n >= 2 of
+            True  -> nodeError ManyNodeUsers
+            False -> pure rootId'
+
+  rootId <- maybe (nodeError NoRootFound) pure (head rootId'')
+  pure (userId, rootId)
+
+
+getOrMk_RootWithCorpus :: (HasNodeError err, MkCorpus a)
+                      => User
+                      -> Either CorpusName [CorpusId]
+                      -> Maybe a
+                      -> Cmd err (UserId, RootId, CorpusId)
+getOrMk_RootWithCorpus user cName c = do
+  (userId, rootId) <- getOrMkRoot user
+  corpusId'' <- if user == UserName userMaster
+                  then do
+                    ns <- getCorporaWithParentId rootId
+                    pure $ map _node_id ns
+                  else
+                    pure $ fromRight [] cName
+
+  corpusId' <- if corpusId'' /= []
+                  then pure corpusId''
+                  else do
+                    c' <- mk (Just $ fromLeft "Default" cName) c rootId userId
+                    _tId <- case head c' of
+                              Nothing -> pure [0]
+                              Just c'' -> mkNode NodeTexts c'' userId
+                    pure c'
+
+  corpusId <- maybe (nodeError NoCorpusFound) pure (head corpusId')
+  pure (userId, rootId, corpusId)
+
+
+
+
+
+
+mkRoot :: HasNodeError err
+       => User
+       -> Cmd err [RootId]
+mkRoot user = do
+
+  -- TODO
+  -- udb <- getUserDb user
+  -- let uid = user_id udb
+  uid <- getUserId user
+
+  -- TODO ? Which name for user Node ?
+  let una = "username"
+
+  case uid > 0 of
+     False -> nodeError NegativeId
+     True  -> do
+       rs <- mkNodeWithParent NodeUser Nothing uid una
+       _ <- case rs of
+         [r] -> do
+           _ <- mkNodeWithParent NodeFolderPrivate (Just r) uid una
+           _ <- mkNodeWithParent NodeFolderShared  (Just r) uid una
+           _ <- mkNodeWithParent NodeFolderPublic  (Just r) uid una
+           pure rs
+         _   -> pure rs
+       pure rs
+
 getRoot :: User -> Cmd err [Node HyperdataUser]
 getRoot = runOpaQuery . selectRoot
 
@@ -66,5 +150,3 @@ selectRoot (RootId nid) =
     restrict -< _node_id   row   .== (pgNodeId nid)
     returnA  -< row
 
-
-