]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/Node/New.hs
merge
[gargantext.git] / src / Gargantext / API / Node / New.hs
1 {-|
2 Module : Gargantext.API.Node.Post
3 Description :
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10 New = Post maybe change the name
11 Async new node feature
12
13 -}
14
15 {-# LANGUAGE TemplateHaskell #-}
16 {-# LANGUAGE TypeOperators #-}
17 {-# OPTIONS_GHC -fno-warn-orphans #-}
18
19 {-# LANGUAGE IncoherentInstances #-}
20 module Gargantext.API.Node.New
21 where
22
23 import Control.Lens hiding (elements, Empty)
24 import Data.Aeson
25 import Data.Swagger
26 import Data.Text (Text)
27 import GHC.Generics (Generic)
28 import Servant
29 import Test.QuickCheck (elements)
30 import Test.QuickCheck.Arbitrary
31 import Web.FormUrlEncoded (FromForm, ToForm)
32
33 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
34 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
35 import Gargantext.API.Prelude
36 import Gargantext.Database.Action.Flow.Types
37 import Gargantext.Database.Action.Node
38 import Gargantext.Database.Admin.Types.Node
39 import Gargantext.Database.Prelude
40 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
41 import Gargantext.Database.Query.Table.Node.User
42 import Gargantext.Database.Schema.Node
43 import Gargantext.Prelude
44 import Gargantext.Utils.Jobs (serveJobsAPI, jobHandleLogger)
45
46 ------------------------------------------------------------------------
47 data PostNode = PostNode { pn_name :: Text
48 , pn_typename :: NodeType}
49 deriving (Generic)
50 ------------------------------------------------------------------------
51 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
52 instance FromJSON PostNode
53 instance ToJSON PostNode
54 instance ToSchema PostNode
55 instance FromForm PostNode
56 instance ToForm PostNode
57 instance Arbitrary PostNode where
58 arbitrary = elements [PostNode "Node test" NodeCorpus]
59
60 ------------------------------------------------------------------------
61 postNode :: HasNodeError err
62 => UserId
63 -> NodeId
64 -> PostNode
65 -> Cmd err [NodeId]
66 postNode uId pId (PostNode nodeName nt) = do
67 nodeUser <- getNodeUser (NodeId uId)
68 let uId' = nodeUser ^. node_user_id
69 mkNodeWithParent nt (Just pId) uId' nodeName
70
71 ------------------------------------------------------------------------
72 type PostNodeAsync = Summary "Post Node"
73 :> "async"
74 :> AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog
75
76
77 postNodeAsyncAPI
78 :: UserId -> NodeId -> ServerT PostNodeAsync (GargM Env GargError)
79 postNodeAsyncAPI uId nId =
80 serveJobsAPI NewNodeJob $ \jHandle p ->
81 postNodeAsync uId nId p (jobHandleLogger jHandle)
82
83 ------------------------------------------------------------------------
84 postNodeAsync :: FlowCmdM env err m
85 => UserId
86 -> NodeId
87 -> PostNode
88 -> (JobLog -> m ())
89 -> m JobLog
90 postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
91
92 -- printDebug "postNodeAsync" nId
93 logStatus JobLog { _scst_succeeded = Just 1
94 , _scst_failed = Just 0
95 , _scst_remaining = Just 2
96 , _scst_events = Just []
97 }
98
99 nodeUser <- getNodeUser (NodeId uId)
100
101 -- _ <- threadDelay 1000
102 logStatus JobLog { _scst_succeeded = Just 1
103 , _scst_failed = Just 0
104 , _scst_remaining = Just 2
105 , _scst_events = Just []
106 }
107
108 let uId' = nodeUser ^. node_user_id
109 _ <- mkNodeWithParent tn (Just nId) uId' nodeName
110
111 pure JobLog { _scst_succeeded = Just 3
112 , _scst_failed = Just 0
113 , _scst_remaining = Just 0
114 , _scst_events = Just []
115 }