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

-}

{-# OPTIONS_GHC -fno-warn-deprecations #-}

{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE OverloadedLists   #-}   -- allows to write Map and HashMap as lists

module Gargantext.Core.Viz.Graph.API
  where

import Control.Lens (set, _Just, (^?), at, view)
import Data.HashMap.Strict qualified as HashMap
import Gargantext.API.Admin.EnvTypes (Env)
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Ngrams.Tools
import Gargantext.API.Prelude (GargM)
import Gargantext.API.Routes.Named.Viz qualified as Named
import Gargantext.API.Worker (serveWorkerAPI)
import Gargantext.Core.Methods.Similarities (Similarity(..), GraphMetric(..), withMetric)
import Gargantext.Core.NodeStory.Types ( HasNodeStory, a_version, unNodeStory, NodeListStory, NodeStoryEnv, hasNodeStory, HasNodeStoryEnv )
import Gargantext.Core.Text.Ngrams (NgramsType(..))
import Gargantext.Core.Types.Main ( ListType(MapTerm) )
import Gargantext.Core.Viz.Graph.GEXF ()
import Gargantext.Core.Viz.Graph.Tools -- (cooc2graph)
import Gargantext.Core.Viz.Graph.Types
import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOnlyUser)
import Gargantext.Database.Action.Node (mkNodeWithParent)
import Gargantext.Database.Admin.Config ( userMaster )
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Node ( getOrMkList, getNodeWith, defaultList, getClosestParentIdByType )
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node.Select ( selectNodesWithUsername )
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Schema.Node (node_hyperdata, node_name)
import Gargantext.Prelude
import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..))
import Servant
import Servant.Server.Generic (AsServerT)
import Gargantext.Core.Config (GargConfig)

------------------------------------------------------------------------
--getGraph :: UserId -> NodeId -> GargServer HyperdataGraphAPI
-- TODO(adn) DB-transactional
getGraph :: (HasNodeStoryEnv env err, HasNodeError err, IsDBCmd env err m)
         => NodeId
         -> m HyperdataGraphAPI
