1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
{-|
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 TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# 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 Servant
import Servant.Job.Async
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
import Web.FormUrlEncoded (FromForm)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Prelude
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
------------------------------------------------------------------------
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 FromForm 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_user_id
mkNodeWithParent nt (Just pId) uId' nodeName
------------------------------------------------------------------------
type PostNodeAsync = Summary "Post Node"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog
postNodeAsyncAPI :: UserId -> NodeId -> GargServer PostNodeAsync
postNodeAsyncAPI uId nId =
serveJobsAPI $
JobFunction (\p logs -> postNodeAsync uId nId p (liftBase . logs))
------------------------------------------------------------------------
postNodeAsync :: FlowCmdM env err m
=> UserId
-> NodeId
-> PostNode
-> (JobLog -> m ())
-> m JobLog
postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
printDebug "postNodeAsync" nId
logStatus JobLog { _scst_succeeded = Just 1
, _scst_failed = Just 0
, _scst_remaining = Just 2
, _scst_events = Just []
}
nodeUser <- getNodeUser (NodeId uId)
-- _ <- threadDelay 1000
logStatus JobLog { _scst_succeeded = Just 1
, _scst_failed = Just 0
, _scst_remaining = Just 2
, _scst_events = Just []
}
let uId' = nodeUser ^. node_user_id
_ <- mkNodeWithParent tn (Just nId) uId' nodeName
pure JobLog { _scst_succeeded = Just 3
, _scst_failed = Just 0
, _scst_remaining = Just 0
, _scst_events = Just []
}