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(..), AsyncJobs)
  34 import Gargantext.API.Prelude
  35 import Gargantext.Database.Action.Flow.Types
  36 import Gargantext.Database.Action.Node
  37 import Gargantext.Database.Admin.Types.Node
  38 import Gargantext.Database.Prelude
  39 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
  40 import Gargantext.Database.Query.Table.Node.User
  41 import Gargantext.Database.Schema.Node
  42 import Gargantext.Prelude
  43
  44 ------------------------------------------------------------------------
  45 data PostNode = PostNode { pn_name     :: Text
  46                          , pn_typename :: NodeType}
  47   deriving (Generic)
  48 ------------------------------------------------------------------------
  49 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
  50 instance FromJSON  PostNode
  51 instance ToJSON    PostNode
  52 instance ToSchema  PostNode
  53 instance FromForm  PostNode
  54 instance Arbitrary PostNode where
  55   arbitrary = elements [PostNode "Node test" NodeCorpus]
  56
  57 ------------------------------------------------------------------------
  58 postNode :: HasNodeError err
  59          => UserId
  60          -> NodeId
  61          -> PostNode
  62          -> Cmd err [NodeId]
  63 postNode uId pId (PostNode nodeName nt) = do
  64   nodeUser <- getNodeUser (NodeId uId)
  65   let uId' = nodeUser ^. node_user_id
  66   mkNodeWithParent nt (Just pId) uId' nodeName
  67
  68 ------------------------------------------------------------------------
  69 type PostNodeAsync = Summary "Post Node"
  70    :> "async"
  71    :> AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog
  72
  73
  74 postNodeAsyncAPI :: UserId -> NodeId -> GargServer PostNodeAsync
  75 postNodeAsyncAPI uId nId =
  76   serveJobsAPI $
  77     JobFunction (\p logs -> postNodeAsync uId nId p (liftBase . logs))
  78
  79 ------------------------------------------------------------------------
  80 postNodeAsync :: FlowCmdM env err m
  81     => UserId
  82     -> NodeId
  83     -> PostNode
  84     -> (JobLog -> m ())
  85     -> m JobLog
  86 postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
  87
  88   printDebug "postNodeAsync" nId
  89   logStatus JobLog { _scst_succeeded = Just 1
  90                    , _scst_failed    = Just 0
  91                    , _scst_remaining = Just 2
  92                    , _scst_events    = Just []
  93                    }
  94
  95   nodeUser <- getNodeUser (NodeId uId)
  96
  97   -- _ <- threadDelay 1000
  98   logStatus JobLog { _scst_succeeded = Just 1
  99                    , _scst_failed    = Just 0
 100                    , _scst_remaining = Just 2
 101                    , _scst_events    = Just []
 102                    }
 103
 104   let uId' = nodeUser ^. node_user_id
 105   _ <- mkNodeWithParent tn (Just nId) uId' nodeName
 106
 107   pure      JobLog { _scst_succeeded = Just 3
 108                    , _scst_failed    = Just 0
 109                    , _scst_remaining = Just 0
 110                    , _scst_events    = Just []
 111                    }