getGraph nId = do
  env <- view hasNodeStory
  nodeGraph <- runDBQuery $ getNodeWith nId (Proxy :: Proxy HyperdataGraph)

  let
    graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
    camera = nodeGraph ^. node_hyperdata . hyperdataCamera

  mcId <- runDBQuery $ getClosestParentIdByType nId NodeCorpus
  let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId

  -- printDebug "[getGraph] getting list for cId" cId
  listId <- runDBQuery $ defaultList cId
  repo <- runDBQuery $ getRepo env [listId]

  -- TODO Similarity in Graph params
  case graph of
    Nothing     -> do
        let defaultMetric          = Order1
        let defaultEdgesStrength   = Strong
        let defaultBridgenessMethod = BridgenessBasic
        graph' <- computeGraph cId defaultBridgenessMethod (withMetric defaultMetric) defaultEdgesStrength (NgramsTerms, NgramsTerms) repo
        mt     <- defaultGraphMetadata cId listId "Title" repo defaultMetric defaultEdgesStrength defaultBridgenessMethod
        let mt' = set gm_legend (generateLegend graph') mt
        let
          graph'' = set graph_metadata (Just mt') graph'
          hg = HyperdataGraphAPI graph'' camera
       -- _      <- updateHyperdata nId hg
        _ <- runDBTx $ updateHyperdata nId (HyperdataGraph (Just graph'') camera)
        pure $ trace ("[G.V.G.API] Graph empty, computing" :: Text) hg

    Just graph' -> pure $ trace ("[G.V.G.API] Graph exists, returning" :: Text) $
        HyperdataGraphAPI graph' camera


--recomputeGraph :: UserId -> NodeId -> Maybe GraphMetric -> GargNoServer Graph
-- TODO(adn) make db-transactional.
recomputeGraph :: (HasNodeStoryEnv env err, IsDBCmd env err m, HasNodeError err)
               => NodeId
               -> BridgenessMethod
               -> Maybe GraphMetric
               -> Maybe Strength
               -> NgramsType
               -> NgramsType
               -> Bool
               -> m Graph
recomputeGraph nId bridgeMethod maybeSimilarity maybeStrength nt1 nt2 force' = do
  env <- view hasNodeStory
  nodeGraph <- runDBQuery $ getNodeWith nId (Proxy :: Proxy HyperdataGraph)
  let
    graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
    camera = nodeGraph ^. node_hyperdata . hyperdataCamera
    graphMetadata = graph ^? _Just . graph_metadata . _Just
    listVersion   = graph ^? _Just . graph_metadata . _Just . gm_list . lfg_version
    graphMetric   = case maybeSimilarity of
                      Nothing -> graph ^? _Just . graph_metadata . _Just . gm_metric
                      Just _  -> maybeSimilarity
    similarity = case graphMetric of
                   Nothing -> withMetric Order1
                   Just m  -> withMetric m

    strength = case maybeStrength of
                   Nothing -> case graph ^? _Just . graph_metadata . _Just . gm_edgesStrength of
                        Nothing  -> Strong
                        Just  mr -> fromMaybe Strong mr
                   Just r  -> r

  mcId <- runDBQuery $ getClosestParentIdByType nId NodeCorpus
  let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId

  listId  <- runDBQuery $ defaultList cId
  repo    <- runDBQuery $ getRepo env [listId]
  let v   = repo ^. unNodeStory . at listId . _Just . a_version

  let computeG mt = do
        !g <- computeGraph cId bridgeMethod similarity strength (nt1,nt2) repo
        let mt' = set gm_legend (generateLegend g) mt
        let g' = set graph_metadata (Just mt') g
        _nentries <- runDBTx $ updateHyperdata nId (HyperdataGraph (Just g') camera)
        pure g'

  case graph of
    Nothing     -> do
      mt     <- defaultGraphMetadata cId listId "Title" repo (fromMaybe Order1 maybeSimilarity) strength bridgeMethod
      g <- computeG mt
      pure $ trace ("[G.V.G.API.recomputeGraph] Graph empty, computed" :: Text) g
    Just graph' -> if (listVersion == Just v) && (not force')
                     then pure graph'
                     else do
                       case graphMetadata of
                         Nothing -> do
                           mt <- defaultGraphMetadata cId listId "Title" repo (fromMaybe Order1 maybeSimilarity) strength bridgeMethod
                           g <- computeG mt
                           pure $ trace ("[G.V.G.API] Graph exists, no metadata, recomputing" :: Text) g
                         Just mt -> do
                           g <- computeG mt
                           pure $ trace ("[G.V.G.API] Graph exists, recomputing" :: Text) g


-- TODO remove repo
-- TODO(adn) DB-transactional
computeGraph :: HasNodeError err
             => CorpusId
             -> BridgenessMethod
             -> Similarity
             -> Strength
             -> (NgramsType, NgramsType)
             -> NodeListStory
             -> DBCmd err Graph
computeGraph corpusId bridgeMethod similarity strength (nt1,nt2) repo = do
  -- Getting the Node parameters
  (lId, lIds)  <- runDBQuery $ ((,) <$> defaultList corpusId <*> selectNodesWithUsername NodeList userMaster)

  -- Getting the Ngrams to compute with and grouping it according to the lists
  let
    groupedContextsByNgrams nt corpusId' (lists_master, lists_user) = do
      let
        ngs = filterListWithRoot [MapTerm] $ mapTermListRoot lists_user nt repo
      groupNodesByNgrams ngs <$> getContextsByNgramsOnlyUser corpusId'
                                     (lists_user <> lists_master) nt (HashMap.keys ngs)

  -- Optim if nt1 == nt2 : do not compute twice
  (m1,m2) <- do
    m1 <- runDBQuery $ groupedContextsByNgrams nt1 corpusId (lIds, [lId])
    if nt1 == nt2
      then
        pure (m1,m1)
      else do
        m2 <- runDBQuery $ groupedContextsByNgrams nt2 corpusId (lIds, [lId])
        pure (m1,m2)

            -- Removing the hapax (ngrams with 1 cooc)
  let !myCooc = {- HashMap.filter (>0)
              $ -} getCoocByNgrams'' (Diagonal True) (identity, identity) (m1,m2)

  -- TODO MultiPartite Here
  liftBase
        $ cooc2graphWith bridgeMethod (MultiPartite (Partite (HashMap.keysSet m1) nt1)
                                              (Partite (HashMap.keysSet m2) nt2)
                                              )
                                similarity 0 strength myCooc



defaultGraphMetadata :: HasNodeError err
                     => CorpusId
                     -> ListId
                     -> Text
                     -> NodeListStory
                     -> GraphMetric
                     -> Strength
                     -> BridgenessMethod
                     -> DBCmd err GraphMetadata
defaultGraphMetadata cId lId t repo gm str bm = do
  pure $ GraphMetadata { _gm_title         = t
                       , _gm_metric        = gm
                       , _gm_edgesStrength = Just str
                       , _gm_corpusId      = [cId]
                       , _gm_bridgenessMethod = Just bm
                       , _gm_legend = [
                             LegendField 1 "#FFF" "Cluster1"
                           , LegendField 2 "#FFF" "Cluster2"
                           , LegendField 3 "#FFF" "Cluster3"
                           , LegendField 4 "#FFF" "Cluster4"
                           ]
                       , _gm_list  = ListForGraph lId (repo ^. unNodeStory . at lId . _Just . a_version)
                       , _gm_startForceAtlas = True
                       }
                         -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])

