Commit d86ab2a1 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[charts] fix HyperdataList so that charts are per tabType

parent 994c72a7
Pipeline #1114 failed with stage
...@@ -20,8 +20,8 @@ module Gargantext.API.Metrics ...@@ -20,8 +20,8 @@ module Gargantext.API.Metrics
import Control.Lens import Control.Lens
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Time (UTCTime)
import Data.Text (Text) import Data.Text (Text)
import Data.Time (UTCTime)
import Servant import Servant
import Gargantext.API.HashedResponse import Gargantext.API.HashedResponse
...@@ -30,7 +30,7 @@ import Gargantext.API.Ngrams.Types ...@@ -30,7 +30,7 @@ import Gargantext.API.Ngrams.Types
import Gargantext.API.Prelude (GargServer) import Gargantext.API.Prelude (GargServer)
import Gargantext.Core.Types (CorpusId, Limit, ListId, ListType(..)) import Gargantext.Core.Types (CorpusId, Limit, ListId, ListType(..))
import Gargantext.Database.Action.Flow import Gargantext.Database.Action.Flow
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataList(..)) import Gargantext.Database.Admin.Types.Hyperdata (HyperdataList(..), hl_chart, hl_pie, hl_scatter, hl_tree)
import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metric(..), Metrics(..)) import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metric(..), Metrics(..))
import Gargantext.Database.Admin.Types.Node (NodeId) import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Database.Prelude import Gargantext.Database.Prelude
...@@ -77,7 +77,8 @@ getScatter cId maybeListId tabType _maybeLimit = do ...@@ -77,7 +77,8 @@ getScatter cId maybeListId tabType _maybeLimit = do
Just lid -> pure lid Just lid -> pure lid
Nothing -> defaultList cId Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList) node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let HyperdataList { _hl_scatter = mChart } = node ^. node_hyperdata let HyperdataList { _hl_scatter = scatterMap } = node ^. node_hyperdata
mChart = Map.lookup tabType scatterMap
chart <- case mChart of chart <- case mChart of
Just chart -> pure chart Just chart -> pure chart
...@@ -120,7 +121,8 @@ updateScatter' cId maybeListId tabType maybeLimit = do ...@@ -120,7 +121,8 @@ updateScatter' cId maybeListId tabType maybeLimit = do
Nothing -> defaultList cId Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList) node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let hl = node ^. node_hyperdata let hl = node ^. node_hyperdata
_ <- updateHyperdata listId $ hl { _hl_scatter = Just $ Metrics metrics } scatterMap = hl ^. hl_scatter
_ <- updateHyperdata listId $ hl { _hl_scatter = Map.insert tabType (Metrics metrics) scatterMap }
pure $ Metrics metrics pure $ Metrics metrics
...@@ -169,7 +171,8 @@ getChart cId _start _end maybeListId tabType = do ...@@ -169,7 +171,8 @@ getChart cId _start _end maybeListId tabType = do
Just lid -> pure lid Just lid -> pure lid
Nothing -> defaultList cId Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList) node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let HyperdataList { _hl_chart = mChart } = node ^. node_hyperdata let HyperdataList { _hl_chart = chartMap } = node ^. node_hyperdata
mChart = Map.lookup tabType chartMap
chart <- case mChart of chart <- case mChart of
Just chart -> pure chart Just chart -> pure chart
...@@ -198,14 +201,15 @@ updateChart' :: HasNodeError err => ...@@ -198,14 +201,15 @@ updateChart' :: HasNodeError err =>
-> TabType -> TabType
-> Maybe Limit -> Maybe Limit
-> Cmd err (ChartMetrics Histo) -> Cmd err (ChartMetrics Histo)
updateChart' cId maybeListId _tabType _maybeLimit = do updateChart' cId maybeListId tabType _maybeLimit = do
listId <- case maybeListId of listId <- case maybeListId of
Just lid -> pure lid Just lid -> pure lid
Nothing -> defaultList cId Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList) node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let hl = node ^. node_hyperdata let hl = node ^. node_hyperdata
chartMap = hl ^. hl_chart
h <- histoData cId h <- histoData cId
_ <- updateHyperdata listId $ hl { _hl_chart = Just $ ChartMetrics h } _ <- updateHyperdata listId $ hl { _hl_chart = Map.insert tabType (ChartMetrics h) chartMap }
pure $ ChartMetrics h pure $ ChartMetrics h
...@@ -253,7 +257,8 @@ getPie cId _start _end maybeListId tabType = do ...@@ -253,7 +257,8 @@ getPie cId _start _end maybeListId tabType = do
Just lid -> pure lid Just lid -> pure lid
Nothing -> defaultList cId Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList) node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let HyperdataList { _hl_pie = mChart } = node ^. node_hyperdata let HyperdataList { _hl_pie = pieMap } = node ^. node_hyperdata
mChart = Map.lookup tabType pieMap
chart <- case mChart of chart <- case mChart of
Just chart -> pure chart Just chart -> pure chart
...@@ -288,9 +293,10 @@ updatePie' cId maybeListId tabType _maybeLimit = do ...@@ -288,9 +293,10 @@ updatePie' cId maybeListId tabType _maybeLimit = do
Nothing -> defaultList cId Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList) node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let hl = node ^. node_hyperdata let hl = node ^. node_hyperdata
pieMap = hl ^. hl_pie
p <- chartData cId (ngramsTypeFromTabType tabType) MapTerm p <- chartData cId (ngramsTypeFromTabType tabType) MapTerm
_ <- updateHyperdata listId $ hl { _hl_pie = Just $ ChartMetrics p } _ <- updateHyperdata listId $ hl { _hl_pie = Map.insert tabType (ChartMetrics p) pieMap }
pure $ ChartMetrics p pure $ ChartMetrics p
...@@ -348,7 +354,8 @@ getTree cId _start _end maybeListId tabType listType = do ...@@ -348,7 +354,8 @@ getTree cId _start _end maybeListId tabType listType = do
Nothing -> defaultList cId Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList) node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let HyperdataList { _hl_tree = mChart } = node ^. node_hyperdata let HyperdataList { _hl_tree = treeMap } = node ^. node_hyperdata
mChart = Map.lookup tabType treeMap
chart <- case mChart of chart <- case mChart of
Just chart -> pure chart Just chart -> pure chart
...@@ -384,8 +391,9 @@ updateTree' cId maybeListId tabType listType = do ...@@ -384,8 +391,9 @@ updateTree' cId maybeListId tabType listType = do
node <- getNodeWith listId (Proxy :: Proxy HyperdataList) node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let hl = node ^. node_hyperdata let hl = node ^. node_hyperdata
treeMap = hl ^. hl_tree
t <- treeData cId (ngramsTypeFromTabType tabType) listType t <- treeData cId (ngramsTypeFromTabType tabType) listType
_ <- updateHyperdata listId $ hl { _hl_tree = Just $ ChartMetrics t } _ <- updateHyperdata listId $ hl { _hl_tree = Map.insert tabType (ChartMetrics t) treeMap }
pure $ ChartMetrics t pure $ ChartMetrics t
......
...@@ -59,7 +59,7 @@ import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams ...@@ -59,7 +59,7 @@ import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
data TabType = Docs | Trash | MoreFav | MoreTrash data TabType = Docs | Trash | MoreFav | MoreTrash
| Terms | Sources | Authors | Institutes | Terms | Sources | Authors | Institutes
| Contacts | Contacts
deriving (Generic, Enum, Bounded, Show) deriving (Bounded, Enum, Eq, Generic, Ord, Show)
instance FromHttpApiData TabType instance FromHttpApiData TabType
where where
...@@ -76,7 +76,6 @@ instance FromHttpApiData TabType ...@@ -76,7 +76,6 @@ instance FromHttpApiData TabType
parseUrlPiece "Contacts" = pure Contacts parseUrlPiece "Contacts" = pure Contacts
parseUrlPiece _ = Left "Unexpected value of TabType" parseUrlPiece _ = Left "Unexpected value of TabType"
instance ToParamSchema TabType instance ToParamSchema TabType
instance ToJSON TabType instance ToJSON TabType
instance FromJSON TabType instance FromJSON TabType
...@@ -84,6 +83,10 @@ instance ToSchema TabType ...@@ -84,6 +83,10 @@ instance ToSchema TabType
instance Arbitrary TabType instance Arbitrary TabType
where where
arbitrary = elements [minBound .. maxBound] arbitrary = elements [minBound .. maxBound]
instance FromJSONKey TabType where
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
instance ToJSONKey TabType where
toJSONKey = genericToJSONKey defaultJSONKeyOptions
newtype MSet a = MSet (Map a ()) newtype MSet a = MSet (Map a ())
deriving (Eq, Ord, Show, Generic, Arbitrary, Semigroup, Monoid) deriving (Eq, Ord, Show, Generic, Arbitrary, Semigroup, Monoid)
......
...@@ -21,23 +21,39 @@ Portability : POSIX ...@@ -21,23 +21,39 @@ Portability : POSIX
module Gargantext.Database.Admin.Types.Hyperdata.List module Gargantext.Database.Admin.Types.Hyperdata.List
where where
import Data.Map (Map)
import qualified Data.Map as Map
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core.Viz.Types (Histo(..)) import Gargantext.Core.Viz.Types (Histo(..))
import Gargantext.API.Ngrams.NTree (MyTree) import Gargantext.API.Ngrams.NTree (MyTree)
import Gargantext.API.Ngrams.Types (TabType)
import Gargantext.Database.Admin.Types.Hyperdata.Prelude import Gargantext.Database.Admin.Types.Hyperdata.Prelude
import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metrics) import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metrics)
------------------------------------------------------------------------ ------------------------------------------------------------------------
data HyperdataList = data HyperdataList =
HyperdataList { _hl_chart :: !(Maybe (ChartMetrics Histo)) HyperdataList { _hl_chart :: !(Map TabType (ChartMetrics Histo))
, _hl_list :: !(Maybe Text) , _hl_list :: !(Maybe Text)
, _hl_pie :: !(Maybe (ChartMetrics Histo)) , _hl_pie :: !(Map TabType (ChartMetrics Histo))
, _hl_scatter :: !(Maybe Metrics) , _hl_scatter :: !(Map TabType Metrics)
, _hl_tree :: !(Maybe (ChartMetrics [MyTree])) , _hl_tree :: !(Map TabType (ChartMetrics [MyTree]))
} deriving (Show, Generic) } deriving (Show, Generic)
-- HyperdataList { _hl_chart :: !(Maybe (ChartMetrics Histo))
-- , _hl_list :: !(Maybe Text)
-- , _hl_pie :: !(Maybe (ChartMetrics Histo))
-- , _hl_scatter :: !(Maybe Metrics)
-- , _hl_tree :: !(Maybe (ChartMetrics [MyTree]))
-- } deriving (Show, Generic)
defaultHyperdataList :: HyperdataList defaultHyperdataList :: HyperdataList
defaultHyperdataList = HyperdataList Nothing Nothing Nothing Nothing Nothing defaultHyperdataList = HyperdataList {
_hl_chart = Map.empty
, _hl_list = Nothing
, _hl_pie = Map.empty
, _hl_scatter = Map.empty
, _hl_tree = Map.empty
}
data HyperdataListCooc = data HyperdataListCooc =
HyperdataListCooc { _hlc_preferences :: !Text } HyperdataListCooc { _hlc_preferences :: !Text }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment