[API] PostNodeAsync (wip)

src/Gargantext/API/Node.hs

@@ -37,7 +37,6 @@ Node API
 module Gargantext.API.Node
   where
 
-import Control.Lens ((^.))
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Maybe
 import Data.Swagger
@@ -49,12 +48,12 @@ import Gargantext.API.Admin.Types
 import Gargantext.API.Metrics
 import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus, QueryParamR)
 import Gargantext.API.Ngrams.NTree (MyTree)
+import Gargantext.API.Node.New
 import Gargantext.API.Search (SearchDocsAPI, searchDocs, SearchPairsAPI, searchPairs)
 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.Action.Node
 import Gargantext.Database.Query.Facet (FacetDoc, OrderBy(..))
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Children (getChildren)
@@ -65,7 +64,7 @@ import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude -- (Cmd, CmdM)
-import Gargantext.Database.Schema.Node (node_userId, _node_typename)
+import Gargantext.Database.Schema.Node (_node_typename)
 import Gargantext.Database.Query.Table.NodeNode
 import Gargantext.Prelude
 import Gargantext.Viz.Chart
@@ -236,17 +235,6 @@ instance ToSchema  RenameNode
 instance Arbitrary RenameNode where
   arbitrary = elements [RenameNode "test"]
 ------------------------------------------------------------------------
-data PostNode = PostNode { pn_name :: Text
-                         , pn_typename :: NodeType}
-  deriving (Generic)
-
--- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
-instance FromJSON  PostNode
-instance ToJSON    PostNode
-instance ToSchema  PostNode
-instance Arbitrary PostNode where
-  arbitrary = elements [PostNode "Node test" NodeCorpus]
-
 ------------------------------------------------------------------------
 type CatApi =  Summary " To Categorize NodeNodes: 0 for delete, 1/null neutral, 2 favorite"
             :> ReqBody '[JSON] NodesToCategory
@@ -334,16 +322,6 @@ treeAPI = treeDB
 rename :: NodeId -> RenameNode -> Cmd err [Int]
 rename nId (RenameNode name') = U.update (U.Rename nId name')
 
-postNode :: HasNodeError err
-         => UserId
-         -> NodeId
-         -> PostNode
-         -> Cmd err [NodeId]
-postNode uId pId (PostNode nodeName nt) = do
-  nodeUser <- getNodeUser (NodeId uId)
-  let uId' = nodeUser ^. node_userId
-  mkNodeWithParent nt (Just pId) uId' nodeName
-
 putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
         => NodeId
         -> a

src/Gargantext/API/Node/Corpus/New.hs

@@ -37,10 +37,10 @@ import Gargantext.API.Admin.Orchestrator.Types (ScraperStatus(..))
 import qualified Gargantext.API.Admin.Orchestrator.Types as T
 import Gargantext.API.Node.Corpus.New.File
 import Gargantext.Core (Lang(..){-, allLangs-})
-import Gargantext.Core.Types.Individu (UserId, User(..))
+import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Action.Flow (FlowCmdM, flowCorpus, getDataText, flowDataText, TermType(..), DataOrigin(..){-, allDataOrigins-})
-import Gargantext.Database.Admin.Types.Node (CorpusId, ToHyperdataDocument(..))
+import Gargantext.Database.Admin.Types.Node (CorpusId, ToHyperdataDocument(..), UserId)
 import Gargantext.Prelude
 import Servant
 import Servant.API.Flatten (Flat)

src/Gargantext/API/Node/New.hs

