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 Servant.Job.Async
  30 import Test.QuickCheck (elements)
  31 import Test.QuickCheck.Arbitrary
  32 import Web.FormUrlEncoded          (FromForm, ToForm)
  33
  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
  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 ToForm    PostNode
  56 instance Arbitrary PostNode where
  57   arbitrary = elements [PostNode "Node test" NodeCorpus]
  58
  59 ------------------------------------------------------------------------
  60 postNode :: HasNodeError err
  61          => UserId
  62          -> NodeId
  63          -> PostNode
  64          -> Cmd err [NodeId]
  65 postNode uId pId (PostNode nodeName nt) = do
  66   nodeUser <- getNodeUser (NodeId uId)
  67   let uId' = nodeUser ^. node_user_id
  68   mkNodeWithParent nt (Just pId) uId' nodeName
  69
  70 ------------------------------------------------------------------------
  71 type PostNodeAsync = Summary "Post Node"
  72    :> "async"
  73    :> AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog
  74
  75
  76 postNodeAsyncAPI :: UserId -> NodeId -> GargServer PostNodeAsync
  77 postNodeAsyncAPI uId nId =
  78   serveJobsAPI $
  79     JobFunction (\p logs -> postNodeAsync uId nId p (liftBase . logs))
  80
  81 ------------------------------------------------------------------------
  82 postNodeAsync :: FlowCmdM env err m
  83     => UserId
  84     -> NodeId
  85     -> PostNode
  86     -> (JobLog -> m ())
  87     -> m JobLog
  88 postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
  89
  90   printDebug "postNodeAsync" nId
  91   logStatus JobLog { _scst_succeeded = Just 1
  92                    , _scst_failed    = Just 0
  93                    , _scst_remaining = Just 2
  94                    , _scst_events    = Just []
  95                    }
  96
  97   nodeUser <- getNodeUser (NodeId uId)
  98
  99   -- _ <- threadDelay 1000
 100   logStatus JobLog { _scst_succeeded = Just 1
 101                    , _scst_failed    = Just 0
 102                    , _scst_remaining = Just 2
 103                    , _scst_events    = Just []
 104                    }
 105
 106   let uId' = nodeUser ^. node_user_id
 107   _ <- mkNodeWithParent tn (Just nId) uId' nodeName
 108
 109   pure      JobLog { _scst_succeeded = Just 3
 110                    , _scst_failed    = Just 0
 111                    , _scst_remaining = Just 0
 112                    , _scst_events    = Just []
 113                    }