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