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

Metrics API

-}

{-# LANGUAGE TypeOperators #-}

module Gargantext.API.Metrics
    where

import Data.HashMap.Strict qualified as HashMap
import Data.Time (UTCTime)
import Data.Vector (Vector)
import Gargantext.API.HashedResponse (HashedResponse, constructHashedResponse, hash)
import Gargantext.API.Ngrams.NgramsTree (NgramsTree)
import Gargantext.API.Ngrams.Types (QueryParamR, TabType, ngramsTypeFromTabType, unNgramsTerm)
import Gargantext.API.Prelude (IsGargServer)
import Gargantext.API.Routes.Named.Metrics qualified as Named
import Gargantext.Core.NodeStory (HasNodeStory, NodeStoryEnv, HasNodeStoryEnv (..))
import Gargantext.Core.Text.Metrics (Scored(..), {-normalizeGlobal,-} normalizeLocal)
import Gargantext.Core.Types (CorpusId, ListId, ListType(..))
import Gargantext.Core.Types.Query (Limit)
import Gargantext.Core.Viz.Chart (chartData, histoData, treeData)
import Gargantext.Core.Viz.Types (Histo)
import Gargantext.Database.Action.Metrics qualified as Metrics
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataList(..), hl_chart, hl_pie, hl_scatter, hl_tree)
import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metric(..), Metrics(..))
import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Node (defaultList, getNodeWith)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Schema.Node (node_hyperdata)
import Gargantext.Prelude hiding (hash)
import Servant
import Servant.Server.Generic (AsServerT)
import Control.Lens (view)

-------------------------------------------------------------
scatterApi :: IsGargServer err env m => NodeId -> Named.ScatterAPI (AsServerT m)
scatterApi id' = Named.ScatterAPI
  { sepGenEp        = \lid tt lm -> do
    env <- view hasNodeStory
    runDBTx $ getScatter env id' lid tt lm
  , scatterUpdateEp = updateScatter id'
  , scatterHashEp   = \a b -> do
    env <- view hasNodeStory
    runDBTx $ getScatterHash env id' a b
  }

getScatter :: HasNodeError err
           => NodeStoryEnv err
           -> CorpusId
           -> Maybe ListId
           -> TabType
           -> Maybe Limit
           -> DBUpdate err (HashedResponse Metrics)
getScatter env cId maybeListId tabType _maybeLimit = do
  listId <- case maybeListId of
    Just lid -> pure lid
    Nothing  -> defaultList cId
  node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
  let HyperdataList { _hl_scatter = scatterMap } = node ^. node_hyperdata
      mChart = HashMap.lookup tabType scatterMap

  chart <- case mChart of
    Just chart -> pure chart
    Nothing    -> do
      updateScatter' env cId listId tabType Nothing

  pure $ constructHashedResponse chart

updateScatter :: HasNodeStory env err m
              => CorpusId
              -> Maybe ListId
              -> TabType
              -> Maybe Limit
              -> m ()
updateScatter cId maybeListId tabType maybeLimit = do
  env <- view hasNodeStory
  runDBTx $ do
    listId <- case maybeListId of
      Just lid -> pure lid
      Nothing  -> defaultList cId
    -- printDebug "[updateScatter] cId" cId
    -- printDebug "[updateScatter] maybeListId" maybeListId
    -- printDebug "[updateScatter] tabType" tabType
    -- printDebug "[updateScatter] maybeLimit" maybeLimit
    void $ updateScatter' env cId listId tabType maybeLimit

updateScatter' :: HasNodeError err
               => NodeStoryEnv err
               -> CorpusId
               -> ListId
               -> TabType
               -> Maybe Limit
               -> DBUpdate err Metrics
