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 module Gargantext.API.Node.New
  20       where
  21
  22 import Control.Lens hiding (elements, Empty)
  23 import Data.Aeson
  24 import Data.Swagger
  25 import Data.Text (Text)
  26 import GHC.Generics (Generic)
  27 import Servant
  28 import Servant.Job.Async
  29 import Test.QuickCheck (elements)
  30 import Test.QuickCheck.Arbitrary
  31 import Web.FormUrlEncoded          (FromForm)
  32
  33 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
  34 import Gargantext.API.Node.Corpus.New (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
  45 ------------------------------------------------------------------------
  46 data PostNode = PostNode { pn_name     :: Text
  47                          , pn_typename :: NodeType}
  48   deriving (Generic)
  49 ------------------------------------------------------------------------
  50 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
  51 instance FromJSON  PostNode
  52 instance ToJSON    PostNode
  53 instance ToSchema  PostNode
  54 instance FromForm  PostNode
  55 instance Arbitrary PostNode where
  56   arbitrary = elements [PostNode "Node test" NodeCorpus]
  57
  58 ------------------------------------------------------------------------
  59 postNode :: HasNodeError err
  60          => UserId
  61          -> NodeId
  62          -> PostNode
  63          -> Cmd err [NodeId]
  64 postNode uId pId (PostNode nodeName nt) = do
  65   nodeUser <- getNodeUser (NodeId uId)
  66   let uId' = nodeUser ^. node_userId
  67   mkNodeWithParent nt (Just pId) uId' nodeName
  68
  69 ------------------------------------------------------------------------
  70 type PostNodeAsync = Summary "Post Node"
  71    :> "async"
  72    :> AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog
  73
  74
  75 postNodeAsyncAPI :: UserId -> NodeId -> GargServer PostNodeAsync
  76 postNodeAsyncAPI uId nId =
  77   serveJobsAPI $
  78     JobFunction (\p logs -> postNodeAsync uId nId p (liftBase . logs))
  79
  80 ------------------------------------------------------------------------
  81 postNodeAsync :: FlowCmdM env err m
  82     => UserId
  83     -> NodeId
  84     -> PostNode
  85     -> (JobLog -> m ())
  86     -> m JobLog
  87 postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
  88
  89   printDebug "postNodeAsync" nId
  90   logStatus JobLog { _scst_succeeded = Just 1
  91                    , _scst_failed    = Just 0
  92                    , _scst_remaining = Just 2
  93                    , _scst_events    = Just []
  94                    }
  95
  96   nodeUser <- getNodeUser (NodeId uId)
  97
  98   -- _ <- threadDelay 1000
  99   logStatus JobLog { _scst_succeeded = Just 1
 100                    , _scst_failed    = Just 0
 101                    , _scst_remaining = Just 2
 102                    , _scst_events    = Just []
 103                    }
 104
 105   let uId' = nodeUser ^. node_userId
 106   _ <- mkNodeWithParent tn (Just nId) uId' nodeName
 107
 108   pure      JobLog { _scst_succeeded = Just 3
 109                    , _scst_failed    = Just 0
 110                    , _scst_remaining = Just 0
 111                    , _scst_events    = Just []
 112                    }