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