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 TypeOperators      #-}
  17
  18 module Gargantext.API.Metrics
  19     where
  20
  21 import Control.Lens
  22 import Data.Time (UTCTime)
  23 import Protolude
  24 import Servant
  25 import qualified Data.Map as Map
  26
  27 import Gargantext.API.HashedResponse
  28 import Gargantext.API.Ngrams
  29 import Gargantext.API.Ngrams.NTree
  30 import Gargantext.API.Prelude (GargServer)
  31 import Gargantext.Core.Types (CorpusId, Limit, ListId, ListType(..))
  32 import Gargantext.Database.Action.Flow
  33 import qualified Gargantext.Database.Action.Metrics as Metrics
  34 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataList(..))
  35 import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metric(..), Metrics(..))
  36 import Gargantext.Database.Admin.Types.Node (NodeId)
  37 import Gargantext.Database.Query.Table.Node (defaultList, getNodeWith)
  38 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
  39 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
  40 import Gargantext.Database.Prelude
  41 import Gargantext.Database.Schema.Node (node_hyperdata)
  42 import Gargantext.Text.Metrics (Scored(..))
  43 import Gargantext.Viz.Chart
  44 import Gargantext.Viz.Types
  45
  46 -------------------------------------------------------------
  47 -- | Scatter metrics API
  48 type ScatterAPI = Summary "SepGen IncExc metrics"
  49                   :> QueryParam  "list"       ListId
  50                   :> QueryParamR "ngramsType" TabType
  51                   :> QueryParam  "limit"      Int
  52                   :> Get '[JSON] (HashedResponse Metrics)
  53               :<|> Summary "Scatter update"
  54                   :> QueryParam  "list"       ListId
  55                   :> QueryParamR "ngramsType" TabType
  56                   :> QueryParam  "limit"      Int
  57                   :> Post '[JSON] ()
  58               :<|> "md5" :>
  59                      Summary "Scatter MD5"
  60                   :> QueryParam  "list"       ListId
  61                   :> QueryParamR "ngramsType" TabType
  62                   :> Get '[JSON] Text
  63
  64 scatterApi :: NodeId -> GargServer ScatterAPI
  65 scatterApi id' = getScatter id'
  66             :<|> updateScatter id'
  67             :<|> getScatterMD5 id'
  68
  69 getScatter :: FlowCmdM env err m =>
  70   CorpusId
  71   -> Maybe ListId
  72   -> TabType
  73   -> Maybe Limit
  74   -> m (HashedResponse Metrics)
  75 getScatter cId maybeListId tabType _maybeLimit = do
  76   listId <- case maybeListId of
  77     Just lid -> pure lid
  78     Nothing  -> defaultList cId
  79   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
  80   let HyperdataList { hd_scatter = mChart } = node ^. node_hyperdata
  81
  82   chart <- case mChart of
  83     Just chart -> pure chart
  84     Nothing    -> do
  85       updateScatter' cId maybeListId tabType Nothing
  86
  87   pure $ constructHashedResponse chart
  88
  89 updateScatter :: FlowCmdM env err m =>
  90   CorpusId
  91   -> Maybe ListId
  92   -> TabType
  93   -> Maybe Limit
  94   -> m ()
  95 updateScatter cId maybeListId tabType maybeLimit = do
  96   _ <- updateScatter' cId maybeListId tabType maybeLimit
  97   pure ()
  98
  99 updateScatter' :: FlowCmdM env err m =>
 100   CorpusId
 101   -> Maybe ListId
 102   -> TabType
 103   -> Maybe Limit
 104   -> m Metrics
 105 updateScatter' cId maybeListId tabType maybeLimit = do
 106   (ngs', scores) <- Metrics.getMetrics cId maybeListId tabType maybeLimit
 107
 108   let
 109     metrics      = map (\(Scored t s1 s2) -> Metric t (log' 5 s1) (log' 2 s2) (listType t ngs')) scores
 110     log' n x     = 1 + (if x <= 0 then 0 else log $ (10^(n::Int)) * x)
 111     listType t m = maybe (panic errorMsg) fst $ Map.lookup t m
 112     errorMsg     = "API.Node.metrics: key absent"
 113
 114   listId <- case maybeListId of
 115     Just lid -> pure lid
 116     Nothing  -> defaultList cId
 117   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
 118   let HyperdataList { hd_chart = hdc
 119                     , hd_list = hdl
 120                     , hd_pie = hdp
 121                     , hd_tree = hdt } = node ^. node_hyperdata
 122   _ <- updateHyperdata listId $ HyperdataList hdc hdl hdp (Just $ Metrics metrics) hdt
 123
 124   pure $ Metrics metrics
 125
 126 getScatterMD5 :: FlowCmdM env err m =>
 127   CorpusId
 128   -> Maybe ListId
 129   -> TabType
 130   -> m Text
 131 getScatterMD5 cId maybeListId tabType = do
 132   HashedResponse { md5 = md5' } <- getScatter cId maybeListId tabType Nothing
 133   pure md5'
 134
 135
 136 -------------------------------------------------------------
 137 -- | Chart metrics API
 138 type ChartApi = Summary " Chart API"
 139               :> QueryParam "from" UTCTime
 140               :> QueryParam "to"   UTCTime
 141               :> QueryParam  "list"       ListId
 142               :> QueryParamR "ngramsType" TabType
 143               :> Get '[JSON] (HashedResponse (ChartMetrics Histo))
 144         :<|> Summary "Chart update"
 145                 :> QueryParam  "list"       ListId
 146                 :> QueryParamR "ngramsType" TabType
 147                 :> QueryParam  "limit"      Int
 148                 :> Post '[JSON] ()
 149               :<|> "md5" :>
 150                      Summary "Chart MD5"
 151                   :> QueryParam  "list"       ListId
 152                   :> QueryParamR "ngramsType" TabType
 153                   :> Get '[JSON] Text
 154
 155 chartApi :: NodeId -> GargServer ChartApi
 156 chartApi id' = getChart id'
 157           :<|> updateChart id'
 158           :<|> getChartMD5 id'
 159
 160 -- TODO add start / end
 161 getChart :: FlowCmdM env err m =>
 162             CorpusId
 163          -> Maybe UTCTime
 164          -> Maybe UTCTime
 165          -> Maybe ListId
 166          -> TabType
 167          -> m (HashedResponse (ChartMetrics Histo))
 168 getChart cId _start _end maybeListId tabType = do
 169   listId <- case maybeListId of
 170     Just lid -> pure lid
 171     Nothing  -> defaultList cId
 172   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
 173   let HyperdataList { hd_chart = mChart } = node ^. node_hyperdata
 174
 175   chart <- case mChart of
 176     Just chart -> pure chart
 177     Nothing    -> do
 178       updateChart' cId maybeListId tabType Nothing
 179
 180   pure $ constructHashedResponse chart
 181
 182 updateChart :: HasNodeError err =>
 183   CorpusId
 184   -> Maybe ListId
 185   -> TabType
 186   -> Maybe Limit
 187   -> Cmd err ()
 188 updateChart cId maybeListId tabType maybeLimit = do
 189   _ <- updateChart' cId maybeListId tabType maybeLimit
 190   pure ()
 191
 192 updateChart' :: HasNodeError err =>
 193   CorpusId
 194   -> Maybe ListId
 195   -> TabType
 196   -> Maybe Limit
 197   -> Cmd err (ChartMetrics Histo)
 198 updateChart' cId maybeListId _tabType _maybeLimit = do
 199   listId <- case maybeListId of
 200     Just lid -> pure lid
 201     Nothing  -> defaultList cId
 202   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
 203   let HyperdataList { hd_list = hdl
 204                     , hd_pie = hdp
 205                     , hd_scatter = hds
 206                     , hd_tree = hdt } = node ^. node_hyperdata
 207   h <- histoData cId
 208   _ <- updateHyperdata listId $ HyperdataList (Just $ ChartMetrics h) hdl hdp hds hdt
 209
 210   pure $ ChartMetrics h
 211
 212
 213 getChartMD5 :: FlowCmdM env err m =>
 214   CorpusId
 215   -> Maybe ListId
 216   -> TabType
 217   -> m Text
 218 getChartMD5 cId maybeListId tabType = do
 219   HashedResponse { md5 = md5' } <- getChart cId Nothing Nothing maybeListId tabType
 220   pure md5'
 221 -------------------------------------------------------------
 222 -- | Pie metrics API
 223 type PieApi = Summary "Pie Chart"
 224            :> QueryParam "from" UTCTime
 225            :> QueryParam "to"   UTCTime
 226            :> QueryParam  "list"       ListId
 227            :> QueryParamR "ngramsType" TabType
 228            :> Get '[JSON] (HashedResponse (ChartMetrics Histo))
 229         :<|> Summary "Pie Chart update"
 230                 :> QueryParam  "list"       ListId
 231                 :> QueryParamR "ngramsType" TabType
 232                 :> QueryParam  "limit"      Int
 233                 :> Post '[JSON] ()
 234               :<|> "md5" :>
 235                      Summary "Pie MD5"
 236                   :> QueryParam  "list"       ListId
 237                   :> QueryParamR "ngramsType" TabType
 238                   :> Get '[JSON] Text
 239
 240 pieApi :: NodeId -> GargServer PieApi
 241 pieApi id' = getPie id'
 242         :<|> updatePie id'
 243         :<|> getPieMD5 id'
 244
 245 getPie :: FlowCmdM env err m
 246        => CorpusId
 247        -> Maybe UTCTime
 248        -> Maybe UTCTime
 249        -> Maybe ListId
 250        -> TabType
 251        -> m (HashedResponse (ChartMetrics Histo))
 252 getPie cId _start _end maybeListId tabType = do
 253   listId <- case maybeListId of
 254     Just lid -> pure lid
 255     Nothing  -> defaultList cId
 256   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
 257   let HyperdataList { hd_pie = mChart } = node ^. node_hyperdata
 258
 259   chart <- case mChart of
 260     Just chart -> pure chart
 261     Nothing    -> do
 262       updatePie' cId maybeListId tabType Nothing
 263
 264   pure $ constructHashedResponse chart
 265
 266 updatePie :: FlowCmdM env err m =>
 267   CorpusId
 268   -> Maybe ListId
 269   -> TabType
 270   -> Maybe Limit
 271   -> m ()
 272 updatePie cId maybeListId tabType maybeLimit = do
 273   _ <- updatePie' cId maybeListId tabType maybeLimit
 274   pure ()
 275
 276 updatePie' :: FlowCmdM env err m =>
 277   CorpusId
 278   -> Maybe ListId
 279   -> TabType
 280   -> Maybe Limit
 281   -> m (ChartMetrics Histo)
 282 updatePie' cId maybeListId tabType _maybeLimit = do
 283   listId <- case maybeListId of
 284     Just lid -> pure lid
 285     Nothing  -> defaultList cId
 286   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
 287   let HyperdataList { hd_chart = hdc
 288                     , hd_list = hdl
 289                     , hd_scatter = hds
 290                     , hd_tree = hdt } = node ^. node_hyperdata
 291
 292   p <- pieData cId (ngramsTypeFromTabType tabType) MapTerm
 293   _ <- updateHyperdata listId $ HyperdataList hdc hdl (Just $ ChartMetrics p) hds hdt
 294
 295   pure $ ChartMetrics p
 296
 297 getPieMD5 :: FlowCmdM env err m =>
 298   CorpusId
 299   -> Maybe ListId
 300   -> TabType
 301   -> m Text
 302 getPieMD5 cId maybeListId tabType = do
 303   HashedResponse { md5 = md5' } <- getPie cId Nothing Nothing maybeListId tabType
 304   pure md5'
 305 -------------------------------------------------------------
 306 -- | Tree metrics API
 307
 308 type TreeApi = Summary " Tree API"
 309            :> QueryParam "from" UTCTime
 310            :> QueryParam "to"   UTCTime
 311            :> QueryParam  "list"       ListId
 312            :> QueryParamR "ngramsType" TabType
 313            :> QueryParamR "listType"   ListType
 314            :> Get '[JSON] (HashedResponse (ChartMetrics [MyTree]))
 315         :<|> Summary "Tree Chart update"
 316                 :> QueryParam  "list"       ListId
 317                 :> QueryParamR "ngramsType" TabType
 318                 :> QueryParamR "listType"   ListType
 319                 :> Post '[JSON] ()
 320           :<|> "md5" :>
 321                   Summary "Tree MD5"
 322               :> QueryParam  "list"       ListId
 323               :> QueryParamR "ngramsType" TabType
 324               :> QueryParamR "listType"   ListType
 325               :> Get '[JSON] Text
 326
 327                 -- Depending on the Type of the Node, we could post
 328                 -- New documents for a corpus
 329                 -- New map list terms
 330              -- :<|> "process"  :> MultipartForm MultipartData :> Post '[JSON] Text
 331
 332 treeApi :: NodeId -> GargServer TreeApi
 333 treeApi id' = getTree id'
 334          :<|> updateTree id'
 335          :<|> getTreeMD5 id'
 336
 337 getTree :: FlowCmdM env err m
 338         => CorpusId
 339         -> Maybe UTCTime
 340         -> Maybe UTCTime
 341         -> Maybe ListId
 342         -> TabType
 343         -> ListType
 344         -> m (HashedResponse (ChartMetrics [MyTree]))
 345 getTree cId _start _end maybeListId tabType listType = do
 346   listId <- case maybeListId of
 347     Just lid -> pure lid
 348     Nothing  -> defaultList cId
 349
 350   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
 351   let HyperdataList { hd_tree = mChart } = node ^. node_hyperdata
 352
 353   chart <- case mChart of
 354     Just chart -> pure chart
 355     Nothing    -> do
 356       updateTree' cId maybeListId tabType listType
 357
 358   pure $ constructHashedResponse chart
 359
 360 updateTree :: FlowCmdM env err m =>
 361   CorpusId
 362   -> Maybe ListId
 363   -> TabType
 364   -> ListType
 365   -> m ()
 366 updateTree cId maybeListId tabType listType = do
 367   _ <- updateTree' cId maybeListId tabType listType
 368   pure ()
 369
 370 updateTree' :: FlowCmdM env err m =>
 371   CorpusId
 372   -> Maybe ListId
 373   -> TabType
 374   -> ListType
 375   -> m (ChartMetrics [MyTree])
 376 updateTree' cId maybeListId tabType listType = do
 377   listId <- case maybeListId of
 378     Just lid -> pure lid
 379     Nothing  -> defaultList cId
 380
 381   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
 382   let HyperdataList { hd_chart = hdc
 383                     , hd_list = hdl
 384                     , hd_scatter = hds
 385                     , hd_pie = hdp } = node ^. node_hyperdata
 386   t <- treeData cId (ngramsTypeFromTabType tabType) listType
 387   _ <- updateHyperdata listId $ HyperdataList hdc hdl hdp hds (Just $ ChartMetrics t)
 388
 389   pure $ ChartMetrics t
 390
 391 getTreeMD5 :: FlowCmdM env err m =>
 392   CorpusId
 393   -> Maybe ListId
 394   -> TabType
 395   -> ListType
 396   -> m Text
 397 getTreeMD5 cId maybeListId tabType listType = do
 398   HashedResponse { md5 = md5' } <- getTree cId Nothing Nothing maybeListId tabType listType
 399   pure md5'