[DB/REFACT] Node actions (WIP).

src/Gargantext/API/Node.hs

@@ -54,9 +54,9 @@ import Gargantext.API.Table
 import Gargantext.Core.Types (NodeTableResult)
 import Gargantext.Core.Types.Main (Tree, NodeTree, ListType)
 import Gargantext.Database.Action.Flow.Pairing (pairing)
-import Gargantext.Database.Query
+import Gargantext.Database.Action.Node
 import Gargantext.Database.Query.Facet (FacetDoc, OrderBy(..))
-import Gargantext.Database.Query.Table.Node hiding (postNode)
+import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Children (getChildren)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Query.Table.Node.User

src/Gargantext/Database/Action/Node.hs

+{-|
+Module      : Gargantext.Database.Action.Node
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# OPTIONS_GHC -fno-warn-orphans        #-}
+
+{-# LANGUAGE Arrows                 #-}
+{-# LANGUAGE DeriveGeneric          #-}
+{-# LANGUAGE ConstraintKinds        #-}
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE OverloadedStrings      #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE NoImplicitPrelude      #-}
+{-# LANGUAGE RankNTypes             #-}
+{-# LANGUAGE TemplateHaskell        #-}
+{-# LANGUAGE TypeFamilies           #-}
+
+module Gargantext.Database.Action.Node
+  where
+
+import Gargantext.Core.Types (Name)
+import Gargantext.Database.Query.Table.Node
+import Gargantext.Database.Query.Table.Node.User
+import Gargantext.Database.Query.Table.Node.Error
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Prelude (Cmd)
+import Prelude hiding (null, id, map, sum)
+
+------------------------------------------------------------------------
+-- | TODO mk all others nodes
+mkNodeWithParent :: HasNodeError err
+                 => NodeType
+                 -> Maybe ParentId
+                 -> UserId
+                 -> Name
+                 -> Cmd err [NodeId]
+mkNodeWithParent NodeUser (Just _) _   _    = nodeError UserNoParent
+
+------------------------------------------------------------------------
+mkNodeWithParent NodeUser Nothing uId name =
+  insertNodesWithParentR Nothing [node NodeUser name fake_HyperdataUser Nothing uId]
+
+mkNodeWithParent _ Nothing _ _ = nodeError HasParent
+------------------------------------------------------------------------
+mkNodeWithParent NodeFolder (Just i) uId name =
+   insertNodesWithParentR (Just i) [node NodeFolder name hd Nothing uId]
+    where
+      hd = defaultFolder
+
+mkNodeWithParent NodeFolderPrivate (Just i) uId _ =
+   insertNodesWithParentR (Just i) [node NodeFolderPrivate "Private" hd Nothing uId]
+    where
+      hd = defaultFolder
+
+mkNodeWithParent NodeFolderShared (Just i) uId _ =
+   insertNodesWithParentR (Just i) [node NodeFolderShared "Shared" hd Nothing uId]
+    where
+      hd = defaultFolder
+
+mkNodeWithParent NodeFolderPublic (Just i) uId _ =
+   insertNodesWithParentR (Just i) [node NodeFolderPublic "Public" hd Nothing uId]
+    where
+      hd = defaultFolder
+
+mkNodeWithParent NodeTeam (Just i) uId name =
+   insertNodesWithParentR (Just i) [node NodeTeam name hd Nothing uId]
+    where
+      hd = defaultFolder
+------------------------------------------------------------------------
+mkNodeWithParent NodeCorpus (Just i) uId name =
+   insertNodesWithParentR (Just i) [node NodeCorpus name hd Nothing uId]
+    where
+      hd = defaultCorpus
+
+mkNodeWithParent NodeAnnuaire (Just i) uId name =
+   insertNodesWithParentR (Just i) [node NodeAnnuaire name hd Nothing uId]
+    where
+      hd = defaultAnnuaire
+
+mkNodeWithParent NodeList (Just i) uId name =
+   insertNodesWithParentR (Just i) [node NodeList name hd Nothing uId]
+    where
+      hd = defaultAnnuaire
+
+mkNodeWithParent _ _ _ _       = nodeError NotImplYet
+

src/Gargantext/Database/Query.hs

@@ -8,88 +8,7 @@ Stability   : experimental
 Portability : POSIX
 -}
 
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-{-# OPTIONS_GHC -fno-warn-orphans        #-}
-
-{-# LANGUAGE Arrows                 #-}
-{-# LANGUAGE DeriveGeneric          #-}
-{-# LANGUAGE ConstraintKinds        #-}
-{-# LANGUAGE FlexibleContexts       #-}
-{-# LANGUAGE FlexibleInstances      #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE OverloadedStrings      #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE NoImplicitPrelude      #-}
-{-# LANGUAGE RankNTypes             #-}
-{-# LANGUAGE TemplateHaskell        #-}
-{-# LANGUAGE TypeFamilies           #-}
-
 module Gargantext.Database.Query
   where
 
-import Gargantext.Core.Types (Name)
-import Gargantext.Database.Query.Table.Node
-import Gargantext.Database.Query.Table.Node.User
-import Gargantext.Database.Query.Table.Node.Error
-import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd)
-import Prelude hiding (null, id, map, sum)
-
-------------------------------------------------------------------------
--- | TODO mk all others nodes
-mkNodeWithParent :: HasNodeError err
-                 => NodeType
-                 -> Maybe ParentId
-                 -> UserId
-                 -> Name
-                 -> Cmd err [NodeId]
-mkNodeWithParent NodeUser (Just _) _   _    = nodeError UserNoParent
-
-------------------------------------------------------------------------
-mkNodeWithParent NodeUser Nothing uId name =
-  insertNodesWithParentR Nothing [node NodeUser name fake_HyperdataUser Nothing uId]
-
-mkNodeWithParent _ Nothing _ _ = nodeError HasParent
-------------------------------------------------------------------------
-mkNodeWithParent NodeFolder (Just i) uId name =
-   insertNodesWithParentR (Just i) [node NodeFolder name hd Nothing uId]
-    where
-      hd = defaultFolder
-
-mkNodeWithParent NodeFolderPrivate (Just i) uId _ =
-   insertNodesWithParentR (Just i) [node NodeFolderPrivate "Private" hd Nothing uId]
-    where
-      hd = defaultFolder
-
-mkNodeWithParent NodeFolderShared (Just i) uId _ =
-   insertNodesWithParentR (Just i) [node NodeFolderShared "Shared" hd Nothing uId]
-    where
-      hd = defaultFolder
-
-mkNodeWithParent NodeFolderPublic (Just i) uId _ =
-   insertNodesWithParentR (Just i) [node NodeFolderPublic "Public" hd Nothing uId]
-    where
-      hd = defaultFolder
-
-mkNodeWithParent NodeTeam (Just i) uId name =
-   insertNodesWithParentR (Just i) [node NodeTeam name hd Nothing uId]
-    where
-      hd = defaultFolder
-------------------------------------------------------------------------
-mkNodeWithParent NodeCorpus (Just i) uId name =
-   insertNodesWithParentR (Just i) [node NodeCorpus name hd Nothing uId]
-    where
-      hd = defaultCorpus
-
-mkNodeWithParent NodeAnnuaire (Just i) uId name =
-   insertNodesWithParentR (Just i) [node NodeAnnuaire name hd Nothing uId]
-    where
-      hd = defaultAnnuaire
-
-mkNodeWithParent NodeList (Just i) uId name =
-   insertNodesWithParentR (Just i) [node NodeList name hd Nothing uId]
-    where
-      hd = defaultAnnuaire
-
-mkNodeWithParent _ _ _ _       = nodeError NotImplYet
 

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

@@ -355,7 +355,6 @@ node2table uid pid (Node' nt txt v []) = Node Nothing (pgInt4 $ nodeTypeId nt) (
 node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet"
 
 
-
 data Node' = Node' { _n_type :: NodeType
                    , _n_name :: Text
                    , _n_data :: Value
@@ -371,6 +370,7 @@ mkNodeR ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns (rReturning
 
 ------------------------------------------------------------------------
 
+{-
 data NewNode = NewNode { _newNodeId :: NodeId
                        , _newNodeChildren :: [NodeId] }
 
@@ -402,7 +402,7 @@ postNode uid pid (Node' NodeDashboard txt v ns) = do
   pure $ NewNode pid' pids
 
 postNode _ _ (Node' _ _ _ _) = nodeError NotImplYet
-
+-}
 
 childWith :: UserId -> ParentId -> Node' -> NodeWrite
 childWith uId pId (Node' NodeDocument txt v []) = node2table uId (Just pId) (Node' NodeDocument txt v [])

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

@@ -39,7 +39,7 @@ import Gargantext.Database.Query.Table.Node.User (HyperdataUser)
 import Gargantext.Database.Action.Flow.Utils (getUserId)
 import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead)
 import Gargantext.Database.Schema.Node (queryNodeTable)
-import Gargantext.Database.Query
+import Gargantext.Database.Action.Node
 import Gargantext.Database.Query.Table.User (queryUserTable, UserPoly(..))
 import Gargantext.Database.Admin.Types.Node (Node, NodeType(NodeUser), pgNodeId)
 import Gargantext.Database.Prelude (Cmd, runOpaQuery)