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)
  37 import Gargantext.Prelude
  38 import Gargantext.API.Ngrams
  39 import Gargantext.API.Ngrams.NTree
  40 import Gargantext.Database.Flow
  41 import Gargantext.Viz.Chart
  42 import Test.QuickCheck (elements)
  43 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  44
  45 data Metrics = Metrics
  46   { metrics_data :: [Metric]}
  47   deriving (Generic, Show)
  48
  49 instance ToSchema Metrics
  50 instance Arbitrary Metrics
  51   where
  52     arbitrary = Metrics <$> arbitrary
  53
  54 data Metric = Metric
  55   { m_label :: !Text
  56   , m_x     :: !Double
  57   , m_y     :: !Double
  58   , m_cat   :: !ListType
  59   } deriving (Generic, Show)
  60
  61 instance ToSchema Metric
  62 instance Arbitrary Metric
  63   where
  64     arbitrary = Metric <$> arbitrary
  65                        <*> arbitrary
  66                        <*> arbitrary
  67                        <*> arbitrary
  68
  69 deriveJSON (unPrefix "metrics_") ''Metrics
  70 deriveJSON (unPrefix "m_") ''Metric
  71
  72 -------------------------------------------------------------
  73
  74 data ChartMetrics a = ChartMetrics { chartMetrics_data :: a }
  75   deriving (Generic, Show)
  76
  77 instance (ToSchema a) => ToSchema (ChartMetrics a)
  78 instance (Arbitrary a) => Arbitrary (ChartMetrics a)
  79   where
  80     arbitrary = ChartMetrics <$> arbitrary
  81
  82 deriveJSON (unPrefix "chartMetrics_") ''ChartMetrics
  83
  84 -------------------------------------------------------------
  85 instance ToSchema Histo
  86 instance Arbitrary Histo
  87   where
  88     arbitrary = elements [ Histo ["2012"] [1]
  89                          , Histo ["2013"] [1]
  90                          ]
  91 deriveJSON (unPrefix "histo_") ''Histo
  92
  93 instance ToSchema (TreeChartMetrics)
  94 instance Arbitrary (TreeChartMetrics)
  95   where
  96     arbitrary = TreeChartMetrics <$> arbitrary
  97
  98
  99 instance ToSchema MyTree
 100 instance Arbitrary MyTree
 101   where
 102     arbitrary = MyTree <$> arbitrary <*> arbitrary <*> arbitrary
 103
 104
 105
 106
 107
 108 -- TODO add start / end
 109 getChart :: CorpusId -> Maybe UTCTime -> Maybe UTCTime -> Cmd err (ChartMetrics Histo)
 110 getChart cId _start _end = do
 111   h <- histoData cId
 112   pure (ChartMetrics h)
 113
 114 getPie :: FlowCmdM env err m => CorpusId -> Maybe UTCTime -> Maybe UTCTime -> TabType -> m (ChartMetrics Histo)
 115 getPie cId _start _end tt = do
 116   p <- pieData cId (ngramsTypeFromTabType tt) GraphTerm
 117   pure (ChartMetrics p)
 118
 119 getTree :: FlowCmdM env err m => CorpusId -> Maybe UTCTime -> Maybe UTCTime -> TabType -> ListType -> m (ChartMetrics TreeChartMetrics)
 120 getTree cId _start _end tt lt = do
 121   p <- treeData cId (ngramsTypeFromTabType tt) lt
 122   pure (ChartMetrics p)
 123
 124
 125