updateScatter' env cId listId tabType maybeLimit = do
  (ngs', scores) <- Metrics.getMetrics env cId listId tabType maybeLimit

  let
    metrics      = fmap (\(Scored t s1 s2) -> Metric { m_label = unNgramsTerm t
                                                     , m_x = s1
                                                     , m_y = s2
                                                     , m_cat = listType t ngs' })
                 $ fmap normalizeLocal scores
    listType t m = maybe (panicTrace errorMsg) fst $ HashMap.lookup t m
    errorMsg     = "API.Node.metrics: key absent"

  node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
  let hl = node ^. node_hyperdata
      scatterMap = hl ^. hl_scatter
  _ <- updateHyperdata listId $ hl { _hl_scatter = HashMap.insert tabType (Metrics metrics) scatterMap }

  pure $ Metrics metrics

getScatterHash :: HasNodeError err
               => NodeStoryEnv err
               -> CorpusId
               -> Maybe ListId
               -> TabType
               -> DBUpdate err Text
getScatterHash env cId maybeListId tabType = do
  hash <$> getScatter env cId maybeListId tabType Nothing


-------------------------------------------------------------
chartApi :: IsGargServer err env m => NodeId -> Named.ChartAPI (AsServerT m)
chartApi id' = Named.ChartAPI
  { getChartEp = \st end ll tt -> do
    runDBTx $ getChart id' st end ll tt
  , updateChartEp = \a b c -> runDBTx $ updateChart id' a b c
  , chartHashEp = \a b -> do
    runDBTx $ getChartHash id' a b
  }

-- TODO add start / end
getChart :: HasNodeError err
         => CorpusId
         -> Maybe UTCTime
         -> Maybe UTCTime
         -> Maybe ListId
         -> TabType
         -> DBUpdate err (HashedResponse (ChartMetrics Histo))
getChart cId _start _end maybeListId tabType = do
  listId <- case maybeListId of
    Just lid -> pure lid
    Nothing  -> defaultList cId
  node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
  let chartMap = node ^. node_hyperdata ^. hl_chart
      mChart = HashMap.lookup tabType chartMap

  chart <- case mChart of
    Just chart -> pure chart
    Nothing    -> do
      updateChart' cId listId tabType Nothing

  pure $ constructHashedResponse chart

updateChart :: HasNodeError err
            => CorpusId
            -> Maybe ListId
            -> TabType
            -> Maybe Limit
            -> DBUpdate err ()
updateChart cId maybeListId tabType maybeLimit = do
  listId <- case maybeListId of
    Just lid -> pure lid
    Nothing  -> defaultList cId
  --printDebug "[updateChart] cId" cId
  --printDebug "[updateChart] listId" listId
  --printDebug "[updateChart] tabType" tabType
  --printDebug "[updateChart] maybeLimit" maybeLimit
  void $ updateChart' cId listId tabType maybeLimit

updateChart' :: HasNodeError err
             => CorpusId
             -> ListId
             -> TabType
             -> Maybe Limit
             -> DBUpdate err (ChartMetrics Histo)
updateChart' cId listId tabType _maybeLimit = do
  node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
  let hl = node ^. node_hyperdata
      chartMap = hl ^. hl_chart
  h <- histoData cId
  _ <- updateHyperdata listId $ hl { _hl_chart = HashMap.insert tabType (ChartMetrics h) chartMap }

  pure $ ChartMetrics h


getChartHash :: HasNodeError err
             => CorpusId
             -> Maybe ListId
             -> TabType
             -> DBUpdate err Text
getChartHash cId maybeListId tabType = do
  hash <$> getChart cId Nothing Nothing maybeListId tabType

-------------------------------------------------------------
-- | Pie metrics API
type PieApi = Summary "Pie Chart"
           :> QueryParam "from" UTCTime
           :> QueryParam "to"   UTCTime
           :> QueryParam  "list"       ListId
           :> QueryParamR "ngramsType" TabType
           :> Get '[JSON] (HashedResponse (ChartMetrics Histo))
         :<|> Summary "Pie Chart update"
             :> QueryParam  "list"       ListId
             :> QueryParamR "ngramsType" TabType
             :> QueryParam  "limit"      Limit
             :> Post '[JSON] ()
         :<|> "hash" :> Summary "Pie Hash"
                     :> QueryParam  "list"       ListId
                     :> QueryParamR "ngramsType" TabType
                     :> Get '[JSON] Text

pieApi :: IsGargServer err env m => NodeId -> Named.PieAPI (AsServerT m)
pieApi id' = Named.PieAPI
  { getPieChartEp    = \ st end mlt tt -> do
    env <- view hasNodeStory
    runDBTx $ getPie env id' st end mlt tt
  , pieChartUpdateEp = updatePie id'
  , pieHashEp        = \a b -> do
    env <- view hasNodeStory
    runDBTx $ getPieHash env id' a b
  }

getPie :: HasNodeError err
       => NodeStoryEnv err
       -> CorpusId
       -> Maybe UTCTime
       -> Maybe UTCTime
       -> Maybe ListId
       -> TabType
       -> DBUpdate err (HashedResponse (ChartMetrics Histo))
getPie env cId _start _end maybeListId tabType = do
  listId <- case maybeListId of
    Just lid -> pure lid
    Nothing  -> defaultList cId
  node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
  let pieMap = node ^. node_hyperdata ^. hl_pie
      mChart = HashMap.lookup tabType pieMap

  chart <- case mChart of
    Just chart -> pure chart
    Nothing    -> do
      updatePie' env cId listId tabType Nothing

  pure $ constructHashedResponse chart

updatePie :: HasNodeStory env err m
          => CorpusId
          -> Maybe ListId
          -> TabType
          -> Maybe Limit
          -> m ()
updatePie cId maybeListId tabType maybeLimit = do
  printDebug "[updatePie] cId" cId
  printDebug "[updatePie] maybeListId" maybeListId
  printDebug "[updatePie] tabType" tabType
  printDebug "[updatePie] maybeLimit" maybeLimit
  env <- view hasNodeStory
  runDBTx $ do
    listId <- case maybeListId of
      Just lid -> pure lid
      Nothing  -> defaultList cId
    void $ updatePie' env cId listId tabType maybeLimit

updatePie' :: HasNodeError err
           => NodeStoryEnv err
           -> CorpusId
           -> ListId
           -> TabType
           -> Maybe Limit
           -> DBUpdate err (ChartMetrics Histo)
updatePie' env cId listId tabType _maybeLimit = do
  node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
  let hl = node ^. node_hyperdata
      pieMap = hl ^. hl_pie

  p <- chartData env cId (ngramsTypeFromTabType tabType) MapTerm
  _ <- updateHyperdata listId $ hl { _hl_pie = HashMap.insert tabType (ChartMetrics p) pieMap }

  pure $ ChartMetrics p

getPieHash :: HasNodeError err
           => NodeStoryEnv err
           -> CorpusId
           -> Maybe ListId
           -> TabType
           -> DBUpdate err Text
getPieHash env cId maybeListId tabType = do
  hash <$> getPie env cId Nothing Nothing maybeListId tabType

-------------------------------------------------------------
-- | Tree metrics API
treeApi :: IsGargServer err env m => NodeId -> Named.TreeAPI (AsServerT m)
treeApi id' = Named.TreeAPI
  { treeChartEp = \st end mlid tt lt -> do
      env <- view hasNodeStory
      runDBTx $ getTree env id' st end mlid tt lt
  , treeChartUpdateEp = updateTree id'
  , treeHashEp = \a b c -> do
    env <- view hasNodeStory
    runDBTx $ getTreeHash env id' a b c
  }

getTree :: HasNodeError err
        => NodeStoryEnv err
        -> CorpusId
        -> Maybe UTCTime
        -> Maybe UTCTime
        -> Maybe ListId
        -> TabType
        -> ListType
        -> DBUpdate err (HashedResponse (ChartMetrics (Vector NgramsTree)))
getTree env cId _start _end maybeListId tabType listType = do
  listId <- case maybeListId of
    Just lid -> pure lid
    Nothing  -> defaultList cId

  node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
  let treeMap = node ^. node_hyperdata ^. hl_tree
      mChart = HashMap.lookup tabType treeMap

  chart <- case mChart of
    Just chart -> pure chart
    Nothing    -> updateTree' env cId maybeListId tabType listType

  pure $ constructHashedResponse chart

updateTree :: HasNodeStory env err m
           => CorpusId
           -> Maybe ListId
           -> TabType
           -> ListType
           -> m ()
updateTree cId maybeListId tabType listType = do
  printDebug "[updateTree] cId" cId
  printDebug "[updateTree] maybeListId" maybeListId
  printDebug "[updateTree] tabType" tabType
  printDebug "[updateTree] listType" listType
  env <- view hasNodeStory
  _ <- runDBTx $ updateTree' env cId maybeListId tabType listType
  pure ()

updateTree' :: HasNodeError err
            => NodeStoryEnv err
            -> CorpusId
            -> Maybe ListId
            -> TabType
            -> ListType
            -> DBUpdate err (ChartMetrics (Vector NgramsTree))
updateTree' env cId maybeListId tabType listType = do
  listId <- case maybeListId of
    Just lid -> pure lid
    Nothing  -> defaultList cId

  node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
  let hl      = node ^. node_hyperdata
      treeMap = hl  ^. hl_tree
  t <- treeData env cId (ngramsTypeFromTabType tabType) listType
  _ <- updateHyperdata listId $ hl { _hl_tree = HashMap.insert tabType (ChartMetrics t) treeMap }

  pure $ ChartMetrics t

getTreeHash :: HasNodeError err
            => NodeStoryEnv err
            -> CorpusId
            -> Maybe ListId
            -> TabType
            -> ListType
            -> DBUpdate err Text
getTreeHash env cId maybeListId tabType listType = do
  hash <$> getTree env cId Nothing Nothing maybeListId tabType listType
