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)
  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 $ \p logs ->
  81     postNodeAsync uId nId p (liftBase . logs)
  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                    }