Metrics.hs

{-|
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

-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE NoImplicitPrelude  #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RankNTypes         #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeOperators      #-}

module Gargantext.API.Metrics
    where

import Data.Aeson.TH (deriveJSON)
import Data.Swagger
import Data.Time (UTCTime)
import Data.Text (Text)
import GHC.Generics (Generic)
import Gargantext.Core.Types (ListType(..))
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Database.Utils
import Gargantext.Core.Types (CorpusId, ListId, Limit)
import Gargantext.Prelude
import Gargantext.API.Ngrams
import Gargantext.Text.Metrics (Scored(..))
import Gargantext.API.Ngrams.NTree
import Gargantext.Database.Flow
import Gargantext.Viz.Chart
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import qualified Data.Map as Map
import qualified Gargantext.Database.Metrics as Metrics

data Metrics = Metrics
  { metrics_data :: [Metric]}
  deriving (Generic, Show)

instance ToSchema Metrics where
  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "metrics_")
instance Arbitrary Metrics
  where
    arbitrary = Metrics <$> arbitrary

data Metric = Metric
  { m_label :: !Text
  , m_x     :: !Double
  , m_y     :: !Double
  , m_cat   :: !ListType
  } deriving (Generic, Show)

instance ToSchema Metric where
  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "m_")
instance Arbitrary Metric
  where
    arbitrary = Metric <$> arbitrary
                       <*> arbitrary
                       <*> arbitrary
                       <*> arbitrary

deriveJSON (unPrefix "metrics_") ''Metrics
deriveJSON (unPrefix "m_") ''Metric

-------------------------------------------------------------

data ChartMetrics a = ChartMetrics { chartMetrics_data :: a }
  deriving (Generic, Show)

instance (ToSchema a) => ToSchema (ChartMetrics a) where
  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "chartMetrics_")
instance (Arbitrary a) => Arbitrary (ChartMetrics a)
  where
    arbitrary = ChartMetrics <$> arbitrary

deriveJSON (unPrefix "chartMetrics_") ''ChartMetrics

-------------------------------------------------------------
instance ToSchema Histo where
  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "histo_")
instance Arbitrary Histo
  where
    arbitrary = elements [ Histo ["2012"] [1]
                         , Histo ["2013"] [1]
                         ]
deriveJSON (unPrefix "histo_") ''Histo



-------------------------------------------------------------
-- | Scatter metrics API
type ScatterAPI = Summary "SepGen IncExc metrics"
                :> QueryParam  "list"       ListId
                :> QueryParamR "ngramsType" TabType
                :> QueryParam  "limit"      Int
                :> Get '[JSON] Metrics

getScatter :: FlowCmdM env err m => 
  CorpusId
  -> Maybe ListId
  -> TabType
  -> Maybe Limit
  -> m Metrics
getScatter cId maybeListId tabType maybeLimit = do
  (ngs', scores) <- Metrics.getMetrics cId maybeListId tabType maybeLimit

  let
    metrics      = map (\(Scored t s1 s2) -> Metric t (log' 5 s1) (log' 2 s2) (listType t ngs')) scores
    log' n x     = 1 + (if x <= 0 then 0 else (log $ (10^(n::Int)) * x))
    listType t m = maybe (panic errorMsg) fst $ Map.lookup t m
    errorMsg     = "API.Node.metrics: key absent"

  pure $ Metrics metrics



-- TODO add start / end
getChart :: CorpusId -> Maybe UTCTime -> Maybe UTCTime -> Cmd err (ChartMetrics Histo)
getChart cId _start _end = do
  h <- histoData cId
  pure (ChartMetrics h)

getPie :: FlowCmdM env err m => CorpusId -> Maybe UTCTime -> Maybe UTCTime -> TabType -> m (ChartMetrics Histo)
getPie cId _start _end tt = do
  p <- pieData cId (ngramsTypeFromTabType tt) GraphTerm
  pure (ChartMetrics p)

getTree :: FlowCmdM env err m => CorpusId -> Maybe UTCTime -> Maybe UTCTime -> TabType -> ListType -> m (ChartMetrics [MyTree])
getTree cId _start _end tt lt = do
  p <- treeData cId (ngramsTypeFromTabType tt) lt
  pure (ChartMetrics p)