src/Gargantext/API/Metrics.hs

   1 {-|
   2 Module      : Gargantext.API.Metrics
   3 Description : Server API
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Metrics API
  11
  12 -}
  13
  14 {-# OPTIONS_GHC -fno-warn-orphans #-}
  15
  16 {-# LANGUAGE DataKinds          #-}
  17 {-# LANGUAGE DeriveGeneric      #-}
  18 {-# LANGUAGE FlexibleContexts   #-}
  19 {-# LANGUAGE NoImplicitPrelude  #-}
  20 {-# LANGUAGE OverloadedStrings  #-}
  21 {-# LANGUAGE RankNTypes         #-}
  22 {-# LANGUAGE TemplateHaskell    #-}
  23 {-# LANGUAGE TypeOperators      #-}
  24
  25 module Gargantext.API.Metrics
  26     where
  27
  28 import Data.Aeson.TH (deriveJSON)
  29 import Data.Swagger
  30 import Data.Text (Text)
  31 import Data.Time (UTCTime)
  32 import GHC.Generics (Generic)
  33 import Servant
  34 import Test.QuickCheck (elements)
  35 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  36 import qualified Data.Map as Map
  37
  38 import qualified Gargantext.Database.Action.Metrics as Metrics
  39 import Gargantext.API.Ngrams
  40 import Gargantext.API.Ngrams.NTree
  41 import Gargantext.Core.Types (CorpusId, ListId, Limit)
  42 import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..))
  43 import Gargantext.Core.Types (ListType(..))
  44 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
  45 import Gargantext.Database.Action.Flow
  46 import Gargantext.Database.Prelude
  47 import Gargantext.Prelude
  48 import Gargantext.Text.Metrics (Scored(..))
  49 import Gargantext.Viz.Chart
  50
  51 -------------------------------------------------------------
  52 instance ToSchema Histo where
  53   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "histo_")
  54 instance Arbitrary Histo
  55   where
  56     arbitrary = elements [ Histo ["2012"] [1]
  57                          , Histo ["2013"] [1]
  58                          ]
  59 deriveJSON (unPrefix "histo_") ''Histo
  60
  61
  62
  63 -------------------------------------------------------------
  64 -- | Scatter metrics API
  65 type ScatterAPI = Summary "SepGen IncExc metrics"
  66                 :> QueryParam  "list"       ListId
  67                 :> QueryParamR "ngramsType" TabType
  68                 :> QueryParam  "limit"      Int
  69                 :> Get '[JSON] Metrics
  70
  71 getScatter :: FlowCmdM env err m =>
  72   CorpusId
  73   -> Maybe ListId
  74   -> TabType
  75   -> Maybe Limit
  76   -> m Metrics
  77 getScatter cId maybeListId tabType maybeLimit = do
  78   (ngs', scores) <- Metrics.getMetrics cId maybeListId tabType maybeLimit
  79
  80   let
  81     metrics      = map (\(Scored t s1 s2) -> Metric t (log' 5 s1) (log' 2 s2) (listType t ngs')) scores
  82     log' n x     = 1 + (if x <= 0 then 0 else (log $ (10^(n::Int)) * x))
  83     listType t m = maybe (panic errorMsg) fst $ Map.lookup t m
  84     errorMsg     = "API.Node.metrics: key absent"
  85
  86   pure $ Metrics metrics
  87
  88
  89
  90 -- TODO add start / end
  91 getChart :: CorpusId -> Maybe UTCTime -> Maybe UTCTime -> Cmd err (ChartMetrics Histo)
  92 getChart cId _start _end = do
  93   h <- histoData cId
  94   pure (ChartMetrics h)
  95
  96 getPie :: FlowCmdM env err m => CorpusId -> Maybe UTCTime -> Maybe UTCTime -> TabType -> m (ChartMetrics Histo)
  97 getPie cId _start _end tt = do
  98   p <- pieData cId (ngramsTypeFromTabType tt) GraphTerm
  99   pure (ChartMetrics p)
 100
 101 getTree :: FlowCmdM env err m => CorpusId -> Maybe UTCTime -> Maybe UTCTime -> TabType -> ListType -> m (ChartMetrics [MyTree])
 102 getTree cId _start _end tt lt = do
 103   p <- treeData cId (ngramsTypeFromTabType tt) lt
 104   pure (ChartMetrics p)
 105
 106
 107