[CLEAN] renaming unexplicit fun

src/Gargantext/API/Metrics.hs

@@ -25,7 +25,7 @@ import Data.Time (UTCTime)
 import Servant
 
 import Gargantext.API.HashedResponse
-import Gargantext.API.Ngrams.NTree
+import Gargantext.API.Ngrams.NgramsTree
 import Gargantext.API.Ngrams.Types
 import Gargantext.API.Prelude (GargServer)
 import Gargantext.Core.Types (CorpusId, Limit, ListId, ListType(..))
@@ -317,7 +317,7 @@ type TreeApi = Summary " Tree API"
            :> QueryParam  "list"       ListId
            :> QueryParamR "ngramsType" TabType
            :> QueryParamR "listType"   ListType
-           :> Get '[JSON] (HashedResponse (ChartMetrics [MyTree]))
+           :> Get '[JSON] (HashedResponse (ChartMetrics [NgramsTree]))
         :<|> Summary "Tree Chart update"
                 :> QueryParam  "list"       ListId
                 :> QueryParamR "ngramsType" TabType
@@ -347,7 +347,7 @@ getTree :: FlowCmdM env err m
         -> Maybe ListId
         -> TabType
         -> ListType
-        -> m (HashedResponse (ChartMetrics [MyTree]))
+        -> m (HashedResponse (ChartMetrics [NgramsTree]))
 getTree cId _start _end maybeListId tabType listType = do
   listId <- case maybeListId of
     Just lid -> pure lid
@@ -383,7 +383,7 @@ updateTree' :: FlowCmdM env err m =>
   -> Maybe ListId
   -> TabType
   -> ListType
-  -> m (ChartMetrics [MyTree])
+  -> m (ChartMetrics [NgramsTree])
 updateTree' cId maybeListId tabType listType = do
   listId <- case maybeListId of
     Just lid -> pure lid

src/Gargantext/API/Ngrams.hs

