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
  94 instance ToSchema MyTree
  95 instance Arbitrary MyTree
  96   where
  97     arbitrary = MyTree <$> arbitrary <*> arbitrary <*> arbitrary
  98
  99
 100
 101
 102
 103 -- TODO add start / end
 104 getChart :: CorpusId -> Maybe UTCTime -> Maybe UTCTime -> Cmd err (ChartMetrics Histo)
 105 getChart cId _start _end = do
 106   h <- histoData cId
 107   pure (ChartMetrics h)
 108
 109 getPie :: FlowCmdM env err m => CorpusId -> Maybe UTCTime -> Maybe UTCTime -> TabType -> m (ChartMetrics Histo)
 110 getPie cId _start _end tt = do
 111   p <- pieData cId (ngramsTypeFromTabType tt) GraphTerm
 112   pure (ChartMetrics p)
 113
 114 getTree :: FlowCmdM env err m => CorpusId -> Maybe UTCTime -> Maybe UTCTime -> TabType -> ListType -> m (ChartMetrics [MyTree])
 115 getTree cId _start _end tt lt = do
 116   p <- treeData cId (ngramsTypeFromTabType tt) lt
 117   pure (ChartMetrics p)
 118
 119
 120