+{-|
+Module      : Gargantext.API.Node.Post
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+New = Post maybe change the name
+Async new node feature
+
+-}
+
+{-# LANGUAGE NoImplicitPrelude  #-}
+{-# LANGUAGE TemplateHaskell    #-}
+{-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE DataKinds          #-}
+{-# LANGUAGE TypeOperators      #-}
+{-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE FlexibleContexts   #-}
+{-# LANGUAGE RankNTypes         #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Gargantext.API.Node.New
+      where
+
+import Control.Lens hiding (elements, Empty)
+import Data.Aeson
+import Data.Swagger
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import Gargantext.API.Admin.Orchestrator.Types (ScraperStatus(..))
+import Gargantext.API.Node.Corpus.New (AsyncJobs)
+import Gargantext.Database.Action.Flow.Types
+import Gargantext.Database.Action.Node
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Prelude
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
+import Gargantext.Database.Query.Table.Node.User
+import Gargantext.Database.Schema.Node
+import Gargantext.Prelude
+import Servant
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+
+------------------------------------------------------------------------
+data PostNode = PostNode { pn_name     :: Text
+                         , pn_typename :: NodeType}
+  deriving (Generic)
+------------------------------------------------------------------------
+-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
+instance FromJSON  PostNode
+instance ToJSON    PostNode
+instance ToSchema  PostNode
+instance Arbitrary PostNode where
+  arbitrary = elements [PostNode "Node test" NodeCorpus]
+
+------------------------------------------------------------------------
+postNode :: HasNodeError err
+         => UserId
+         -> NodeId
+         -> PostNode
+         -> Cmd err [NodeId]
+postNode uId pId (PostNode nodeName nt) = do
+  nodeUser <- getNodeUser (NodeId uId)
+  let uId' = nodeUser ^. node_userId
+  mkNodeWithParent nt (Just pId) uId' nodeName
+
+------------------------------------------------------------------------
+type PostNodeAsync = Summary "Post Node"
+   :> "async"
+   :> AsyncJobs ScraperStatus '[FormUrlEncoded] PostNode ScraperStatus
+
+------------------------------------------------------------------------
+postNodeAsync :: FlowCmdM env err m
+    => UserId
+    -> NodeId
+    -> PostNode
+    -> (ScraperStatus -> m ())
+    -> m ScraperStatus
+postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
+
+  printDebug "postNodeAsync" nId
+  logStatus ScraperStatus { _scst_succeeded = Just 1
+                          , _scst_failed    = Just 0
+                          , _scst_remaining = Just 2
+                          , _scst_events    = Just []
+                          }
+
+  nodeUser <- getNodeUser (NodeId uId)
+
+  -- _ <- threadDelay 1000
+  logStatus ScraperStatus { _scst_succeeded = Just 1
+                          , _scst_failed    = Just 0
+                          , _scst_remaining = Just 2
+                          , _scst_events    = Just []
+                          }
+
+  let uId' = nodeUser ^. node_userId
+  _ <- mkNodeWithParent tn (Just nId) uId' nodeName
+
+  pure      ScraperStatus { _scst_succeeded = Just 3
+                          , _scst_failed    = Just 0
+                          , _scst_remaining = Just 0
+                          , _scst_events    = Just []
+                          }

src/Gargantext/Core/Types.hs

@@ -46,8 +46,8 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Prelude
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
+------------------------------------------------------------------------
 data Ordering = Down | Up
-
 ------------------------------------------------------------------------
 type Name = Text
 type Term  = Text

src/Gargantext/Core/Types/Individu.hs

@@ -19,11 +19,10 @@ module Gargantext.Core.Types.Individu
   where
 
 import Data.Text (Text, pack, reverse)
-import Gargantext.Database.Admin.Types.Node (NodeId)
+import Gargantext.Database.Admin.Types.Node (NodeId, UserId)
 import Gargantext.Prelude hiding (reverse)
 
-type UserId = Int
-
+-- FIXME UserName used twice
 data User = UserDBId UserId | UserName Text | RootId NodeId
   deriving (Eq)
 

src/Gargantext/Database/Action/Flow.hs

@@ -74,7 +74,7 @@ import Gargantext.Database.Action.Search (searchInDatabase)
 import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
-import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Ngrams
 import Gargantext.Database.Query.Table.NodeNgrams (listInsertDb , getCgramsId)
 import Gargantext.Database.Query.Table.NodeNodeNgrams2

src/Gargantext/Database/Action/Flow/List.hs

@@ -31,10 +31,10 @@ import Data.Text (Text)
 import Gargantext.API.Ngrams (NgramsElement(..), putListNgrams)
 import Gargantext.Core.Flow.Types
 import Gargantext.Core.Types.Main (ListType(CandidateTerm))
-import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
 import Gargantext.Database.Query.Table.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb, getCgramsId)
 import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams,  NgramsType(..), text2ngrams, ngramsTypeId)
+import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams
 import Gargantext.Prelude
 import qualified Data.List as List

src/Gargantext/Database/Admin/Types/Node.hs

@@ -59,8 +59,10 @@ import Text.Show (Show())
 import qualified Opaleye as O
 
 
-------------------------------------------------------------------------
+type UserId = Int
+type MasterUserId = UserId
 
+------------------------------------------------------------------------
 -- | NodePoly indicates that Node has a Polymorphism Type
 type Node json   = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
 
@@ -175,9 +177,6 @@ type PhyloId  = NodeId
 type AnnuaireId = NodeId
 type ContactId  = NodeId
 
-type UserId   = Int
-type MasterUserId = UserId
-
 ------------------------------------------------------------------------
 data Status  = Status { status_failed    :: !Int
                       , status_succeeded :: !Int

src/Gargantext/Database/Prelude.hs

@@ -19,6 +19,7 @@ Portability : POSIX
 
 module Gargantext.Database.Prelude where
 
+
 import Control.Exception
 import Control.Lens (Getter, view)
 import Control.Monad.Error.Class -- (MonadError(..), Error)
@@ -49,6 +50,7 @@ import qualified Data.ByteString      as DB
 import qualified Data.List as DL
 import qualified Database.PostgreSQL.Simple as PGS
 
+-------------------------------------------------------
 
 class HasConnectionPool env where
   connPool :: Getter env (Pool Connection)

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

@@ -31,11 +31,8 @@ import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import GHC.Generics (Generic)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types (Name)
-import Gargantext.Core.Types.Individu
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Database.Admin.Types.Node (Node,Hyperdata, DocumentId, NodeId(..))
-import Gargantext.Database.Admin.Types.Node (NodeType(..))
-import Gargantext.Database.Admin.Types.Node (pgNodeId)
+import Gargantext.Database.Admin.Types.Node (Node,Hyperdata, DocumentId, NodeId(..), UserId, NodeType(..), pgNodeId)
 import Gargantext.Database.Prelude -- (fromField', Cmd)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Contact (HyperdataContact, fake_HyperdataContact)

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

@@ -56,7 +56,6 @@ insertUsers us = mkCmd $ \c -> runInsert_ c insert
   where
     insert = Insert userTable us rCount Nothing
 
-
 gargantextUser :: Username -> UserWrite
 gargantextUser u = UserDB (Nothing) (pgStrictText "password")
                          (Nothing) (pgBool True) (pgStrictText u)