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

-}

{-# LANGUAGE TypeApplications #-}

module Gargantext.API.Node.Update
      where

import Control.Lens (view, (^?), _Just)
import Data.Set qualified as Set
import Gargantext.API.Admin.EnvTypes (Env)
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Metrics qualified as Metrics
import Gargantext.API.Ngrams.Types qualified as NgramsTypes
import Gargantext.API.Node.Update.Types (Method(..), UpdateNodeParams(..), UpdateNodeConfigGraph(..))
import Gargantext.API.Prelude (GargM, simuLogs)
import Gargantext.API.Routes.Named.Node qualified as Named
import Gargantext.API.Worker (serveWorkerAPI)
import Gargantext.Core.NodeStory.Types (HasNodeStory, hasNodeStory)
import Gargantext.Core.Text.Ngrams (NgramsType(NgramsTerms))
import Gargantext.Core.Types.Main (ListType(..))
import Gargantext.Core.Viz.Graph.API (recomputeGraph)
import Gargantext.Core.Viz.Phylo (subConfigAPI2config, phylo_computeTime)
import Gargantext.Core.Viz.Phylo.API.Tools (flowPhyloAPI)
import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
import Gargantext.Database.Action.Flow (reIndexWith)
import Gargantext.Database.Action.Flow.Pairing (pairing)
import Gargantext.Database.Action.Metrics (updateNgramsOccurrences, updateContextScore)
import Gargantext.Database.Admin.Types.Hyperdata.Phylo ( HyperdataPhylo(HyperdataPhylo), hp_data )
import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType(NodeCorpus, NodeAnnuaire, NodeTexts, NodeGraph, NodePhylo, NodeList) )
import Gargantext.Database.Query.Table.Node (defaultList, getNode, getChildrenByType, getNodeWith)
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Schema.Node (node_parent_id, node_hyperdata)
import Gargantext.Database.Prelude
import Gargantext.Prelude
import Gargantext.System.Logging ( MonadLogger )
import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..))
import Gargantext.Utils.UTCTime (timeMeasured)
import Servant.Server.Generic (AsServerT)

------------------------------------------------------------------------
api :: NodeId -> Named.UpdateAPI (AsServerT (GargM Env BackendInternalError))
api nId =
  Named.UpdateAPI {
    updateNodeEp = serveWorkerAPI $ \p ->
        Jobs.UpdateNode { _un_node_id = nId
                        , _un_args = p }
 }

-- TODO(adn) Make DB-transactional.
updateNode :: (HasNodeStory env err m
              , MonadJobStatus m
              , MonadLogger m
              )
           => NodeId
           -> UpdateNodeParams
           -> JobHandle m
           -> m ()
updateNode nId (UpdateNodeParamsGraph
                    (UpdateNodeConfigGraph metric bridgeMethod strength nt1 nt2)) jobHandle = do

  markStarted 2 jobHandle
  markProgress 1 jobHandle
  -- printDebug "Computing graph: " method
  _ <- recomputeGraph nId bridgeMethod (Just metric) (Just strength) nt1 nt2 True
  -- printDebug "Graph computed: " method
  markComplete jobHandle

updateNode nid1 (LinkNodeReq nt nid2) jobHandle = do
  env <- view hasNodeStory
  markStarted 2 jobHandle
  markProgress 1 jobHandle
  _ <- case nt of
    NodeAnnuaire -> runDBTx $ pairing env nid2 nid1 Nothing -- defaultList
    NodeCorpus   -> runDBTx $ pairing env nid1 nid2 Nothing -- defaultList
    _            -> panicTrace $ "[G.API.N.Update.updateNode] NodeType not implemented"
                               <> show nt <> " nid1: " <> show nid1 <> " nid2: " <> show nid2

  markComplete jobHandle

-- | `Advanced` to update graphs
updateNode lId (UpdateNodeParamsList Advanced) jobHandle = do
  markStarted 4 jobHandle
  corpusId <- view node_parent_id <$> (runDBQuery $ getNode lId)

  markProgress 1 jobHandle

  _ <- case corpusId of
    Just cId -> do
      _ <- Metrics.updatePie cId (Just lId) NgramsTypes.Authors Nothing
      markProgress 1 jobHandle
      _ <- Metrics.updateTree cId (Just lId) NgramsTypes.Institutes MapTerm
      markProgress 1 jobHandle
      _ <- Metrics.updatePie cId (Just lId) NgramsTypes.Sources Nothing
      pure ()
    Nothing  -> pure ()

  markComplete jobHandle

