Commit 1e9e4ffd authored by Alexandre Delanoë's avatar Alexandre Delanoë

[CLEAN] fix warnings

parent 5cf6f5da
Pipeline #1304 failed with stage
...@@ -89,7 +89,7 @@ buildNgramsOthersList ::( HasNodeError err ...@@ -89,7 +89,7 @@ buildNgramsOthersList ::( HasNodeError err
-> GroupParams -> GroupParams
-> (NgramsType, MapListSize) -> (NgramsType, MapListSize)
-> m (Map NgramsType [NgramsElement]) -> m (Map NgramsType [NgramsElement])
buildNgramsOthersList user uCid groupParams (nt, MapListSize mapListSize) = do buildNgramsOthersList user uCid _groupParams (nt, MapListSize mapListSize) = do
allTerms :: Map Text (Set NodeId) <- getNodesByNgramsUser uCid nt allTerms :: Map Text (Set NodeId) <- getNodesByNgramsUser uCid nt
-- | PrivateFirst for first developments since Public NodeMode is not implemented yet -- | PrivateFirst for first developments since Public NodeMode is not implemented yet
......
...@@ -25,13 +25,12 @@ import Data.Monoid (Monoid, mempty) ...@@ -25,13 +25,12 @@ import Data.Monoid (Monoid, mempty)
import Data.Text (Text) import Data.Text (Text)
import Gargantext.Core.Text.List.Social.Prelude import Gargantext.Core.Text.List.Social.Prelude
import Gargantext.Core.Text.List.Group.Prelude import Gargantext.Core.Text.List.Group.Prelude
import Gargantext.Core.Text.List.Group.WithStem
import Gargantext.Core.Text.List.Group.WithScores import Gargantext.Core.Text.List.Group.WithScores
import Gargantext.Prelude import Gargantext.Prelude
import qualified Data.Map as Map import qualified Data.Map as Map
------------------------------------------------------------------------ ------------------------------------------------------------------------
toGroupedTree :: (Ord a, Monoid a, GroupWithStem a) toGroupedTree :: (Ord a, Monoid a)
=> FlowCont Text FlowListScores => FlowCont Text FlowListScores
-> Map Text a -> Map Text a
-> FlowCont Text (GroupedTreeScores a) -> FlowCont Text (GroupedTreeScores a)
...@@ -66,6 +65,4 @@ setScoresWith f = Map.mapWithKey (\k v -> v { _gts'_score = f k ...@@ -66,6 +65,4 @@ setScoresWith f = Map.mapWithKey (\k v -> v { _gts'_score = f k
$ view gts'_children v $ view gts'_children v
} }
) )
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -17,10 +17,8 @@ Portability : POSIX ...@@ -17,10 +17,8 @@ Portability : POSIX
module Gargantext.Core.Text.List.Group.WithStem module Gargantext.Core.Text.List.Group.WithStem
where where
import Control.Lens (view, over)
import Data.Map (Map) import Data.Map (Map)
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Data.Monoid (mempty)
import Data.Set (Set) import Data.Set (Set)
import Data.Text (Text) import Data.Text (Text)
import Gargantext.API.Ngrams.Types import Gargantext.API.Ngrams.Types
...@@ -29,7 +27,6 @@ import Gargantext.Core.Text.List.Group.Prelude ...@@ -29,7 +27,6 @@ import Gargantext.Core.Text.List.Group.Prelude
import Gargantext.Core.Text.List.Social.Prelude import Gargantext.Core.Text.List.Social.Prelude
import Gargantext.Core.Text.List.Social.Patch import Gargantext.Core.Text.List.Social.Patch
import Gargantext.Core.Text.Terms.Mono.Stem (stem) import Gargantext.Core.Text.Terms.Mono.Stem (stem)
import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Prelude import Gargantext.Prelude
import qualified Data.List as List import qualified Data.List as List
import qualified Data.Map as Map import qualified Data.Map as Map
...@@ -113,167 +110,3 @@ toNgramsPatch children = NgramsPatch children' Patch.Keep ...@@ -113,167 +110,3 @@ toNgramsPatch children = NgramsPatch children' Patch.Keep
$ PatchMap.fromList $ PatchMap.fromList
$ List.zip children (List.cycle [addPatch]) $ List.zip children (List.cycle [addPatch])
------------------------------------------------------------------------
-- 8< - 8< - 8< - 8< - 8< - 8< - 8< - 8< - 8< - 8< - 8< - 8< - 8< - 8< --
-- TODO remove below
------------------------------------------------------------------------
class GroupWithStem a where
groupWithStem' :: GroupParams
-> FlowCont Text (GroupedTreeScores a)
-> FlowCont Text (GroupedTreeScores a)
-- TODO factorize groupWithStem_*
instance GroupWithStem (Set NodeId) where
groupWithStem' = groupWithStem_SetNodeId
instance GroupWithStem Double where
groupWithStem' = groupWithStem_Double
groupWithStem_SetNodeId :: GroupParams
-> FlowCont Text (GroupedTreeScores (Set NodeId))
-> FlowCont Text (GroupedTreeScores (Set NodeId))
groupWithStem_SetNodeId g flc
| g == GroupIdentity = FlowCont ( (<>)
(view flc_scores flc)
(view flc_cont flc)
) mempty
| otherwise = mergeWith (groupWith g) flc
groupWithStem_Double :: GroupParams
-> FlowCont Text (GroupedTreeScores Double)
-> FlowCont Text (GroupedTreeScores Double)
groupWithStem_Double g flc
| g == GroupIdentity = FlowCont ( (<>)
(view flc_scores flc)
(view flc_cont flc)
) mempty
| otherwise = mergeWith_Double (groupWith g) flc
-- | MergeWith : with stem, we always have an answer
-- if Maybe lems then we should add it to continuation
mergeWith :: (Text -> Text)
-> FlowCont Text (GroupedTreeScores (Set NodeId))
-> FlowCont Text (GroupedTreeScores (Set NodeId))
mergeWith fun flc = FlowCont scores mempty
where
scores :: Map Text (GroupedTreeScores (Set NodeId))
scores = foldl' (alter (mapStems scores')) scores' cont'
where
scores' = view flc_scores flc
cont' = Map.toList $ view flc_cont flc
-- TODO insert at the right place in group hierarchy
-- adding as child of the parent for now
alter :: Map Stem Text
-> Map Text (GroupedTreeScores (Set NodeId))
-> (Text, GroupedTreeScores (Set NodeId))
-> Map Text (GroupedTreeScores (Set NodeId))
alter st target (t,g) = case Map.lookup t st of
Nothing -> Map.alter (alter' (t,g)) t target
Just t' -> Map.alter (alter' (t,g)) t' target
alter' (_t,g) Nothing = Just g
alter' ( t,g) (Just g') = Just $ over gts'_children
( Map.union (Map.singleton t g))
g'
mapStems :: Map Text (GroupedTreeScores (Set NodeId))
-> Map Stem Text
mapStems = (Map.fromListWith (<>)) . List.concat . (map mapStem) . Map.toList
mapStem :: (Text, GroupedTreeScores (Set NodeId))
-> [(Stem, Text)]
mapStem (s,g) = parent : children
where
parent = (fun s, s)
children = List.concat $ map mapStem (Map.toList $ view gts'_children g)
-- | MergeWith : with stem, we always have an answer
-- if Maybe lems then we should add it to continuation
mergeWith_Double :: (Text -> Text)
-> FlowCont Text (GroupedTreeScores Double)
-> FlowCont Text (GroupedTreeScores Double)
mergeWith_Double fun flc = FlowCont scores mempty
where
scores :: Map Text (GroupedTreeScores Double)
scores = foldl' (alter (mapStems scores')) scores' cont'
where
scores' = view flc_scores flc
cont' = Map.toList $ view flc_cont flc
-- TODO insert at the right place in group hierarchy
-- adding as child of the parent for now
alter :: Map Stem Text
-> Map Text (GroupedTreeScores Double)
-> (Text, GroupedTreeScores Double)
-> Map Text (GroupedTreeScores Double)
alter st target (t,g) = case Map.lookup t st of
Nothing -> Map.alter (alter' (t,g)) t target
Just t' -> Map.alter (alter' (t,g)) t' target
alter' (_t,g) Nothing = Just g
alter' ( t,g) (Just g') = Just $ over gts'_children
( Map.union (Map.singleton t g))
g'
mapStems :: Map Text (GroupedTreeScores Double)
-> Map Stem Text
mapStems = (Map.fromListWith (<>)) . List.concat . (map mapStem) . Map.toList
mapStem :: (Text, GroupedTreeScores Double)
-> [(Stem, Text)]
mapStem (s,g) = parent : children
where
parent = (fun s, s)
children = List.concat $ map mapStem (Map.toList $ view gts'_children g)
{-
-- | TODO fixme
mergeWith_a :: (Text -> Text)
-> FlowCont Text (GroupedTreeScores a)
-> FlowCont Text (GroupedTreeScores a)
mergeWith_a fun flc = FlowCont scores mempty
where
scores :: Map Text (GroupedTreeScores a)
scores = foldl' (alter (mapStems scores')) scores' cont'
where
scores' = view flc_scores flc
cont' = Map.toList $ _flc_cont flc
-- TODO insert at the right place in group hierarchy
-- adding as child of the parent for now
alter :: Map Stem Text
-> Map Text (GroupedTreeScores a)
-> (Text, GroupedTreeScores a)
-> Map Text (GroupedTreeScores a)
alter st target (t,g) = case Map.lookup t st of
Nothing -> Map.alter (alter' (t,g)) t target
Just t' -> Map.alter (alter' (t,g)) t' target
alter' (_t,g) Nothing = Just g
alter' ( t,g) (Just g') = Just $ over gts'_children
( Map.union (Map.singleton t g))
g'
mapStems :: Map Text (GroupedTreeScores a)
-> Map Stem Text
mapStems = (Map.fromListWith (<>)) . List.concat . (map mapStem) . Map.toList
mapStem :: (Text, GroupedTreeScores a)
-> [(Stem, Text)]
mapStem (s,g) = parent : children
where
parent = (fun s, s)
children = List.concat $ map mapStem (Map.toList $ view gts'_children g)
-}
...@@ -20,7 +20,6 @@ import Gargantext.Core.Text.List.Social.Find ...@@ -20,7 +20,6 @@ import Gargantext.Core.Text.List.Social.Find
import Gargantext.Core.Text.List.Social.History import Gargantext.Core.Text.List.Social.History
import Gargantext.Core.Text.List.Social.Patch import Gargantext.Core.Text.List.Social.Patch
import Gargantext.Core.Text.List.Social.Prelude import Gargantext.Core.Text.List.Social.Prelude
import Gargantext.Core.Text.List.Social.Scores
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude import Gargantext.Database.Prelude
......
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