[FIX] ViewScore instances

src/Gargantext/Core/Text/List/Group.hs

@@ -29,7 +29,7 @@ import Gargantext.Core.Text.List.Social.Prelude
 import Gargantext.Prelude
 import qualified Data.HashMap.Strict as HashMap
 ------------------------------------------------------------------------
-toGroupedTree :: (Ord a, Monoid a)
+toGroupedTree :: (Ord a, Monoid a, HasSize a)
               => FlowCont NgramsTerm FlowListScores
               -> HashMap NgramsTerm a
               -> FlowCont NgramsTerm (GroupedTreeScores a)

src/Gargantext/Core/Text/List/Group/Prelude.hs

@@ -23,13 +23,12 @@ import Data.Monoid
 import Data.Semigroup
 import Data.Set (Set)
 import Gargantext.API.Ngrams.Types (NgramsElement, mkNgramsElement, NgramsTerm(..), RootParent(..), mSetFromList)
-import Gargantext.Core.Text.Metrics (Scored(..), scored_genInc)
 import Gargantext.Core.Types (ListType(..))
-import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Prelude
 import qualified Data.HashMap.Strict as HashMap
 import qualified Data.List as List
 import qualified Data.Set  as Set
+import Prelude (foldl1)
 
 type Stem = NgramsTerm
 ------------------------------------------------------------------------
@@ -91,6 +90,21 @@ instance SetListType (HashMap NgramsTerm (GroupedTreeScores a)) where
 
                             ------
 
+class HasSize a where
+  hasSize :: a -> Integer
+
+instance HasSize Double where
+  hasSize = round
+
+instance HasSize (Set a) where
+  hasSize = fromIntegral . Set.size
+
+instance (HasSize a, Semigroup a) => ViewScore (GroupedTreeScores a) Integer where
+  viewScore = hasSize . viewScores
+
+{-
+
+-- TODO clean this instances
 instance ViewScore (GroupedTreeScores Double) Double where
   viewScore = viewScores
 
@@ -100,19 +114,25 @@ instance ViewScores (GroupedTreeScores Double) Double where
       parent   = view gts'_score g
       children = map viewScores $ HashMap.elems $ view gts'_children g
 
-
 instance ViewScore (GroupedTreeScores (Set NodeId)) Int where
   viewScore = Set.size . viewScores
 
+instance ViewScore (GroupedTreeScores (Scored NgramsTerm)) Double where
+  viewScore = view (gts'_score . scored_genInc)
+
 instance ViewScores (GroupedTreeScores (Set NodeId)) (Set NodeId) where
   viewScores g = Set.unions $ parent : children
     where
       parent   = view gts'_score g
       children = map viewScores $ HashMap.elems $ view gts'_children g
+-}
 
+instance Semigroup a=> ViewScores (GroupedTreeScores a) a where
+  viewScores g = foldl1 (<>) $ parent : children
+    where
+      parent   = view gts'_score g
+      children = map viewScores $ HashMap.elems $ view gts'_children g
 
-instance ViewScore (GroupedTreeScores (Scored NgramsTerm)) Double where
-  viewScore = view (gts'_score . scored_genInc)
 
                             ------
 instance HasTerms (HashMap NgramsTerm (GroupedTreeScores a)) where

src/Gargantext/Core/Text/List/Group/WithScores.hs

@@ -28,14 +28,14 @@ import qualified Data.HashMap.Strict as HashMap
 
 ------------------------------------------------------------------------
 -- | Main function
-groupWithScores' :: (Eq a, Ord a, Monoid a)
+groupWithScores' :: (Eq a, Ord a, Monoid a, HasSize a)
                 => FlowCont NgramsTerm FlowListScores
                 -> (NgramsTerm -> a)
                 -> FlowCont NgramsTerm (GroupedTreeScores a)
 groupWithScores' flc scores = FlowCont  groups orphans
   where
     -- parent/child relation is inherited from social lists
-    groups  = HashMap.filter (\v -> view gts'_score v /= mempty)
+    groups  = HashMap.filter (\v -> viewScore v > 0)
             $ toGroupedTree'
             $ toMapMaybeParent scores
             $ (view flc_scores flc <> view flc_cont flc)