{-|
Module      : Gargantext.API.Node.Post
Description :
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

New = Post maybe change the name
Async new node feature

-}

{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeOperators      #-}

{-# LANGUAGE IncoherentInstances #-}
module Gargantext.API.Node.New
      where

import Control.Lens hiding (elements, Empty)
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs (..))
import Gargantext.API.Errors.Types
import Gargantext.API.Node.New.Types
import Gargantext.API.Prelude
import Gargantext.API.Routes.Named.Node qualified as Named
import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CE
import Gargantext.Database.Action.Flow.Types
import Gargantext.Database.Action.Node
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (DBCmd')
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Prelude
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Servant.Server.Generic (AsServerT)
import Gargantext.API.Admin.Types (HasSettings)

------------------------------------------------------------------------
postNode :: (HasNodeError err, HasSettings env, CE.HasCentralExchangeNotification env)
         => AuthenticatedUser
         -- ^ The logged-in user
         -> NodeId
         -> PostNode
         -> DBCmd' env err [NodeId]
postNode authenticatedUser pId (PostNode nodeName nt) = do
  let userId = authenticatedUser ^. auth_user_id
  nodeIds <- mkNodeWithParent nt (Just pId) userId nodeName

  -- mapM_ (CE.ce_notify . CE.UpdateTreeFirstLevel) nodeIds
  CE.ce_notify $ CE.UpdateTreeFirstLevel pId
  
  return nodeIds

postNodeAsyncAPI
  :: AuthenticatedUser
  -- ^ The logged-in user
  -> NodeId
  -- ^ The target node
  -> Named.PostNodeAsyncAPI (AsServerT (GargM Env BackendInternalError))
postNodeAsyncAPI authenticatedUser nId = Named.PostNodeAsyncAPI $ AsyncJobs $
  serveJobsAPI NewNodeJob $ \jHandle p -> postNodeAsync authenticatedUser nId p jHandle

------------------------------------------------------------------------
postNodeAsync :: (FlowCmdM env err m, MonadJobStatus m, HasSettings env, CE.HasCentralExchangeNotification env)
    => AuthenticatedUser
    -- ^ The logged in user
    -> NodeId
    -> PostNode
    -> JobHandle m
    -> m ()
postNodeAsync authenticatedUser nId (PostNode nodeName tn) jobHandle = do

  -- printDebug "postNodeAsync" nId
  markStarted 3 jobHandle
  markProgress 1 jobHandle

  -- _ <- threadDelay 1000
  markProgress 1 jobHandle

  let userId = authenticatedUser ^. auth_user_id
  _nodeIds <- mkNodeWithParent tn (Just nId) userId nodeName

  -- mapM_ (CE.ce_notify . CE.UpdateTreeFirstLevel) nodeIds
  CE.ce_notify $ CE.UpdateTreeFirstLevel nId

  markComplete jobHandle