graphAsync :: NodeId -> Named.GraphAsyncAPI (AsServerT (GargM Env BackendInternalError))
graphAsync nId =
  Named.GraphAsyncAPI {
    recomputeGraphEp = serveWorkerAPI $ const $ Jobs.RecomputeGraph { _rg_node_id = nId }
    }


--graphRecompute :: UserId
--               -> NodeId
--               -> (JobLog -> GargNoServer ())
--               -> GargNoServer JobLog
-- TODO get Graph Metadata to recompute
graphRecompute ::  (HasNodeStory env err m, MonadJobStatus m)
               => NodeId
               -> JobHandle m
               -> m ()
graphRecompute n jobHandle = do
  markStarted 1 jobHandle
  _g <- recomputeGraph n BridgenessBasic Nothing Nothing NgramsTerms NgramsTerms False
  markComplete jobHandle

graphVersions :: HasNodeError err
              => NodeStoryEnv err
              -> UserId
              -> NodeId
              -> DBUpdate err GraphVersions
graphVersions env u nId = do
  nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
  let
    graph =  nodeGraph
          ^. node_hyperdata
           . hyperdataGraph

    listVersion =  graph
                ^? _Just
                . graph_metadata
                . _Just
                . gm_list
                . lfg_version

  mcId <- getClosestParentIdByType nId NodeCorpus
  let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId

  listId <- getOrMkList cId u
  repo <- getRepo env [listId]
  let v = repo ^. unNodeStory . at listId . _Just . a_version
  -- printDebug "graphVersions" v

  pure $ GraphVersions { gv_graph = listVersion
                       , gv_repo = v }

recomputeVersions :: HasNodeStory env err m
                  => NodeId
                  -> m Graph
recomputeVersions nId = recomputeGraph nId BridgenessBasic Nothing Nothing NgramsTerms NgramsTerms False

------------------------------------------------------------
graphClone :: HasNodeError err
           => GargConfig
           -> UserId
           -> NodeId
           -> HyperdataGraphAPI
           -> DBUpdate err NodeId
graphClone cfg userId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph
                                         , _hyperdataAPICamera = camera }) = do
  let nodeType = NodeGraph
  nodeParent <- getNodeWith pId (Proxy :: Proxy HyperdataGraph)
  nIds <- mkNodeWithParent cfg nodeType (Just pId) userId $ nodeParent ^. node_name
  case nIds of
    [] -> pure pId
    (nId:_) -> do
      let graphP = graph
      let graphP' = set (graph_metadata . _Just . gm_startForceAtlas) False graphP

      _ <- updateHyperdata nId (HyperdataGraph (Just graphP') camera)

      pure nId

------------------------------------------------------------
--getGraphGexf :: UserId
--             -> NodeId
--             -> GargNoServer (Headers '[Servant.Header "Content-Disposition" Text] Graph)
getGraphGexf :: HasNodeStory env err m
              => NodeId
             -> m (Headers '[Servant.Header "Content-Disposition" Text] Graph)
getGraphGexf nId = do
  HyperdataGraphAPI { _hyperdataAPIGraph = graph } <- getGraph nId
  pure $ addHeader "attachment; filename=graph.gexf" graph

------------------------------------------------------------
updateGraphLegend :: HasNodeError err
                  => NodeId
                  -> GraphLegendAPI
                  -> DBUpdate err NodeId
updateGraphLegend nId (GraphLegendAPI lg ) = do
  nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
  let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
  case graph of
    Nothing -> pure nId
    Just g -> do
      let graph' = set (graph_metadata . _Just . gm_legend) lg g
      _ <- updateHyperdata nId (HyperdataGraph (Just graph') (nodeGraph ^. node_hyperdata . hyperdataCamera))
      pure nId
