Commit a76b46a9 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-graph-screenshot

parents 35b8b782 b8d306d8
Pipeline #1021 failed with stage
...@@ -56,11 +56,10 @@ type ScatterAPI = Summary "SepGen IncExc metrics" ...@@ -56,11 +56,10 @@ type ScatterAPI = Summary "SepGen IncExc metrics"
:> QueryParamR "ngramsType" TabType :> QueryParamR "ngramsType" TabType
:> QueryParam "limit" Int :> QueryParam "limit" Int
:> Post '[JSON] () :> Post '[JSON] ()
:<|> "hash" :> :<|> "hash" :> Summary "Scatter Hash"
Summary "Scatter Hash" :> QueryParam "list" ListId
:> QueryParam "list" ListId :> QueryParamR "ngramsType" TabType
:> QueryParamR "ngramsType" TabType :> Get '[JSON] Text
:> Get '[JSON] Text
scatterApi :: NodeId -> GargServer ScatterAPI scatterApi :: NodeId -> GargServer ScatterAPI
scatterApi id' = getScatter id' scatterApi id' = getScatter id'
...@@ -138,22 +137,21 @@ type ChartApi = Summary " Chart API" ...@@ -138,22 +137,21 @@ type ChartApi = Summary " Chart API"
:> QueryParam "list" ListId :> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType :> QueryParamR "ngramsType" TabType
:> Get '[JSON] (HashedResponse (ChartMetrics Histo)) :> Get '[JSON] (HashedResponse (ChartMetrics Histo))
:<|> Summary "Chart update" :<|> Summary "Chart update"
:> QueryParam "list" ListId :> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType :> QueryParamR "ngramsType" TabType
:> QueryParam "limit" Int :> QueryParam "limit" Int
:> Post '[JSON] () :> Post '[JSON] ()
:<|> "hash" :> :<|> "hash" :> Summary "Chart Hash"
Summary "Chart Hash" :> QueryParam "list" ListId
:> QueryParam "list" ListId :> QueryParamR "ngramsType" TabType
:> QueryParamR "ngramsType" TabType :> Get '[JSON] Text
:> Get '[JSON] Text
chartApi :: NodeId -> GargServer ChartApi chartApi :: NodeId -> GargServer ChartApi
chartApi id' = getChart id' chartApi id' = getChart id'
:<|> updateChart id' :<|> updateChart id'
:<|> getChartHash id' :<|> getChartHash id'
-- TODO add start / end -- TODO add start / end
getChart :: FlowCmdM env err m => getChart :: FlowCmdM env err m =>
CorpusId CorpusId
...@@ -220,16 +218,15 @@ type PieApi = Summary "Pie Chart" ...@@ -220,16 +218,15 @@ type PieApi = Summary "Pie Chart"
:> QueryParam "list" ListId :> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType :> QueryParamR "ngramsType" TabType
:> Get '[JSON] (HashedResponse (ChartMetrics Histo)) :> Get '[JSON] (HashedResponse (ChartMetrics Histo))
:<|> Summary "Pie Chart update" :<|> Summary "Pie Chart update"
:> QueryParam "list" ListId :> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType :> QueryParamR "ngramsType" TabType
:> QueryParam "limit" Int :> QueryParam "limit" Int
:> Post '[JSON] () :> Post '[JSON] ()
:<|> "hash" :> :<|> "hash" :> Summary "Pie Hash"
Summary "Pie Hash" :> QueryParam "list" ListId
:> QueryParam "list" ListId :> QueryParamR "ngramsType" TabType
:> QueryParamR "ngramsType" TabType :> Get '[JSON] Text
:> Get '[JSON] Text
pieApi :: NodeId -> GargServer PieApi pieApi :: NodeId -> GargServer PieApi
pieApi id' = getPie id' pieApi id' = getPie id'
...@@ -280,7 +277,7 @@ updatePie' cId maybeListId tabType _maybeLimit = do ...@@ -280,7 +277,7 @@ updatePie' cId maybeListId tabType _maybeLimit = do
node <- getNodeWith listId (Proxy :: Proxy HyperdataList) node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let hl = node ^. node_hyperdata let hl = node ^. node_hyperdata
p <- pieData cId (ngramsTypeFromTabType tabType) MapTerm p <- chartData cId (ngramsTypeFromTabType tabType) MapTerm
_ <- updateHyperdata listId $ hl { _hl_pie = Just $ ChartMetrics p } _ <- updateHyperdata listId $ hl { _hl_pie = Just $ ChartMetrics p }
pure $ ChartMetrics p pure $ ChartMetrics p
......
...@@ -163,11 +163,11 @@ instance FromHttpApiData TabType ...@@ -163,11 +163,11 @@ instance FromHttpApiData TabType
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
instance ToSchema TabType instance ToSchema TabType
instance Arbitrary TabType instance Arbitrary TabType
where where
arbitrary = elements [minBound .. maxBound] arbitrary = elements [minBound .. maxBound]
......
...@@ -217,6 +217,7 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode ...@@ -217,6 +217,7 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
:<|> pairs id' :<|> pairs id'
:<|> getPair id' :<|> getPair id'
-- VIZ
:<|> scatterApi id' :<|> scatterApi id'
:<|> chartApi id' :<|> chartApi id'
:<|> pieApi id' :<|> pieApi id'
......
...@@ -219,7 +219,6 @@ flowCorpusUser l user corpusName ctype ids = do ...@@ -219,7 +219,6 @@ flowCorpusUser l user corpusName ctype ids = do
_ <- insertDefaultNode NodeDashboard userCorpusId userId _ <- insertDefaultNode NodeDashboard userCorpusId userId
_ <- insertDefaultNode NodeGraph userCorpusId userId _ <- insertDefaultNode NodeGraph userCorpusId userId
--_ <- mkPhylo userCorpusId userId --_ <- mkPhylo userCorpusId userId
-- Annuaire Flow -- Annuaire Flow
-- _ <- mkAnnuaire rootUserId userId -- _ <- mkAnnuaire rootUserId userId
pure userCorpusId pure userCorpusId
......
...@@ -49,8 +49,8 @@ tficf :: TficfContext Count Total ...@@ -49,8 +49,8 @@ tficf :: TficfContext Count Total
-> TFICF -> TFICF
tficf (TficfInfra (Count ic) (Total it) ) tficf (TficfInfra (Count ic) (Total it) )
(TficfSupra (Count sc) (Total st) ) (TficfSupra (Count sc) (Total st) )
| it >= ic && st >= sc && it <= st = (ic/it) / log (sc/st) | it >= ic && st >= sc {-&& it <= st-} = (ic/it) / log (sc/st)
| otherwise = panic $ "[ERR]" <> path <> " Frequency impossible" | otherwise = panic $ "[ERR]" <> path <>" Frequency impossible"
tficf _ _ = panic $ "[ERR]" <> path <> "Undefined for these contexts" tficf _ _ = panic $ "[ERR]" <> path <> "Undefined for these contexts"
......
...@@ -19,7 +19,6 @@ import Data.Map (toList) ...@@ -19,7 +19,6 @@ import Data.Map (toList)
import qualified Data.List as List import qualified Data.List as List
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Servant
import Gargantext.Core.Types.Main import Gargantext.Core.Types.Main
import Gargantext.Database.Admin.Config import Gargantext.Database.Admin.Config
...@@ -51,10 +50,10 @@ histoData cId = do ...@@ -51,10 +50,10 @@ histoData cId = do
pure (Histo ls css) pure (Histo ls css)
pieData :: FlowCmdM env err m chartData :: FlowCmdM env err m
=> CorpusId -> NgramsType -> ListType => CorpusId -> NgramsType -> ListType
-> m Histo -> m Histo
pieData cId nt lt = do chartData cId nt lt = do
ls' <- selectNodesWithUsername NodeList userMaster ls' <- selectNodesWithUsername NodeList userMaster
ls <- map (_node_id) <$> getListsWithParentId cId ls <- map (_node_id) <$> getListsWithParentId cId
ts <- mapTermListRoot ls nt <$> getRepo ts <- mapTermListRoot ls nt <$> getRepo
...@@ -71,8 +70,6 @@ pieData cId nt lt = do ...@@ -71,8 +70,6 @@ pieData cId nt lt = do
pure (Histo dates (map round count)) pure (Histo dates (map round count))
treeData :: FlowCmdM env err m treeData :: FlowCmdM env err m
=> CorpusId -> NgramsType -> ListType => CorpusId -> NgramsType -> ListType
-> m [MyTree] -> m [MyTree]
...@@ -80,32 +77,13 @@ treeData cId nt lt = do ...@@ -80,32 +77,13 @@ treeData cId nt lt = do
ls' <- selectNodesWithUsername NodeList userMaster ls' <- selectNodesWithUsername NodeList userMaster
ls <- map (_node_id) <$> getListsWithParentId cId ls <- map (_node_id) <$> getListsWithParentId cId
ts <- mapTermListRoot ls nt <$> getRepo ts <- mapTermListRoot ls nt <$> getRepo
let
dico = filterListWithRoot lt ts
terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
cs' <- getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
m <- getListNgrams ls nt
pure $ toTree lt cs' m
treeData' :: FlowCmdM env ServerError m
=> CorpusId -> NgramsType -> ListType
-> m [MyTree]
treeData' cId nt lt = do
ls' <- selectNodesWithUsername NodeList userMaster
ls <- map (_node_id) <$> getListsWithParentId cId
ts <- mapTermListRoot ls nt <$> getRepo
let let
dico = filterListWithRoot lt ts dico = filterListWithRoot lt ts
terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
cs' <- getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms cs' <- getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
m <- getListNgrams ls nt m <- getListNgrams ls nt
pure $ toTree lt cs' m pure $ toTree lt cs' m
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