Commit bea2c142 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-ngrams-table-online' of...

Merge branch 'dev-ngrams-table-online' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell-gargantext into dev-merge
parents fce6da2e 55e12934
Pipeline #1381 failed with stage
...@@ -78,6 +78,7 @@ module Gargantext.API.Ngrams ...@@ -78,6 +78,7 @@ module Gargantext.API.Ngrams
, Version , Version
, Versioned(..) , Versioned(..)
, VersionedWithCount(..)
, currentVersion , currentVersion
, listNgramsChangedSince , listNgramsChangedSince
) )
...@@ -487,7 +488,7 @@ getTableNgrams :: forall env err m. ...@@ -487,7 +488,7 @@ getTableNgrams :: forall env err m.
-> Maybe MinSize -> Maybe MaxSize -> Maybe MinSize -> Maybe MaxSize
-> Maybe OrderBy -> Maybe OrderBy
-> (NgramsTerm -> Bool) -> (NgramsTerm -> Bool)
-> m (Versioned NgramsTable) -> m (VersionedWithCount NgramsTable)
getTableNgrams _nType nId tabType listId limit_ offset getTableNgrams _nType nId tabType listId limit_ offset
listType minSize maxSize orderBy searchQuery = do listType minSize maxSize orderBy searchQuery = do
...@@ -516,6 +517,15 @@ getTableNgrams _nType nId tabType listId limit_ offset ...@@ -516,6 +517,15 @@ getTableNgrams _nType nId tabType listId limit_ offset
sortOnOrder (Just ScoreAsc) = List.sortOn $ view ne_occurrences sortOnOrder (Just ScoreAsc) = List.sortOn $ view ne_occurrences
sortOnOrder (Just ScoreDesc) = List.sortOn $ Down . view ne_occurrences sortOnOrder (Just ScoreDesc) = List.sortOn $ Down . view ne_occurrences
---------------------------------------
filteredNodes :: Map NgramsTerm NgramsElement -> [NgramsElement]
filteredNodes tableMap = rootOf <$> list & filter selected_node
where
rootOf ne = maybe ne (\r -> fromMaybe (panic "getTableNgrams: invalid root") (tableMap ^. at r))
(ne ^. ne_root)
list = tableMap ^.. each
--------------------------------------- ---------------------------------------
selectAndPaginate :: Map NgramsTerm NgramsElement -> [NgramsElement] selectAndPaginate :: Map NgramsTerm NgramsElement -> [NgramsElement]
selectAndPaginate tableMap = roots <> inners selectAndPaginate tableMap = roots <> inners
...@@ -561,11 +571,17 @@ getTableNgrams _nType nId tabType listId limit_ offset ...@@ -561,11 +571,17 @@ getTableNgrams _nType nId tabType listId limit_ offset
-- trace (show lists) $ -- trace (show lists) $
-- getNgramsTableMap ({-lists <>-} listIds) ngramsType -- getNgramsTableMap ({-lists <>-} listIds) ngramsType
let scoresNeeded = needsScores orderBy let scoresNeeded = needsScores orderBy
tableMap1 <- getNgramsTableMap listId ngramsType tableMap1 <- getNgramsTableMap listId ngramsType
t1 <- getTime' t1 <- getTime'
tableMap2 <- tableMap1 & v_data %%~ setScores scoresNeeded tableMap2 <- tableMap1 & v_data %%~ setScores scoresNeeded
. Map.mapWithKey ngramsElementFromRepo . Map.mapWithKey ngramsElementFromRepo
fltr <- tableMap2 & v_data %%~ fmap NgramsTable . setScores (not scoresNeeded)
. filteredNodes
let fltrCount = length $ fltr ^. v_data . _NgramsTable
t2 <- getTime' t2 <- getTime'
tableMap3 <- tableMap2 & v_data %%~ fmap NgramsTable tableMap3 <- tableMap2 & v_data %%~ fmap NgramsTable
. setScores (not scoresNeeded) . setScores (not scoresNeeded)
...@@ -579,7 +595,7 @@ getTableNgrams _nType nId tabType listId limit_ offset ...@@ -579,7 +595,7 @@ getTableNgrams _nType nId tabType listId limit_ offset
% " sql=" % (if scoresNeeded then "map2" else "map3") % " sql=" % (if scoresNeeded then "map2" else "map3")
% "\n" % "\n"
) t0 t3 t0 t1 t1 t2 t2 t3 ) t0 t3 t0 t1 t1 t2 t2 t3
pure tableMap3 pure $ toVersionedWithCount fltrCount tableMap3
scoresRecomputeTableNgrams :: forall env err m. (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env) => NodeId -> TabType -> ListId -> m Int scoresRecomputeTableNgrams :: forall env err m. (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env) => NodeId -> TabType -> ListId -> m Int
...@@ -645,7 +661,7 @@ type TableNgramsApiGet = Summary " Table Ngrams API Get" ...@@ -645,7 +661,7 @@ type TableNgramsApiGet = Summary " Table Ngrams API Get"
:> QueryParam "maxTermSize" MaxSize :> QueryParam "maxTermSize" MaxSize
:> QueryParam "orderBy" OrderBy :> QueryParam "orderBy" OrderBy
:> QueryParam "search" Text :> QueryParam "search" Text
:> Get '[JSON] (Versioned NgramsTable) :> Get '[JSON] (VersionedWithCount NgramsTable)
type TableNgramsApiPut = Summary " Table Ngrams API Change" type TableNgramsApiPut = Summary " Table Ngrams API Change"
:> QueryParamR "ngramsType" TabType :> QueryParamR "ngramsType" TabType
...@@ -685,7 +701,7 @@ getTableNgramsCorpus :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool ...@@ -685,7 +701,7 @@ getTableNgramsCorpus :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool
-> Maybe MinSize -> Maybe MaxSize -> Maybe MinSize -> Maybe MaxSize
-> Maybe OrderBy -> Maybe OrderBy
-> Maybe Text -- full text search -> Maybe Text -- full text search
-> m (Versioned NgramsTable) -> m (VersionedWithCount NgramsTable)
getTableNgramsCorpus nId tabType listId limit_ offset listType minSize maxSize orderBy mt = getTableNgramsCorpus nId tabType listId limit_ offset listType minSize maxSize orderBy mt =
getTableNgrams NodeCorpus nId tabType listId limit_ offset listType minSize maxSize orderBy searchQuery getTableNgrams NodeCorpus nId tabType listId limit_ offset listType minSize maxSize orderBy searchQuery
where where
...@@ -711,7 +727,7 @@ getTableNgramsDoc :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool en ...@@ -711,7 +727,7 @@ getTableNgramsDoc :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool en
-> Maybe MinSize -> Maybe MaxSize -> Maybe MinSize -> Maybe MaxSize
-> Maybe OrderBy -> Maybe OrderBy
-> Maybe Text -- full text search -> Maybe Text -- full text search
-> m (Versioned NgramsTable) -> m (VersionedWithCount NgramsTable)
getTableNgramsDoc dId tabType listId limit_ offset listType minSize maxSize orderBy _mt = do getTableNgramsDoc dId tabType listId limit_ offset listType minSize maxSize orderBy _mt = do
ns <- selectNodesWithUsername NodeList userMaster ns <- selectNodesWithUsername NodeList userMaster
let ngramsType = ngramsTypeFromTabType tabType let ngramsType = ngramsTypeFromTabType tabType
......
...@@ -650,7 +650,24 @@ instance (Typeable a, ToSchema a) => ToSchema (Versioned a) where ...@@ -650,7 +650,24 @@ instance (Typeable a, ToSchema a) => ToSchema (Versioned a) where
declareNamedSchema = wellNamedSchema "_v_" declareNamedSchema = wellNamedSchema "_v_"
instance Arbitrary a => Arbitrary (Versioned a) where instance Arbitrary a => Arbitrary (Versioned a) where
arbitrary = Versioned 1 <$> arbitrary -- TODO 1 is constant so far arbitrary = Versioned 1 <$> arbitrary -- TODO 1 is constant so far
------------------------------------------------------------------------
type Count = Int
data VersionedWithCount a = VersionedWithCount
{ _vc_version :: Version
, _vc_count :: Count
, _vc_data :: a
}
deriving (Generic, Show, Eq)
deriveJSON (unPrefix "_vc_") ''VersionedWithCount
makeLenses ''VersionedWithCount
instance (Typeable a, ToSchema a) => ToSchema (VersionedWithCount a) where
declareNamedSchema = wellNamedSchema "_vc_"
instance Arbitrary a => Arbitrary (VersionedWithCount a) where
arbitrary = VersionedWithCount 1 1 <$> arbitrary -- TODO 1 is constant so far
toVersionedWithCount :: Count -> Versioned a -> VersionedWithCount a
toVersionedWithCount count (Versioned version data_) = VersionedWithCount version count data_
------------------------------------------------------------------------ ------------------------------------------------------------------------
data Repo s p = Repo data Repo s p = Repo
{ _r_version :: !Version { _r_version :: !Version
......
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