updateNode lId (UpdateNodeParamsList _mode) jobHandle = do
  env <- view hasNodeStory
  markStarted 3 jobHandle
  corpusId <- view node_parent_id <$> runDBQuery (getNode lId)

  markProgress 1 jobHandle

  _ <- case corpusId of
    Just cId -> do
      _ <- runDBTx $ reIndexWith env cId lId NgramsTerms (Set.singleton MapTerm)
      markProgress 1 jobHandle
      _ <- runDBTx $ updateNgramsOccurrences env cId lId
      pure ()
    Nothing  -> pure ()

  markComplete jobHandle

updateNode phyloId (UpdateNodePhylo config) jobHandle = do
  markStarted 3 jobHandle
  oldPhylo      <- runDBQuery $ getNodeWith phyloId (Proxy @HyperdataPhylo)
  let corpusId' = view node_parent_id oldPhylo
  let mbComputeHistory = oldPhylo ^? node_hyperdata . hp_data . traverse . phylo_computeTime . _Just
  markProgress 1 jobHandle

  let corpusId = fromMaybe (panicTrace "no corpus id") corpusId'

  phy <- timeMeasured "updateNode.flowPhyloAPI" $ flowPhyloAPI (subConfigAPI2config config) mbComputeHistory corpusId jobHandle
  markProgress 1 jobHandle

{-
  logStatus JobLog { _scst_succeeded = Just 2
                   , _scst_failed    = Just 0
                   , _scst_remaining = Just 1
                   , _scst_events    = Just []
                   }
-}
  _ <- timeMeasured "updateNode.updateHyperdataPhylo" $ runDBTx $ updateHyperdata phyloId (HyperdataPhylo Nothing (Just phy))

  -- TODO: catch the error of sendMail if userId is not found, then debug
  -- sendMail (UserDBId userId)
  markComplete jobHandle

updateNode tId (UpdateNodeParamsTexts _mode) jobHandle = do
  markStarted 2 jobHandle
  corpusId <- view node_parent_id <$> (runDBQuery $ getNode tId)
  markProgress 1 jobHandle

  _ <- case corpusId of
    Just cId -> updateDocs cId jobHandle
    Nothing  -> do
      _ <- panicTrace "[G.A.N.Update] updateNode/UpdateNodeParamsText: no corpus Id given"
      pure ()

  markComplete jobHandle

updateNode tId
    (UpdateNodeParamsCorpus methodGraph methodPhylo methodTexts methodList)
    jobHandle = do
  markStarted 5 jobHandle
  markProgress 1 jobHandle

  _ <- runDBQuery (getNode tId)
  childTexts     <- runDBQuery $ getChildrenByType tId NodeTexts
  childGraphs    <- runDBQuery $ getChildrenByType tId NodeGraph
  childPhylos    <- runDBQuery $ getChildrenByType tId NodePhylo
  childNodeLists <- runDBQuery $ getChildrenByType tId NodeList

  mapM_ (\cId -> updateNode cId (UpdateNodeParamsTexts methodTexts) jobHandle) childTexts
  markProgress 1 jobHandle
  mapM_ (\cId -> updateNode cId (UpdateNodeParamsGraph methodGraph) jobHandle) childGraphs
  markProgress 1 jobHandle
  mapM_ (\cId -> updateNode cId (UpdateNodePhylo methodPhylo) jobHandle) childPhylos
  markProgress 1 jobHandle
  mapM_ (\cId -> updateNode cId (UpdateNodeParamsList methodList) jobHandle) childNodeLists

  markComplete jobHandle

updateNode _nId _p jobHandle = do
  simuLogs jobHandle 10
------------------------------------------------------------------------

updateDocs :: ( HasNodeStory env err m
              , MonadJobStatus m
              , MonadLogger m )
           => NodeId
           -> JobHandle m
           -> m ()
updateDocs cId jobHandle = do
  env <- view hasNodeStory
  markStarted 4 jobHandle
  lId <- runDBQuery $ defaultList cId
  _ <- runDBTx $ reIndexWith env cId lId NgramsTerms (Set.singleton MapTerm)
  markProgress 1 jobHandle
  _ <- runDBTx $ updateNgramsOccurrences env cId lId
  markProgress 1 jobHandle
  _ <- runDBTx $ updateContextScore      env cId lId
  markProgress 1 jobHandle
  _ <- runDBTx $ Metrics.updateChart'    cId lId NgramsTypes.Docs Nothing
  markProgress 1 jobHandle
  -- printDebug "updateContextsScore" (cId, lId, u)
  pure ()

