Commit a893dd4c authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[list chart] some improvements to list charts

parent 19071e4b
...@@ -6,7 +6,9 @@ import qualified Data.Digest.Pure.MD5 as DPMD5 ...@@ -6,7 +6,9 @@ import qualified Data.Digest.Pure.MD5 as DPMD5
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Protolude import Protolude
data HashedResponse a = HashedResponse { md5 :: Text, value :: a } type MD5 = Text
data HashedResponse a = HashedResponse { md5 :: MD5, value :: a }
deriving (Generic) deriving (Generic)
instance ToSchema a => ToSchema (HashedResponse a) instance ToSchema a => ToSchema (HashedResponse a)
...@@ -16,4 +18,4 @@ instance ToJSON a => ToJSON (HashedResponse a) where ...@@ -16,4 +18,4 @@ instance ToJSON a => ToJSON (HashedResponse a) where
constructHashedResponse :: ToJSON a => a -> HashedResponse a constructHashedResponse :: ToJSON a => a -> HashedResponse a
constructHashedResponse v = HashedResponse { md5 = md5', value = v } constructHashedResponse v = HashedResponse { md5 = md5', value = v }
where where
md5' = show $ DPMD5.md5 $ encode v md5' = show $ DPMD5.md5 $ encode v
\ No newline at end of file
...@@ -59,7 +59,7 @@ type ScatterAPI = Summary "SepGen IncExc metrics" ...@@ -59,7 +59,7 @@ type ScatterAPI = Summary "SepGen IncExc metrics"
Summary "Scatter MD5" Summary "Scatter MD5"
:> QueryParam "list" ListId :> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType :> QueryParamR "ngramsType" TabType
:> Get '[JSON] Text :> Get '[JSON] MD5
scatterApi :: NodeId -> GargServer ScatterAPI scatterApi :: NodeId -> GargServer ScatterAPI
scatterApi id' = getScatter id' scatterApi id' = getScatter id'
...@@ -115,11 +115,8 @@ updateScatter' cId maybeListId tabType maybeLimit = do ...@@ -115,11 +115,8 @@ updateScatter' 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 { hd_chart = hdc let hl = node ^. node_hyperdata
, hd_list = hdl _ <- updateHyperdata listId $ hl { hd_scatter = Just $ Metrics metrics }
, hd_pie = hdp
, hd_tree = hdt } = node ^. node_hyperdata
_ <- updateHyperdata listId $ HyperdataList hdc hdl hdp (Just $ Metrics metrics) hdt
pure $ Metrics metrics pure $ Metrics metrics
...@@ -127,7 +124,7 @@ getScatterMD5 :: FlowCmdM env err m => ...@@ -127,7 +124,7 @@ getScatterMD5 :: FlowCmdM env err m =>
CorpusId CorpusId
-> Maybe ListId -> Maybe ListId
-> TabType -> TabType
-> m Text -> m MD5
getScatterMD5 cId maybeListId tabType = do getScatterMD5 cId maybeListId tabType = do
HashedResponse { md5 = md5' } <- getScatter cId maybeListId tabType Nothing HashedResponse { md5 = md5' } <- getScatter cId maybeListId tabType Nothing
pure md5' pure md5'
...@@ -150,7 +147,7 @@ type ChartApi = Summary " Chart API" ...@@ -150,7 +147,7 @@ type ChartApi = Summary " Chart API"
Summary "Chart MD5" Summary "Chart MD5"
:> QueryParam "list" ListId :> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType :> QueryParamR "ngramsType" TabType
:> Get '[JSON] Text :> Get '[JSON] MD5
chartApi :: NodeId -> GargServer ChartApi chartApi :: NodeId -> GargServer ChartApi
chartApi id' = getChart id' chartApi id' = getChart id'
...@@ -200,12 +197,9 @@ updateChart' cId maybeListId _tabType _maybeLimit = do ...@@ -200,12 +197,9 @@ updateChart' 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 { hd_list = hdl let hl = node ^. node_hyperdata
, hd_pie = hdp
, hd_scatter = hds
, hd_tree = hdt } = node ^. node_hyperdata
h <- histoData cId h <- histoData cId
_ <- updateHyperdata listId $ HyperdataList (Just $ ChartMetrics h) hdl hdp hds hdt _ <- updateHyperdata listId $ hl { hd_chart = Just $ ChartMetrics h }
pure $ ChartMetrics h pure $ ChartMetrics h
...@@ -214,7 +208,7 @@ getChartMD5 :: FlowCmdM env err m => ...@@ -214,7 +208,7 @@ getChartMD5 :: FlowCmdM env err m =>
CorpusId CorpusId
-> Maybe ListId -> Maybe ListId
-> TabType -> TabType
-> m Text -> m MD5
getChartMD5 cId maybeListId tabType = do getChartMD5 cId maybeListId tabType = do
HashedResponse { md5 = md5' } <- getChart cId Nothing Nothing maybeListId tabType HashedResponse { md5 = md5' } <- getChart cId Nothing Nothing maybeListId tabType
pure md5' pure md5'
...@@ -235,7 +229,7 @@ type PieApi = Summary "Pie Chart" ...@@ -235,7 +229,7 @@ type PieApi = Summary "Pie Chart"
Summary "Pie MD5" Summary "Pie MD5"
:> QueryParam "list" ListId :> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType :> QueryParamR "ngramsType" TabType
:> Get '[JSON] Text :> Get '[JSON] MD5
pieApi :: NodeId -> GargServer PieApi pieApi :: NodeId -> GargServer PieApi
pieApi id' = getPie id' pieApi id' = getPie id'
...@@ -284,13 +278,10 @@ updatePie' cId maybeListId tabType _maybeLimit = do ...@@ -284,13 +278,10 @@ updatePie' 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 { hd_chart = hdc let hl = node ^. node_hyperdata
, hd_list = hdl
, hd_scatter = hds
, hd_tree = hdt } = node ^. node_hyperdata
p <- pieData cId (ngramsTypeFromTabType tabType) MapTerm p <- pieData cId (ngramsTypeFromTabType tabType) MapTerm
_ <- updateHyperdata listId $ HyperdataList hdc hdl (Just $ ChartMetrics p) hds hdt _ <- updateHyperdata listId $ hl { hd_pie = Just $ ChartMetrics p }
pure $ ChartMetrics p pure $ ChartMetrics p
...@@ -298,7 +289,7 @@ getPieMD5 :: FlowCmdM env err m => ...@@ -298,7 +289,7 @@ getPieMD5 :: FlowCmdM env err m =>
CorpusId CorpusId
-> Maybe ListId -> Maybe ListId
-> TabType -> TabType
-> m Text -> m MD5
getPieMD5 cId maybeListId tabType = do getPieMD5 cId maybeListId tabType = do
HashedResponse { md5 = md5' } <- getPie cId Nothing Nothing maybeListId tabType HashedResponse { md5 = md5' } <- getPie cId Nothing Nothing maybeListId tabType
pure md5' pure md5'
...@@ -322,7 +313,7 @@ type TreeApi = Summary " Tree API" ...@@ -322,7 +313,7 @@ type TreeApi = Summary " Tree API"
:> QueryParam "list" ListId :> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType :> QueryParamR "ngramsType" TabType
:> QueryParamR "listType" ListType :> QueryParamR "listType" ListType
:> Get '[JSON] Text :> Get '[JSON] MD5
-- Depending on the Type of the Node, we could post -- Depending on the Type of the Node, we could post
-- New documents for a corpus -- New documents for a corpus
...@@ -379,12 +370,9 @@ updateTree' cId maybeListId tabType listType = do ...@@ -379,12 +370,9 @@ updateTree' cId maybeListId tabType listType = do
Nothing -> defaultList cId Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList) node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let HyperdataList { hd_chart = hdc let hl = node ^. node_hyperdata
, hd_list = hdl
, hd_scatter = hds
, hd_pie = hdp } = node ^. node_hyperdata
t <- treeData cId (ngramsTypeFromTabType tabType) listType t <- treeData cId (ngramsTypeFromTabType tabType) listType
_ <- updateHyperdata listId $ HyperdataList hdc hdl hdp hds (Just $ ChartMetrics t) _ <- updateHyperdata listId $ hl { hd_tree = Just $ ChartMetrics t }
pure $ ChartMetrics t pure $ ChartMetrics t
...@@ -393,7 +381,7 @@ getTreeMD5 :: FlowCmdM env err m => ...@@ -393,7 +381,7 @@ getTreeMD5 :: FlowCmdM env err m =>
-> Maybe ListId -> Maybe ListId
-> TabType -> TabType
-> ListType -> ListType
-> m Text -> m MD5
getTreeMD5 cId maybeListId tabType listType = do getTreeMD5 cId maybeListId tabType listType = do
HashedResponse { md5 = md5' } <- getTree cId Nothing Nothing maybeListId tabType listType HashedResponse { md5 = md5' } <- getTree cId Nothing Nothing maybeListId tabType listType
pure md5' pure md5'
\ No newline at end of file
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