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.Time (UTCTime)
  31 import Data.Text (Text)
  32 import GHC.Generics (Generic)
  33 import Gargantext.Core.Types (ListType(..))
  34 import Gargantext.Core.Utils.Prefix (unPrefix)
  35 import Gargantext.Database.Utils
  36 import Gargantext.Core.Types (CorpusId, ListId, Limit)
  37 import Gargantext.Prelude
  38 import Gargantext.API.Ngrams
  39 import Gargantext.Text.Metrics (Scored(..))
  40 import Gargantext.API.Ngrams.NTree
  41 import Gargantext.Database.Flow
  42 import Gargantext.Viz.Chart
  43 import Servant
  44 import Test.QuickCheck (elements)
  45 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  46 import qualified Data.Map as Map
  47 import qualified Gargantext.Database.Metrics as Metrics
  48
  49 data Metrics = Metrics
  50   { metrics_data :: [Metric]}
  51   deriving (Generic, Show)
  52
  53 instance ToSchema Metrics
  54 instance Arbitrary Metrics
  55   where
  56     arbitrary = Metrics <$> arbitrary
  57
  58 data Metric = Metric
  59   { m_label :: !Text
  60   , m_x     :: !Double
  61   , m_y     :: !Double
  62   , m_cat   :: !ListType
  63   } deriving (Generic, Show)
  64
  65 instance ToSchema Metric
  66 instance Arbitrary Metric
  67   where
  68     arbitrary = Metric <$> arbitrary
  69                        <*> arbitrary
  70                        <*> arbitrary
  71                        <*> arbitrary
  72
  73 deriveJSON (unPrefix "metrics_") ''Metrics
  74 deriveJSON (unPrefix "m_") ''Metric
  75
  76 -------------------------------------------------------------
  77
  78 data ChartMetrics a = ChartMetrics { chartMetrics_data :: a }
  79   deriving (Generic, Show)
  80
  81 instance (ToSchema a) => ToSchema (ChartMetrics a)
  82 instance (Arbitrary a) => Arbitrary (ChartMetrics a)
  83   where
  84     arbitrary = ChartMetrics <$> arbitrary
  85
  86 deriveJSON (unPrefix "chartMetrics_") ''ChartMetrics
  87
  88 -------------------------------------------------------------
  89 instance ToSchema Histo
  90 instance Arbitrary Histo
  91   where
  92     arbitrary = elements [ Histo ["2012"] [1]
  93                          , Histo ["2013"] [1]
  94                          ]
  95 deriveJSON (unPrefix "histo_") ''Histo
  96
  97
  98 instance ToSchema MyTree
  99 instance Arbitrary MyTree
 100   where
 101     arbitrary = MyTree <$> arbitrary <*> arbitrary <*> arbitrary
 102
 103
 104 -------------------------------------------------------------
 105 -- | Scatter metrics API
 106 type ScatterAPI = Summary "SepGen IncExc metrics"
 107                 :> QueryParam  "list"       ListId
 108                 :> QueryParamR "ngramsType" TabType
 109                 :> QueryParam  "limit"      Int
 110                 :> Get '[JSON] Metrics
 111
 112 getScatter :: FlowCmdM env err m =>
 113   CorpusId
 114   -> Maybe ListId
 115   -> TabType
 116   -> Maybe Limit
 117   -> m Metrics
 118 getScatter cId maybeListId tabType maybeLimit = do
 119   (ngs', scores) <- Metrics.getMetrics cId maybeListId tabType maybeLimit
 120
 121   let
 122     metrics      = map (\(Scored t s1 s2) -> Metric t (log' 5 s1) (log' 2 s2) (listType t ngs')) scores
 123     log' n x     = 1 + (if x <= 0 then 0 else (log $ (10^(n::Int)) * x))
 124     listType t m = maybe (panic errorMsg) fst $ Map.lookup t m
 125     errorMsg     = "API.Node.metrics: key absent"
 126
 127   pure $ Metrics metrics
 128
 129
 130
 131 -- TODO add start / end
 132 getChart :: CorpusId -> Maybe UTCTime -> Maybe UTCTime -> Cmd err (ChartMetrics Histo)
 133 getChart cId _start _end = do
 134   h <- histoData cId
 135   pure (ChartMetrics h)
 136
 137 getPie :: FlowCmdM env err m => CorpusId -> Maybe UTCTime -> Maybe UTCTime -> TabType -> m (ChartMetrics Histo)
 138 getPie cId _start _end tt = do
 139   p <- pieData cId (ngramsTypeFromTabType tt) GraphTerm
 140   pure (ChartMetrics p)
 141
 142 getTree :: FlowCmdM env err m => CorpusId -> Maybe UTCTime -> Maybe UTCTime -> TabType -> ListType -> m (ChartMetrics [MyTree])
 143 getTree cId _start _end tt lt = do
 144   p <- treeData cId (ngramsTypeFromTabType tt) lt
 145   pure (ChartMetrics p)
 146
 147
 148