]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/Metrics.hs
Swagger fixes
[gargantext.git] / 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