Skip to content

haskell-gargantext
haskell-gargantext
Commit 376ddea3 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

Merge branch 'dev' into 145-dev-graph-explorer-search-tfidf

parents b0b6a491 ca606da8
Pipeline #3385 passed with stage
    in 92 minutes and 10 seconds
    Hide whitespace changes
    Inline Side-by-side
    Showing with 126 additions and 85 deletions
    CHANGELOG.md
    View file @ 376ddea3
    ## Version 0.0.6.8.5
    * [BACK][FIX][Ngrams Table, page sort / limit (#149)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/149)
    * [FRONT][FIX][Security Issue with Teams (#452)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/452)
    * [FRONT][FIX][Darkster Mode: when creating a node we miss informations (#461)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/461)
    ## Version 0.0.6.8.4
    * [BACK][FEAT] Fix reindexing functions
    * [FRONT][FIX][FEEDBACK ON 0.0.6.8.2 (#459)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/459)
    ## Version 0.0.6.8.3
    * [FRONT][SECU][Security Issue with Teams (#452)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/452)
    * [FRONT][FEAT][Graph Explorer: disable controls when ForceAtlas is running (#451)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/451)
    * [FRONT][FIX][[Doc date filter] Filter by multiple dates (#450)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/450)
    * [FRONT][ERGO][[layout] Description node block hide feature (#447)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/447)
    * [FRONT][ERGO][[layout] Node view additions (#448)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/448)
    * [BACK][FIX][Problem at list import (#148)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/148)
    * [FRONT][FIX][CSS in Graph Explorer toolbar (#460)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/460)
    * [BACK][FEAT] Bridgeness with more links
    ## Version 0.0.6.8.2 ## Version 0.0.6.8.2
    * [FRONT][FIX][[Doc view] By default sort document from latest to oldest (#457)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/457) * [FRONT][FIX][[Doc view] By default sort document from latest to oldest (#457)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/457)
    * [FRONT][FIX][Regression on Documents' annotation (#456)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/456) * [FRONT][FIX][Regression on Documents' annotation (#456)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/456)
    * [FRONT][FIX][[layout] Move Cache CTA to topbar (#446)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/446)
    * [FRONT][FIX][Graph Explorer: node status change to either candidates or stop (#454)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/454)
    ## Version 0.0.6.8.1 ## Version 0.0.6.8.1
    ......
    gargantext.cabal
    View file @ 376ddea3
    ...@@ -5,7 +5,7 @@ cabal-version: 1.12 ...@@ -5,7 +5,7 @@ cabal-version: 1.12
    -- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
    name: gargantext name: gargantext
    version: 0.0.6.8.2 version: 0.0.6.8.5
    synopsis: Search, map, share synopsis: Search, map, share
    description: Please see README.md description: Please see README.md
    category: Data category: Data
    ......
    package.yaml
    View file @ 376ddea3
    ...@@ -6,7 +6,7 @@ name: gargantext ...@@ -6,7 +6,7 @@ name: gargantext
    # | | | +----- Layers * : New versions with API additions # | | | +----- Layers * : New versions with API additions
    # | | | | +--- Layers * : New versions without API breaking changes # | | | | +--- Layers * : New versions without API breaking changes
    # | | | | | # | | | | |
    version: '0.0.6.8.2' version: '0.0.6.8.5'
    synopsis: Search, map, share synopsis: Search, map, share
    description: Please see README.md description: Please see README.md
    category: Data category: Data
    ......
    src/Gargantext/API/GraphQL/TreeFirstLevel.hs
    View file @ 376ddea3
    ...@@ -78,13 +78,17 @@ childrenToTreeNodes (TreeN {_tn_node}, rId) = toTreeNode (Just rId) _tn_node ...@@ -78,13 +78,17 @@ childrenToTreeNodes (TreeN {_tn_node}, rId) = toTreeNode (Just rId) _tn_node
    resolveParent :: (HasConnectionPool env, HasConfig env, HasMail env) => Maybe NodeId -> GqlM e env (Maybe TreeNode) resolveParent :: (HasConnectionPool env, HasConfig env, HasMail env) => Maybe NodeId -> GqlM e env (Maybe TreeNode)
    resolveParent (Just pId) = do resolveParent (Just pId) = do
    node <- lift $ getNode pId node <- lift $ getNode pId
    pure $ Just $ nodeToTreeNode node pure $ nodeToTreeNode node
    resolveParent Nothing = pure Nothing resolveParent Nothing = pure Nothing
    nodeToTreeNode :: NN.Node json -> TreeNode nodeToTreeNode :: NN.Node json -> Maybe TreeNode
    nodeToTreeNode N.Node {..} = TreeNode { id = NN.unNodeId _node_id nodeToTreeNode N.Node {..} = if (fromNodeTypeId _node_typename /= NN.NodeFolderShared) && (fromNodeTypeId _node_typename /= NN.NodeTeam)
    , name = _node_name then
    , node_type = fromNodeTypeId _node_typename Just TreeNode { id = NN.unNodeId _node_id
    , parent_id = NN.unNodeId <$> _node_parent_id , name = _node_name
    } , node_type = fromNodeTypeId _node_typename
    , parent_id = NN.unNodeId <$> _node_parent_id
    }
    else
    Nothing
    src/Gargantext/API/Ngrams.hs
    View file @ 376ddea3
    ...@@ -69,6 +69,9 @@ module Gargantext.API.Ngrams ...@@ -69,6 +69,9 @@ module Gargantext.API.Ngrams
    , tableNgramsPull , tableNgramsPull
    , tableNgramsPut , tableNgramsPut
    , getNgramsTable'
    , setNgramsTableScores
    , Version , Version
    , Versioned(..) , Versioned(..)
    , VersionedWithCount(..) , VersionedWithCount(..)
    ...@@ -80,7 +83,7 @@ module Gargantext.API.Ngrams ...@@ -80,7 +83,7 @@ module Gargantext.API.Ngrams
    where where
    import Control.Concurrent import Control.Concurrent
    import Control.Lens ((.~), view, (^.), (^..), (+~), (%~), (.~), sumOf, at, _Just, Each(..), (%%~), mapped, ifolded, withIndex) import Control.Lens ((.~), view, (^.), (^..), (+~), (%~), (.~), sumOf, at, _Just, Each(..), (%%~), mapped, ifolded, withIndex, over)
    import Control.Monad.Reader import Control.Monad.Reader
    import Data.Aeson hiding ((.=)) import Data.Aeson hiding ((.=))
    import Data.Either (Either(..)) import Data.Either (Either(..))
    ...@@ -532,6 +535,11 @@ getTableNgrams _nType nId tabType listId limit_ offset ...@@ -532,6 +535,11 @@ getTableNgrams _nType nId tabType listId limit_ offset
    minSize' = maybe (const True) (<=) minSize minSize' = maybe (const True) (<=) minSize
    maxSize' = maybe (const True) (>=) maxSize maxSize' = maybe (const True) (>=) maxSize
    rootOf tableMap ne = maybe ne (\r -> fromMaybe (panic "getTableNgrams: invalid root")
    (tableMap ^. at r)
    )
    (ne ^. ne_root)
    selected_node n = minSize' s selected_node n = minSize' s
    && maxSize' s && maxSize' s
    && searchQuery (n ^. ne_ngrams) && searchQuery (n ^. ne_ngrams)
    ...@@ -549,109 +557,115 @@ getTableNgrams _nType nId tabType listId limit_ offset ...@@ -549,109 +557,115 @@ getTableNgrams _nType nId tabType listId limit_ offset
    sortOnOrder (Just ScoreDesc) = List.sortOn $ Down . view ne_occurrences sortOnOrder (Just ScoreDesc) = List.sortOn $ Down . view ne_occurrences
    --------------------------------------- ---------------------------------------
    -- | Filter the given `tableMap` with the search criteria.
    filteredNodes :: Map NgramsTerm NgramsElement -> [NgramsElement] filteredNodes :: Map NgramsTerm NgramsElement -> [NgramsElement]
    filteredNodes tableMap = rootOf <$> list & filter selected_node filteredNodes tableMap = roots
    where where
    rootOf ne = maybe ne (\r -> fromMaybe (panic "getTableNgrams: invalid root")
    (tableMap ^. at r)
    )
    (ne ^. ne_root)
    list = tableMap ^.. each list = tableMap ^.. each
    selected_nodes = list & filter selected_node
    roots = rootOf tableMap <$> selected_nodes
    --------------------------------------- -- | Appends subitems (selected from `tableMap`) for given `roots`.
    selectAndPaginate :: Map NgramsTerm NgramsElement -> [NgramsElement] withInners :: Map NgramsTerm NgramsElement -> [NgramsElement] -> [NgramsElement]
    selectAndPaginate tableMap = roots <> inners withInners tableMap roots = roots <> inners
    where where
    list = tableMap ^.. each list = tableMap ^.. each
    rootOf ne = maybe ne (\r -> fromMaybe (panic "getTableNgrams: invalid root") rootSet = Set.fromList (_ne_ngrams <$> roots)
    (tableMap ^. at r) inners = list & filter (selected_inner rootSet)
    )
    (ne ^. ne_root)
    selected_nodes = list & take limit_
    . drop offset'
    . filter selected_node
    . sortOnOrder orderBy
    roots = rootOf <$> selected_nodes
    rootsSet = Set.fromList (_ne_ngrams <$> roots)
    inners = list & filter (selected_inner rootsSet)
    --------------------------------------- -- | Paginate the results
    setScores :: forall t. Each t t NgramsElement NgramsElement => Bool -> t -> m t sortAndPaginate :: [NgramsElement] -> [NgramsElement]
    setScores False table = pure table sortAndPaginate = take limit_
    setScores True table = do . drop offset'
    let ngrams_terms = table ^.. each . ne_ngrams . sortOnOrder orderBy
    -- printDebug "ngrams_terms" ngrams_terms
    t1 <- getTime
    occurrences <- getOccByNgramsOnlyFast nId
    listId
    ngramsType
    --printDebug "occurrences" occurrences
    t2 <- getTime
    liftBase $ hprint stderr
    ("getTableNgrams/setScores #ngrams=" % int % " time=" % hasTime % "\n")
    (length ngrams_terms) t1 t2
    let
    setOcc ne = ne & ne_occurrences .~ sumOf (at (ne ^. ne_ngrams) . _Just) occurrences
    pure $ table & each %~ setOcc
    --------------------------------------- ---------------------------------------
    -- lists <- catMaybes <$> listsWith userMaster
    -- trace (show lists) $
    -- getNgramsTableMap ({-lists <>-} listIds) ngramsType
    let scoresNeeded = needsScores orderBy let scoresNeeded = needsScores orderBy
    tableMap1 <- getNgramsTableMap listId ngramsType
    t1 <- getTime t1 <- getTime
    tableMap2 <- tableMap1 & v_data %%~ setScores scoresNeeded tableMap2 <- getNgramsTable' nId listId ngramsType :: m (Versioned (Map NgramsTerm NgramsElement))
    . Map.mapWithKey ngramsElementFromRepo
    fltr <- tableMap2 & v_data %%~ fmap NgramsTable . setScores (not scoresNeeded) let fltr = tableMap2 & v_data %~ NgramsTable . filteredNodes :: Versioned NgramsTable
    . filteredNodes
    let fltrCount = length $ fltr ^. v_data . _NgramsTable let fltrCount = length $ fltr ^. v_data . _NgramsTable
    t2 <- getTime t2 <- getTime
    tableMap3 <- tableMap2 & v_data %%~ fmap NgramsTable let tableMap3 = over (v_data . _NgramsTable) ((withInners (tableMap2 ^. v_data)) . sortAndPaginate) fltr
    . setScores (not scoresNeeded)
    . selectAndPaginate
    t3 <- getTime t3 <- getTime
    liftBase $ hprint stderr liftBase $ do
    ("getTableNgrams total=" % hasTime hprint stderr
    % " map1=" % hasTime ("getTableNgrams total=" % hasTime
    % " map2=" % hasTime % " map1=" % hasTime
    % " map3=" % hasTime % " map2=" % hasTime
    % " sql=" % (if scoresNeeded then "map2" else "map3") % " map3=" % hasTime
    % "\n" % " sql=" % (if scoresNeeded then "map2" else "map3")
    ) t0 t3 t0 t1 t1 t2 t2 t3 % "\n"
    ) t0 t3 t0 t1 t1 t2 t2 t3
    -- printDebug "[getTableNgrams] tableMap3" $ show tableMap3
    pure $ toVersionedWithCount fltrCount tableMap3 pure $ toVersionedWithCount fltrCount tableMap3
    -- | Helper function to get the ngrams table with scores.
    getNgramsTable' :: forall env err m.
    ( HasNodeStory env err m
    , HasNodeError err
    , HasConnectionPool env
    , HasConfig env
    , HasMail env)
    => NodeId
    -> ListId
    -> TableNgrams.NgramsType
    -> m (Versioned (Map.Map NgramsTerm NgramsElement))
    getNgramsTable' nId listId ngramsType = do
    tableMap1 <- getNgramsTableMap listId ngramsType
    tableMap1 & v_data %%~ (setNgramsTableScores nId listId ngramsType)
    . Map.mapWithKey ngramsElementFromRepo
    -- | Helper function to set scores on an `NgramsTable`.
    setNgramsTableScores :: forall env err m t.
    ( Each t t NgramsElement NgramsElement
    , HasNodeStory env err m
    , HasNodeError err
    , HasConnectionPool env
    , HasConfig env
    , HasMail env)
    => NodeId
    -> ListId
    -> TableNgrams.NgramsType
    -> t
    -> m t
    setNgramsTableScores nId listId ngramsType table = do
    let ngrams_terms = table ^.. each . ne_ngrams
    -- printDebug "ngrams_terms" ngrams_terms
    t1 <- getTime
    occurrences <- getOccByNgramsOnlyFast nId listId ngramsType
    --printDebug "occurrences" occurrences
    t2 <- getTime
    liftBase $ hprint stderr
    ("getTableNgrams/setScores #ngrams=" % int % " time=" % hasTime % "\n")
    (length ngrams_terms) t1 t2
    let
    setOcc ne = ne & ne_occurrences .~ sumOf (at (ne ^. ne_ngrams) . _Just) occurrences
    pure $ table & each %~ setOcc
    scoresRecomputeTableNgrams :: forall env err m. scoresRecomputeTableNgrams :: forall env err m.
    (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env, HasMail env) (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env, HasMail env)
    => NodeId -> TabType -> ListId -> m Int => NodeId -> TabType -> ListId -> m Int
    scoresRecomputeTableNgrams nId tabType listId = do scoresRecomputeTableNgrams nId tabType listId = do
    tableMap <- getNgramsTableMap listId ngramsType tableMap <- getNgramsTableMap listId ngramsType
    _ <- tableMap & v_data %%~ setScores _ <- tableMap & v_data %%~ (setNgramsTableScores nId listId ngramsType)
    . Map.mapWithKey ngramsElementFromRepo . Map.mapWithKey ngramsElementFromRepo
    pure $ 1 pure $ 1
    where where
    ngramsType = ngramsTypeFromTabType tabType ngramsType = ngramsTypeFromTabType tabType
    setScores :: forall t. Each t t NgramsElement NgramsElement => t -> m t
    setScores table = do
    occurrences <- getOccByNgramsOnlyFast nId
    listId
    ngramsType
    let
    setOcc ne = ne & ne_occurrences .~ sumOf (at (ne ^. ne_ngrams) . _Just) occurrences
    pure $ table & each %~ setOcc
    -- APIs -- APIs
    ......
    src/Gargantext/API/Ngrams/List.hs
    View file @ 376ddea3
    ...@@ -158,6 +158,7 @@ reIndexWith cId lId nt lts = do ...@@ -158,6 +158,7 @@ reIndexWith cId lId nt lts = do
    -- Checking Text documents where orphans match -- Checking Text documents where orphans match
    -- TODO Tests here -- TODO Tests here
    let let
    -- fromListWith (<>)
    ngramsByDoc = map (HashMap.fromList) ngramsByDoc = map (HashMap.fromList)
    $ map (map (\((k, cnt), v) -> (SimpleNgrams (text2ngrams k), over (traverse . traverse) (\p -> (p, cnt)) v))) $ map (map (\((k, cnt), v) -> (SimpleNgrams (text2ngrams k), over (traverse . traverse) (\p -> (p, cnt)) v)))
    $ map (\doc -> List.zip $ map (\doc -> List.zip
    ...@@ -266,7 +267,7 @@ parseCsvData lst = Map.fromList $ conv <$> lst ...@@ -266,7 +267,7 @@ parseCsvData lst = Map.fromList $ conv <$> lst
    , _nre_children = MSet , _nre_children = MSet
    $ Map.fromList $ Map.fromList
    $ map (\form -> (NgramsTerm form, ())) $ map (\form -> (NgramsTerm form, ()))
    $ filter (/= "") $ filter (\w -> w /= "" && w /= label)
    $ splitOn "|&|" forms $ splitOn "|&|" forms
    } }
    ) )
    ......
    src/Gargantext/Core/Text/Terms/WithList.hs
    View file @ 376ddea3
    ...@@ -72,9 +72,8 @@ buildPatterns = sortWith (Down . _pat_length) . concatMap buildPattern ...@@ -72,9 +72,8 @@ buildPatterns = sortWith (Down . _pat_length) . concatMap buildPattern
    -------------------------------------------------------------------------- --------------------------------------------------------------------------
    -- Utils -- Utils
    type BlockText = Text
    type MatchedText = Text type MatchedText = Text
    termsInText :: Patterns -> BlockText -> [(MatchedText, TermsCount)] termsInText :: Patterns -> Text -> [(MatchedText, TermsCount)]
    termsInText pats txt = groupWithCounts termsInText pats txt = groupWithCounts
    $ List.concat $ List.concat
    $ map (map unwords) $ map (map unwords)
    ......
    src/Gargantext/Core/Viz/Graph/Bridgeness.hs
    View file @ 376ddea3
    ...@@ -109,10 +109,10 @@ filterComs _b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m ...@@ -109,10 +109,10 @@ filterComs _b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
    filter' (c1,c2) a filter' (c1,c2) a
    | c1 == c2 = a | c1 == c2 = a
    -- TODO use n here -- TODO use n here
    | otherwise = take 1 $ List.sortOn (Down . snd) a | otherwise = take n $ List.sortOn (Down . snd) a
    where where
    _n :: Int n :: Int
    _n = round $ 100 * a' / t n = round $ 100 * a' / t
    a'= fromIntegral $ length a a'= fromIntegral $ length a
    t :: Double t :: Double
    t = fromIntegral $ length $ List.concat $ elems m t = fromIntegral $ length $ List.concat $ elems 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