Skip to content

H
haskell-gargantext
Commit 1e9e4ffd authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[CLEAN] fix warnings

parent 5cf6f5da
Show whitespace changes
Inline Side-by-side
Showing with 2 additions and 173 deletions
src/Gargantext/Core/Text/List.hs
View file @ 1e9e4ffd
......@@ -89,7 +89,7 @@ buildNgramsOthersList ::( HasNodeError err
-> GroupParams
-> (NgramsType, MapListSize)
-> 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
-- | PrivateFirst for first developments since Public NodeMode is not implemented yet
......
src/Gargantext/Core/Text/List/Group.hs
View file @ 1e9e4ffd
......@@ -25,13 +25,12 @@ import Data.Monoid (Monoid, mempty)
import Data.Text (Text)
import Gargantext.Core.Text.List.Social.Prelude
import Gargantext.Core.Text.List.Group.Prelude
import Gargantext.Core.Text.List.Group.WithStem
import Gargantext.Core.Text.List.Group.WithScores
import Gargantext.Prelude
import qualified Data.Map as Map
------------------------------------------------------------------------
toGroupedTree :: (Ord a, Monoid a, GroupWithStem a)
toGroupedTree :: (Ord a, Monoid a)
=> FlowCont Text FlowListScores
-> Map Text a
-> FlowCont Text (GroupedTreeScores a)
......@@ -66,6 +65,4 @@ setScoresWith f = Map.mapWithKey (\k v -> v { _gts'_score = f k
$ view gts'_children v
}
)
------------------------------------------------------------------------
src/Gargantext/Core/Text/List/Group/WithStem.hs
View file @ 1e9e4ffd
......@@ -17,10 +17,8 @@ Portability : POSIX
module Gargantext.Core.Text.List.Group.WithStem
where
import Control.Lens (view, over)
import Data.Map (Map)
import Data.Maybe (catMaybes)
import Data.Monoid (mempty)
import Data.Set (Set)
import Data.Text (Text)
import Gargantext.API.Ngrams.Types
......@@ -29,7 +27,6 @@ import Gargantext.Core.Text.List.Group.Prelude
import Gargantext.Core.Text.List.Social.Prelude
import Gargantext.Core.Text.List.Social.Patch
import Gargantext.Core.Text.Terms.Mono.Stem (stem)
import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Prelude
import qualified Data.List as List
import qualified Data.Map as Map
......@@ -113,167 +110,3 @@ toNgramsPatch children = NgramsPatch children' Patch.Keep
$ PatchMap.fromList
$ 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)
-}
src/Gargantext/Core/Text/List/Social.hs
View file @ 1e9e4ffd
......@@ -20,7 +20,6 @@ import Gargantext.Core.Text.List.Social.Find
import Gargantext.Core.Text.List.Social.History
import Gargantext.Core.Text.List.Social.Patch
import Gargantext.Core.Text.List.Social.Prelude
import Gargantext.Core.Text.List.Social.Scores
import Gargantext.Core.Types.Individu
import Gargantext.Database.Admin.Types.Node
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