-{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
 {-|
 Module      : Gargantext.API.Ngrams
 Description : Server API
@@ -16,6 +15,8 @@ add get
 
 -}
 
+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
+
 {-# LANGUAGE ConstraintKinds   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeOperators     #-}

src/Gargantext/API/Ngrams/NTree.hs → src/Gargantext/API/Ngrams/NgramsTree.hs

 {-|
-Module      : Gargantext.API.Ngrams.NTree
+Module      : Gargantext.API.Ngrams.NgramsTree
 Description : Tree of Ngrams
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -11,7 +11,7 @@ Portability : POSIX
 
 {-# LANGUAGE TemplateHaskell   #-}
 
-module Gargantext.API.Ngrams.NTree
+module Gargantext.API.Ngrams.NgramsTree
   where
 
 import Data.Aeson.TH (deriveJSON)
@@ -36,24 +36,25 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 type Children = Text
 type Root = Text
 
-data MyTree = MyTree { mt_label :: Text
-                     , mt_value :: Double
-                     , mt_children :: [MyTree]
-                  } deriving (Generic, Show)
+data NgramsTree = NgramsTree { mt_label :: Text
+                             , mt_value :: Double
+                             , mt_children :: [NgramsTree]
+                             }
+    deriving (Generic, Show)
 
-toMyTree :: Tree (Text,Double) -> MyTree
-toMyTree (Node (l,v) xs) = MyTree l v (map toMyTree xs)
+toNgramsTree :: Tree (Text,Double) -> NgramsTree
+toNgramsTree (Node (l,v) xs) = NgramsTree l v (map toNgramsTree xs)
 
-deriveJSON (unPrefix "mt_") ''MyTree
+deriveJSON (unPrefix "mt_") ''NgramsTree
 
-instance ToSchema MyTree where
+instance ToSchema NgramsTree where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "mt_")
-instance Arbitrary MyTree
+instance Arbitrary NgramsTree
   where
-    arbitrary = MyTree <$> arbitrary <*> arbitrary <*> arbitrary
+    arbitrary = NgramsTree <$> arbitrary <*> arbitrary <*> arbitrary
 
-toTree :: ListType -> Map Text (Set NodeId) -> Map Text NgramsRepoElement -> [MyTree]
-toTree lt vs m = map toMyTree $ unfoldForest buildNode roots
+toTree :: ListType -> Map Text (Set NodeId) -> Map Text NgramsRepoElement -> [NgramsTree]
+toTree lt vs m = map toNgramsTree $ unfoldForest buildNode roots
   where
     buildNode r = maybe ((r, value r),[])
                         (\x -> ((r, value r), unNgramsTerm <$> (mSetToList $ _nre_children x)))

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

@@ -13,7 +13,7 @@ module Gargantext.Core.Text.List.Social
 
 import Data.Monoid (mconcat)
 import Data.Text (Text)
-import Gargantext.API.Ngrams.Tools -- (getListNgrams)
+import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Text.List.Social.Find
 import Gargantext.Core.Text.List.Social.Prelude
@@ -26,7 +26,6 @@ import Gargantext.Database.Query.Tree
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Prelude
 
-------------------------------------------------------------------------
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
 -- | Main parameters
@@ -46,7 +45,6 @@ keepAllParents :: NgramsType -> KeepAllParents
 keepAllParents NgramsTerms = KeepAllParents False
 keepAllParents _           = KeepAllParents True
 
-
 ------------------------------------------------------------------------
 flowSocialList' :: ( RepoCmdM env err m
                    , CmdM     env err m
@@ -89,5 +87,3 @@ flowSocialList' flowPriority user nt flc =
             mapM (\l -> getListNgrams [l] nt'') ns
         >>= pure
           . toFlowListScores (keepAllParents nt'') flc''
-
-

src/Gargantext/Core/Text/List/Social/ListType.hs

-{-|
-Module      : Gargantext.Core.Text.List.Social.ListType
-Description :
-Copyright   : (c) CNRS, 2018-Present
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
--}
-
-module Gargantext.Core.Text.List.Social.ListType
-  where
-
-import Gargantext.Database.Admin.Types.Node
-import Data.Map (Map)
-import Data.Set (Set)
-import Data.Text (Text)
-import Gargantext.Prelude
-import Gargantext.API.Ngrams.Tools -- (getListNgrams)
-import Gargantext.API.Ngrams.Types
-import Gargantext.Core.Types.Main
-import Gargantext.Database.Schema.Ngrams
-import qualified Data.List  as List
-import qualified Data.Map   as Map
-import qualified Data.Set   as Set
-
-------------------------------------------------------------------------
--- | [ListId] does not merge the lists (it is for Master and User lists
--- here we need UserList only
-countFilterList :: RepoCmdM env err m
-        => Set Text -> NgramsType -> [ListId]
-        ->    Map Text (Map ListType Int)
-        -> m (Map Text (Map ListType Int))
-countFilterList st nt ls input =
-  foldM' (\m l -> countFilterList' st nt [l] m) input ls
-    where
-      countFilterList' :: RepoCmdM env err m
-              => Set Text -> NgramsType -> [ListId]
-              ->    Map Text (Map ListType Int)
-              -> m (Map Text (Map ListType Int))
-      countFilterList' st' nt' ls' input' = do
-        ml <- toMapTextListType <$> getListNgrams ls' nt'
-        pure $ Set.foldl' (\m t -> countList t ml m) input' st'
-
-------------------------------------------------------------------------
--- FIXME children have to herit the ListType of the parent
-toMapTextListType :: Map Text NgramsRepoElement -> Map Text ListType
-toMapTextListType m = Map.fromListWith (<>)
-                    $ List.concat
-                    $ map (toList m)
-                    $ Map.toList m
-  where
-    toList :: Map Text NgramsRepoElement -> (Text, NgramsRepoElement) -> [(Text, ListType)]
-    toList m' (t, nre@(NgramsRepoElement _ _ _ _ (MSet children))) =
-         List.zip terms (List.cycle [lt'])
-          where
-            terms =  [t]
-                  -- <> maybe [] (\n -> [unNgramsTerm n]) root
-                  -- <> maybe [] (\n -> [unNgramsTerm n]) parent
-                  <> (map unNgramsTerm $ Map.keys children)
-            lt'   = listOf m' nre
-
-            listOf :: Map Text NgramsRepoElement -> NgramsRepoElement -> ListType
-            listOf m'' ng = case _nre_parent ng of
-              Nothing -> _nre_list ng
-              Just  p -> case Map.lookup (unNgramsTerm p) m'' of
-                Just ng' -> listOf m'' ng'
-                Nothing  -> CandidateTerm
-                -- panic "[G.C.T.L.Social.listOf] Nothing: Should Not happen"
-
-------------------------------------------------------------------------
-countList :: Text
-          -> Map Text ListType
-          -> Map Text (Map ListType Int)
-          -> Map Text (Map ListType Int)
-countList t m input = case Map.lookup t m of
-  Nothing -> input
-  Just l  -> Map.alter addList t input
-    where
-
-      addList Nothing   = Just $ addCountList l Map.empty
-      addList (Just lm) = Just $ addCountList l lm
-
-      addCountList :: ListType -> Map ListType Int -> Map ListType Int
-      addCountList l' m' = Map.alter (plus l') l'  m'
-        where
-          plus CandidateTerm Nothing  = Just 1
-          plus CandidateTerm (Just x) = Just $ x + 1
-
-          plus MapTerm Nothing              = Just 2
-          plus MapTerm (Just x)             = Just $ x + 2
-
-          plus StopTerm Nothing              = Just 3
-          plus StopTerm (Just x)             = Just $ x + 3
-

src/Gargantext/Core/Text/List/Social/Scores.hs

@@ -39,34 +39,35 @@ toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) me
 
   where
     toFlowListScores_Level1 :: KeepAllParents
-                     -> FlowCont Text FlowListScores
-                     -> FlowCont Text FlowListScores
-                     -> Map Text NgramsRepoElement
-                     -> FlowCont Text FlowListScores
+                            -> FlowCont Text FlowListScores
+                            -> FlowCont Text FlowListScores
+                            -> Map Text NgramsRepoElement
+                            -> FlowCont Text FlowListScores
     toFlowListScores_Level1 k' flc_origin' flc_dest ngramsRepo =
       Set.foldl' (toFlowListScores_Level2 k' ngramsRepo   flc_origin')
                  flc_dest
                  (Set.fromList $ Map.keys $ view flc_cont flc_origin')
 
     toFlowListScores_Level2 :: KeepAllParents
-                       -> Map Text NgramsRepoElement
-                       -> FlowCont Text FlowListScores
-                       -> FlowCont Text FlowListScores
-                       -> Text
-                       -> FlowCont Text FlowListScores
+                            -> Map Text NgramsRepoElement
+                            -> FlowCont Text FlowListScores
+                            -> FlowCont Text FlowListScores
+                            -> Text
+                            -> FlowCont Text FlowListScores
     toFlowListScores_Level2 k'' ngramsRepo flc_origin'' flc_dest' t =
       case Map.lookup t ngramsRepo of
-        Nothing  -> over flc_cont (Map.union $ Map.singleton t mempty) flc_dest'
-        Just nre -> over flc_cont (Map.delete t) 
-                 $ over flc_scores
-                  ( (Map.alter (addParent k'' nre ( Set.fromList
-                                                  $ Map.keys
-                                                  $ view flc_cont flc_origin''
-                                                  )
-                               ) t
-                    )
-                  . (Map.alter (addList $ _nre_list nre) t)
-                  ) flc_dest'
+        Nothing  -> over flc_cont   (Map.union $ Map.singleton t mempty) flc_dest'
+        Just nre -> over flc_cont   (Map.delete t) 
+                 $  over flc_scores
+                                    ( (Map.alter (addParent k'' nre ( Set.fromList
+                                                                    $ Map.keys
+                                                                    $ view flc_cont flc_origin''
+                                                                    )
+                                                 ) t
+                                      )
+                                    . (Map.alter (addList $ _nre_list nre) t)
+                                    )
+                                    flc_dest'
 
 ------------------------------------------------------------------------
 -- | Main addFunctions to groupResolution the FlowListScores
@@ -118,9 +119,9 @@ addParentScore :: Num a
            -> Set Text
            -> Map Text a
            -> Map Text a
-addParentScore _ Nothing               _ss mapParent = mapParent
-addParentScore (KeepAllParents k) (Just (NgramsTerm p')) ss mapParent =
-  case k of
+addParentScore _ Nothing                                   _ss mapParent = mapParent
+addParentScore (KeepAllParents keep) (Just (NgramsTerm p')) ss mapParent =
+  case keep of
     True  -> Map.alter addCount p' mapParent
     False -> case Set.member p' ss of
                False -> mapParent

src/Gargantext/Core/Viz/Chart.hs

@@ -31,7 +31,7 @@ import Gargantext.Prelude
 import Gargantext.Core.Text.Metrics.Count (occurrencesWith)
 
 -- Pie Chart
-import Gargantext.API.Ngrams.NTree
+import Gargantext.API.Ngrams.NgramsTree
 import Gargantext.API.Ngrams.Tools
 import Gargantext.Core.Types
 import Gargantext.Database.Action.Flow
@@ -71,7 +71,7 @@ chartData cId nt lt = do
 
 treeData :: FlowCmdM env err m
         => CorpusId -> NgramsType -> ListType
-        -> m [MyTree]
+        -> m [NgramsTree]
 treeData cId nt lt = do
   ls' <- selectNodesWithUsername NodeList userMaster
   ls <- map (_node_id) <$> getListsWithParentId cId

src/Gargantext/Database/Admin/Types/Hyperdata/List.hs

@@ -27,7 +27,7 @@ import Control.Applicative
 
 import Gargantext.Prelude
 import Gargantext.Core.Viz.Types (Histo(..))
-import Gargantext.API.Ngrams.NTree (MyTree)
+import Gargantext.API.Ngrams.NgramsTree (NgramsTree)
 import Gargantext.API.Ngrams.Types (TabType)
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude
 import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metrics)
@@ -38,13 +38,13 @@ data HyperdataList =
                 , _hl_list    :: !(Maybe Text)
                 , _hl_pie     :: !(Map TabType (ChartMetrics Histo))
                 , _hl_scatter :: !(Map TabType Metrics)
-                , _hl_tree    :: !(Map TabType (ChartMetrics [MyTree]))
+                , _hl_tree    :: !(Map TabType (ChartMetrics [NgramsTree]))
                 } deriving (Show, Generic)
   -- HyperdataList { _hl_chart   :: !(Maybe (ChartMetrics Histo))
   --               , _hl_list    :: !(Maybe Text)
   --               , _hl_pie     :: !(Maybe (ChartMetrics Histo))
   --               , _hl_scatter :: !(Maybe Metrics)
-  --               , _hl_tree    :: !(Maybe (ChartMetrics [MyTree]))
+  --               , _hl_tree    :: !(Maybe (ChartMetrics [NgramsTree]))
   --               } deriving (Show, Generic)
 
 defaultHyperdataList :: HyperdataList