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 NoImplicitPrelude  #-}
  16 {-# LANGUAGE TemplateHaskell    #-}
  17 {-# LANGUAGE DeriveGeneric      #-}
  18 {-# LANGUAGE DataKinds          #-}
  19 {-# LANGUAGE TypeOperators      #-}
  20 {-# LANGUAGE OverloadedStrings  #-}
  21 {-# LANGUAGE FlexibleContexts   #-}
  22 {-# LANGUAGE RankNTypes         #-}
  23 {-# OPTIONS_GHC -fno-warn-orphans #-}
  24
  25 module Gargantext.API.Node.New
  26       where
  27
  28 import Control.Lens hiding (elements, Empty)
  29 import Data.Aeson
  30 import Data.Swagger
  31 import Data.Text (Text)
  32 import GHC.Generics (Generic)
  33 import Gargantext.API.Admin.Orchestrator.Types (ScraperStatus(..))
  34 import Gargantext.API.Node.Corpus.New (AsyncJobs)
  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 import Servant
  44 import Test.QuickCheck (elements)
  45 import Test.QuickCheck.Arbitrary
  46
  47 ------------------------------------------------------------------------
  48 data PostNode = PostNode { pn_name     :: Text
  49                          , pn_typename :: NodeType}
  50   deriving (Generic)
  51 ------------------------------------------------------------------------
  52 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
  53 instance FromJSON  PostNode
  54 instance ToJSON    PostNode
  55 instance ToSchema  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_userId
  68   mkNodeWithParent nt (Just pId) uId' nodeName
  69
  70 ------------------------------------------------------------------------
  71 type PostNodeAsync = Summary "Post Node"
  72    :> "async"
  73    :> AsyncJobs ScraperStatus '[FormUrlEncoded] PostNode ScraperStatus
  74
  75 ------------------------------------------------------------------------
  76 postNodeAsync :: FlowCmdM env err m
  77     => UserId
  78     -> NodeId
  79     -> PostNode
  80     -> (ScraperStatus -> m ())
  81     -> m ScraperStatus
  82 postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
  83
  84   printDebug "postNodeAsync" nId
  85   logStatus ScraperStatus { _scst_succeeded = Just 1
  86                           , _scst_failed    = Just 0
  87                           , _scst_remaining = Just 2
  88                           , _scst_events    = Just []
  89                           }
  90
  91   nodeUser <- getNodeUser (NodeId uId)
  92
  93   -- _ <- threadDelay 1000
  94   logStatus ScraperStatus { _scst_succeeded = Just 1
  95                           , _scst_failed    = Just 0
  96                           , _scst_remaining = Just 2
  97                           , _scst_events    = Just []
  98                           }
  99
 100   let uId' = nodeUser ^. node_userId
 101   _ <- mkNodeWithParent tn (Just nId) uId' nodeName
 102
 103   pure      ScraperStatus { _scst_succeeded = Just 3
 104                           , _scst_failed    = Just 0
 105                           , _scst_remaining = Just 0
 106                           , _scst_events    = Just []
 107                           }