[FIX] Map Text -> HashMap NgramsTerm

src/Gargantext/API/Metrics.hs

@@ -20,16 +20,17 @@ module Gargantext.API.Metrics
 
 import Control.Lens
 import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HM
 import Data.Text (Text)
 import Data.Time (UTCTime)
-import Servant
-
+import Data.Vector (Vector)
 import Gargantext.API.HashedResponse
 import Gargantext.API.Ngrams.NgramsTree
 import Gargantext.API.Ngrams.Types
 import Gargantext.API.Prelude (GargServer)
+import Gargantext.Core.Text.Metrics (Scored(..), {-normalizeGlobal,-} normalizeLocal)
 import Gargantext.Core.Types (CorpusId, Limit, ListId, ListType(..))
+import Gargantext.Core.Viz.Chart
+import Gargantext.Core.Viz.Types
 import Gargantext.Database.Action.Flow
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataList(..), hl_chart, hl_pie, hl_scatter, hl_tree)
 import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metric(..), Metrics(..))
@@ -40,9 +41,9 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
-import Gargantext.Core.Text.Metrics (Scored(..), {-normalizeGlobal,-} normalizeLocal)
-import Gargantext.Core.Viz.Chart
-import Gargantext.Core.Viz.Types
+import Servant
+import qualified Data.HashMap.Strict as HM
+import qualified Data.Vector         as Vector
 import qualified Gargantext.Database.Action.Metrics as Metrics
 
 -------------------------------------------------------------
@@ -112,7 +113,7 @@ updateScatter' cId maybeListId tabType maybeLimit = do
   (ngs', scores) <- Metrics.getMetrics cId maybeListId tabType maybeLimit
 
   let
-    metrics      = fmap (\(Scored t s1 s2) -> Metric t s1 s2 (listType t ngs'))
+    metrics      = fmap (\(Scored t s1 s2) -> Metric (unNgramsTerm t) s1 s2 (listType t ngs'))
                  $ fmap normalizeLocal scores
     listType t m = maybe (panic errorMsg) fst $ HM.lookup t m
     errorMsg     = "API.Node.metrics: key absent"
@@ -318,7 +319,7 @@ type TreeApi = Summary " Tree API"
            :> QueryParam  "list"       ListId
            :> QueryParamR "ngramsType" TabType
            :> QueryParamR "listType"   ListType
-           :> Get '[JSON] (HashedResponse (ChartMetrics [NgramsTree]))
+           :> Get '[JSON] (HashedResponse (ChartMetrics (Vector NgramsTree)))
         :<|> Summary "Tree Chart update"
                 :> QueryParam  "list"       ListId
                 :> QueryParamR "ngramsType" TabType
@@ -342,7 +343,7 @@ getTree :: FlowCmdM env err m
         -> Maybe ListId
         -> TabType
         -> ListType
-        -> m (HashedResponse (ChartMetrics [NgramsTree]))
+        -> m (HashedResponse (ChartMetrics (Vector NgramsTree)))
 getTree cId _start _end maybeListId tabType listType = do
   listId <- case maybeListId of
     Just lid -> pure lid
@@ -378,15 +379,15 @@ updateTree' :: FlowCmdM env err m =>
   -> Maybe ListId
   -> TabType
   -> ListType
-  -> m (ChartMetrics [NgramsTree])
+  -> m (ChartMetrics (Vector NgramsTree))
 updateTree' cId maybeListId tabType listType = do
   listId <- case maybeListId of
     Just lid -> pure lid
     Nothing  -> defaultList cId
 
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
-  let hl = node ^. node_hyperdata
-      treeMap = hl ^. hl_tree
+  let hl      = node ^. node_hyperdata
+      treeMap = hl  ^. hl_tree
   t <- treeData cId (ngramsTypeFromTabType tabType) listType
   _ <- updateHyperdata listId $ hl { _hl_tree = HM.insert tabType (ChartMetrics t) treeMap }
 

src/Gargantext/API/Ngrams.hs

@@ -535,7 +535,7 @@ getTableNgrams _nType nId tabType listId limit_ offset
     setScores :: forall t. Each t t NgramsElement NgramsElement => Bool -> t -> m t
     setScores False table = pure table
     setScores True  table = do
-      let ngrams_terms = unNgramsTerm <$> (table ^.. each . ne_ngrams)
+      let ngrams_terms = table ^.. each . ne_ngrams
       t1 <- getTime'
       occurrences <- getOccByNgramsOnlyFast' nId
                                              listId
@@ -552,7 +552,7 @@ getTableNgrams _nType nId tabType listId limit_ offset
                                             ngrams_terms
       -}
       let
-        setOcc ne = ne & ne_occurrences .~ sumOf (at (unNgramsTerm (ne ^. ne_ngrams)) . _Just) occurrences
+        setOcc ne = ne & ne_occurrences .~ sumOf (at (ne ^. ne_ngrams) . _Just) occurrences
 
       pure $ table & each %~ setOcc
     ---------------------------------------
@@ -594,13 +594,13 @@ scoresRecomputeTableNgrams nId tabType listId = do
 
     setScores :: forall t. Each t t NgramsElement NgramsElement => t -> m t
     setScores table = do
-      let ngrams_terms = unNgramsTerm <$> (table ^.. each . ne_ngrams)
+      let ngrams_terms = table ^.. each . ne_ngrams
       occurrences <- getOccByNgramsOnlyFast' nId
                                              listId
                                             ngramsType
                                             ngrams_terms
       let
-        setOcc ne = ne & ne_occurrences .~ sumOf (at (unNgramsTerm (ne ^. ne_ngrams)) . _Just) occurrences
+        setOcc ne = ne & ne_occurrences .~ sumOf (at (ne ^. ne_ngrams) . _Just) occurrences
 
       pure $ table & each %~ setOcc
 

src/Gargantext/API/Ngrams/NgramsTree.hs

@@ -15,23 +15,23 @@ module Gargantext.API.Ngrams.NgramsTree
   where
 
 import Data.Aeson.TH (deriveJSON)
-import Data.Text (Text)
-import Data.Tree
-import Data.Maybe (catMaybes)
+import Data.HashMap.Strict (HashMap)
 import Data.Map (Map)
+import Data.Maybe (catMaybes)
 import Data.Set (Set)
 import Data.Swagger
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-import qualified Data.List as List
+import Data.Text (Text)
+import Data.Tree
 import GHC.Generics (Generic)
-import Test.QuickCheck
-
-import Gargantext.Prelude
-
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types (ListType(..), NodeId)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Prelude
+import Test.QuickCheck
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.List as List
+import qualified Data.Map as Map
+import qualified Data.Set as Set
 
 type Children = Text
 type Root = Text
@@ -42,8 +42,8 @@ data NgramsTree = NgramsTree { mt_label :: Text
                              }
     deriving (Generic, Show)
 
-toNgramsTree :: Tree (Text,Double) -> NgramsTree
-toNgramsTree (Node (l,v) xs) = NgramsTree l v (map toNgramsTree xs)
+toNgramsTree :: Tree (NgramsTerm,Double) -> NgramsTree
+toNgramsTree (Node (NgramsTerm l,v) xs) = NgramsTree l v (map toNgramsTree xs)
 
 deriveJSON (unPrefix "mt_") ''NgramsTree
 
@@ -53,24 +53,27 @@ instance Arbitrary NgramsTree
   where
     arbitrary = NgramsTree <$> arbitrary <*> arbitrary <*> arbitrary
 
-toTree :: ListType -> Map Text (Set NodeId) -> Map Text NgramsRepoElement -> [NgramsTree]
+toTree :: ListType
+       -> HashMap NgramsTerm (Set NodeId)
+       -> HashMap NgramsTerm 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)))
-                        (Map.lookup r m)
+                        (\x -> ((r, value r), mSetToList $ _nre_children x))
+                        (HashMap.lookup r m)
 
-    value l = maybe 0 (fromIntegral . Set.size) $ Map.lookup l vs
+    value l = maybe 0 (fromIntegral . Set.size) $ HashMap.lookup l vs
 
     rootsCandidates :: [NgramsTerm]
     rootsCandidates = catMaybes
                     $ List.nub
                     $ map (\(c, c') -> case _nre_root c' of
-                                       Nothing -> Just $ NgramsTerm c
-                                       _ -> _nre_root c') (Map.toList m)
+                                       Nothing -> Just c
+                                       _ -> _nre_root c') (HashMap.toList m)
 
     roots = map fst
           $ filter (\(_,l) -> l == lt)
           $ catMaybes
-          $ map (\c -> (,) <$> Just c <*> (_nre_list <$> Map.lookup c m))
-          $ (unNgramsTerm <$> rootsCandidates)
+          $ map (\c -> (,) <$> Just c <*> (_nre_list <$> HashMap.lookup c m))
+          $ rootsCandidates

src/Gargantext/API/Ngrams/Tools.hs

@@ -17,21 +17,20 @@ module Gargantext.API.Ngrams.Tools
 import Control.Concurrent
 import Control.Lens (_Just, (^.), at, view, At, Index, IxValue)
 import Control.Monad.Reader
-import Data.Hashable (Hashable)
 import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HM
-import Gargantext.Data.HashMap.Strict.Utils as HM
+import Data.Hashable (Hashable)
 import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
 import Data.Set (Set)
 import Data.Text (Text)
 import Data.Validity
-
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types (ListType(..), NodeId, ListId)
 import Gargantext.Database.Schema.Ngrams (NgramsType)
 import Gargantext.Prelude
+import qualified Data.HashMap.Strict as HM
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import qualified Gargantext.Data.HashMap.Strict.Utils as HM
 
 mergeNgramsElement :: NgramsRepoElement -> NgramsRepoElement -> NgramsRepoElement
 mergeNgramsElement _neOld neNew = neNew
@@ -44,12 +43,13 @@ getRepo = do
   liftBase $ readMVar v
 
 listNgramsFromRepo :: [ListId] -> NgramsType
-                   -> NgramsRepo -> Map NgramsTerm NgramsRepoElement
+                   -> NgramsRepo -> HashMap NgramsTerm NgramsRepoElement
 listNgramsFromRepo nodeIds ngramsType repo = ngrams
   where
     ngramsMap = repo ^. r_state . at ngramsType . _Just
 
-    ngrams    = Map.unionsWith mergeNgramsElement
+    -- TODO HashMap linked
+    ngrams    = HM.fromList $ Map.toList $ Map.unionsWith mergeNgramsElement
                 [ ngramsMap ^. at nodeId . _Just | nodeId <- nodeIds ]
 
 
@@ -60,7 +60,7 @@ listNgramsFromRepo nodeIds ngramsType repo = ngrams
 --              be properly guarded.
 getListNgrams :: RepoCmdM env err m
               => [ListId] -> NgramsType
-              -> m (Map NgramsTerm NgramsRepoElement)
+              -> m (HashMap NgramsTerm NgramsRepoElement)
 getListNgrams nodeIds ngramsType = listNgramsFromRepo nodeIds ngramsType <$> getRepo
 
 getTermsWith :: (RepoCmdM env err m, Eq a, Hashable a)
@@ -69,8 +69,8 @@ getTermsWith :: (RepoCmdM env err m, Eq a, Hashable a)
           -> m (HashMap a [a])
 getTermsWith f ls ngt lt = HM.fromListWith (<>)
                       <$> map toTreeWith
-                      <$> Map.toList
-                      <$> Map.filter (\f' -> fst f' == lt)
+                      <$> HM.toList
+                      <$> HM.filter (\f' -> fst f' == lt)
                       <$> mapTermListRoot ls ngt
                       <$> getRepo
   where
@@ -81,10 +81,10 @@ getTermsWith f ls ngt lt = HM.fromListWith (<>)
 mapTermListRoot :: [ListId]
                 -> NgramsType
                 -> NgramsRepo
-                -> Map NgramsTerm (ListType, Maybe NgramsTerm)
+                -> HashMap NgramsTerm (ListType, Maybe NgramsTerm)
 mapTermListRoot nodeIds ngramsType repo =
-  (\nre -> (_nre_list nre, _nre_root nre)) <$>
-  listNgramsFromRepo nodeIds ngramsType repo
+      (\nre -> (_nre_list nre, _nre_root nre))
+  <$> listNgramsFromRepo nodeIds ngramsType repo
 
 filterListWithRootHashMap :: ListType
                           -> HashMap NgramsTerm (ListType, Maybe NgramsTerm)
@@ -98,13 +98,13 @@ filterListWithRootHashMap lt m = snd <$> HM.filter isMapTerm m
         Just  (l',_) -> l' == lt
 
 filterListWithRoot :: ListType
-                   -> Map NgramsTerm (ListType, Maybe NgramsTerm)
-                   -> Map NgramsTerm (Maybe RootTerm)
-filterListWithRoot lt m = snd <$> Map.filter isMapTerm m
+                   -> HashMap NgramsTerm (ListType, Maybe NgramsTerm)
+                   -> HashMap NgramsTerm (Maybe RootTerm)
+filterListWithRoot lt m = snd <$> HM.filter isMapTerm m
   where
     isMapTerm (l, maybeRoot) = case maybeRoot of
       Nothing -> l == lt
-      Just  r -> case Map.lookup r m of
+      Just  r -> case HM.lookup r m of
         Nothing -> panic $ "Garg.API.Ngrams.Tools: filterWithRoot, unknown key: " <> unNgramsTerm r
         Just  (l',_) -> l' == lt
 
@@ -126,7 +126,7 @@ groupNodesByNgrams syn occs = HM.fromListWith (<>) occs'
 
 data Diagonal = Diagonal Bool
 
-getCoocByNgrams :: Diagonal -> HashMap Text (Set NodeId) -> HashMap (Text, Text) Int
+getCoocByNgrams :: Diagonal -> HashMap NgramsTerm (Set NodeId) -> HashMap (NgramsTerm, NgramsTerm) Int
 getCoocByNgrams = getCoocByNgrams' identity
 
 
@@ -144,4 +144,4 @@ getCoocByNgrams' f (Diagonal diag) m =
                              listToCombi identity ks
               ]
 
-  where ks = HM.keys m
\ No newline at end of file
+  where ks = HM.keys m

src/Gargantext/API/Ngrams/Types.hs

@@ -47,6 +47,7 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import Protolude (maybeToEither)
 import Gargantext.Prelude
 
+import Gargantext.Prelude.Crypto.Hash (IsHashable(..))
 import Gargantext.Core.Text (size)
 import Gargantext.Core.Types (ListType(..), ListId, NodeId)
 import Gargantext.Core.Types (TODO)
@@ -126,6 +127,12 @@ instance (ToJSONKey a, ToSchema a) => ToSchema (MSet a) where
 newtype NgramsTerm = NgramsTerm { unNgramsTerm :: Text }
   deriving (Ord, Eq, Show, Generic, ToJSONKey, ToJSON, FromJSON, Semigroup, Arbitrary, Serialise, ToSchema, Hashable)
 
+instance IsHashable NgramsTerm where
+  hash (NgramsTerm t) = hash t
+
+instance Monoid NgramsTerm where
+  mempty = NgramsTerm ""
+
 instance FromJSONKey NgramsTerm where
   fromJSONKey = FromJSONKeyTextParser $ \t -> pure $ NgramsTerm $ strip t
 

src/Gargantext/API/Node/Corpus/Export.hs

@@ -42,6 +42,7 @@ import Gargantext.Prelude
 import qualified Data.List as List
 import qualified Data.Map as Map
 import qualified Data.Set as Set
+import qualified Data.HashMap.Strict as HashMap
 
 --------------------------------------------------
 -- | Hashes are ordered by Set
@@ -63,13 +64,13 @@ getCorpus cId lId nt' = do
   ngs  <- getNodeNgrams cId lId nt repo
   let  -- uniqId is hash computed already for each document imported in database
     r = Map.intersectionWith (\a b -> Document a (Ngrams (Set.toList b) (hash b)) (d_hash a b)
-                             ) ns ngs
+                             ) ns (Map.map (Set.map unNgramsTerm) ngs)
           where
             d_hash  a b = hash [ fromMaybe "" (_hd_uniqId $ _node_hyperdata a)
-                                       , hash b
-                                       ]
+                               , hash b
+                               ]
   pure $ Corpus (Map.elems r) (hash $ List.map _d_hash
-                                            $ Map.elems r
+                                    $ Map.elems r
                               )
 
 getNodeNgrams :: HasNodeError err
@@ -77,7 +78,7 @@ getNodeNgrams :: HasNodeError err
         -> Maybe ListId
         -> NgramsType
         -> NgramsRepo
-        -> Cmd err (HashMap NodeId (Set Text))
+        -> Cmd err (Map NodeId (Set NgramsTerm))
 getNodeNgrams cId lId' nt repo = do
   lId <- case lId' of
     Nothing -> defaultList cId
@@ -85,9 +86,10 @@ getNodeNgrams cId lId' nt repo = do
 
   lIds <- selectNodesWithUsername NodeList userMaster
   let ngs = filterListWithRoot MapTerm $ mapTermListRoot [lId] nt repo
-  r <- getNgramsByNodeOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
+  -- TODO HashMap
+  r <- getNgramsByNodeOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
   pure r
 
 -- TODO
 -- Exports List
--- Version number of the list
\ No newline at end of file
+-- Version number of the list

src/Gargantext/Core/Text/List.hs

@@ -16,6 +16,7 @@ module Gargantext.Core.Text.List
   where
 
 import Control.Lens hiding (both) -- ((^.), view, over, set, (_1), (_2))
+import Data.HashMap.Strict (HashMap)
 import Data.Map (Map)
 import Data.Monoid (mempty)
 import Data.Ord (Down(..))
@@ -41,10 +42,11 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
 import Gargantext.Database.Query.Tree.Error (HasTreeError)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Prelude
+import qualified Data.HashMap.Strict as HashMap
 import qualified Data.List as List
 import qualified Data.Map  as Map
 import qualified Data.Set  as Set
-
+import qualified Gargantext.Data.HashMap.Strict.Utils as HashMap
 
 {-
 -- TODO maybe useful for later
@@ -90,13 +92,13 @@ buildNgramsOthersList ::( HasNodeError err
                         -> (NgramsType, MapListSize)
                         -> m (Map NgramsType [NgramsElement])
 buildNgramsOthersList user uCid _groupParams (nt, MapListSize mapListSize) = do
-  allTerms  :: Map Text (Set NodeId) <- getNodesByNgramsUser uCid nt
+  allTerms  :: HashMap NgramsTerm (Set NodeId) <- getNodesByNgramsUser uCid nt
 
   -- | PrivateFirst for first developments since Public NodeMode is not implemented yet
-  socialLists :: FlowCont Text FlowListScores
-    <- flowSocialList MySelfFirst user nt ( FlowCont Map.empty
-                                                      $ Map.fromList
-                                                      $ List.zip (Map.keys allTerms)
+  socialLists :: FlowCont NgramsTerm FlowListScores
+    <- flowSocialList MySelfFirst user nt ( FlowCont HashMap.empty
+                                                      $ HashMap.fromList
+                                                      $ List.zip (HashMap.keys allTerms)
                                                                  (List.cycle [mempty])
                                            )
 {-
@@ -113,22 +115,22 @@ buildNgramsOthersList user uCid _groupParams (nt, MapListSize mapListSize) = do
 -}
 
   let
-    (stopTerms, tailTerms) = Map.partition ((== Just StopTerm) . viewListType)
+    (stopTerms, tailTerms) = HashMap.partition ((== Just StopTerm) . viewListType)
                            $ view flc_scores groupedWithList
 
-    (mapTerms, tailTerms') = Map.partition ((== Just MapTerm)  . viewListType) tailTerms
+    (mapTerms, tailTerms') = HashMap.partition ((== Just MapTerm)  . viewListType) tailTerms
 
     listSize = mapListSize - (List.length mapTerms)
-    (mapTerms', candiTerms) = both Map.fromList
+    (mapTerms', candiTerms) = both HashMap.fromList
                             $ List.splitAt listSize
                             $ List.sortOn (Down . viewScore . snd)
-                            $ Map.toList tailTerms'
+                            $ HashMap.toList tailTerms'
 
   pure $ Map.fromList [( nt,  (toNgramsElement stopTerms)
-                           <> (toNgramsElement mapTerms )
-                           <> (toNgramsElement $ setListType (Just MapTerm      ) mapTerms' )
-                           <> (toNgramsElement $ setListType (Just CandidateTerm) candiTerms)
-                      )]
+                             <> (toNgramsElement mapTerms )
+                             <> (toNgramsElement $ setListType (Just MapTerm      ) mapTerms' )
+                             <> (toNgramsElement $ setListType (Just CandidateTerm) candiTerms)
+                          )]
 
 
 -- TODO use ListIds
@@ -147,23 +149,23 @@ buildNgramsTermsList user uCid mCid groupParams (nt, _mapListSize)= do
 
 -- | Filter 0 With Double
 -- Computing global speGen score
-  allTerms :: Map Text Double <- getTficf uCid mCid nt
+  allTerms :: HashMap NgramsTerm Double <- getTficf uCid mCid nt
 
   -- | PrivateFirst for first developments since Public NodeMode is not implemented yet
-  socialLists :: FlowCont Text FlowListScores
-    <- flowSocialList MySelfFirst user nt ( FlowCont Map.empty
-                                                      $ Map.fromList
-                                                      $ List.zip (Map.keys   allTerms)
-                                                                 (List.cycle [mempty])
+  socialLists :: FlowCont NgramsTerm FlowListScores
+    <- flowSocialList MySelfFirst user nt ( FlowCont HashMap.empty
+                                                      $ HashMap.fromList
+                                                      $ List.zip (HashMap.keys   allTerms)
+                                                                 (List.cycle     [mempty])
                                            )
 
-  let socialLists_Stemmed = addScoreStem groupParams (Set.map NgramsTerm $ Map.keysSet allTerms) socialLists
+  let socialLists_Stemmed = addScoreStem groupParams (HashMap.keysSet allTerms) socialLists
   printDebug "socialLists_Stemmed" socialLists_Stemmed
   let groupedWithList = toGroupedTree {- groupParams -} socialLists_Stemmed allTerms
-      (stopTerms, candidateTerms) = Map.partition ((== Just StopTerm) . viewListType)
+      (stopTerms, candidateTerms) = HashMap.partition ((== Just StopTerm) . viewListType)
                                   $ view flc_scores groupedWithList
 
-      (groupedMono, groupedMult)  = Map.partitionWithKey (\t _v -> size t < 2) candidateTerms
+      (groupedMono, groupedMult)  = HashMap.partitionWithKey (\(NgramsTerm t) _v -> size t < 2) candidateTerms
 
   -- printDebug "stopTerms" stopTerms
 
@@ -174,10 +176,10 @@ buildNgramsTermsList user uCid mCid groupParams (nt, _mapListSize)= do
     monoSize = 0.4  :: Double
     multSize = 1 - monoSize
 
-    splitAt n' ns = both (Map.fromListWith (<>))
+    splitAt n' ns = both (HashMap.fromListWith (<>))
                   $ List.splitAt (round $ n' * listSizeGlobal)
                   $ List.sortOn (viewScore . snd)
-                  $ Map.toList ns
+                  $ HashMap.toList ns
 
     (groupedMonoHead, groupedMonoTail) = splitAt monoSize groupedMono
     (groupedMultHead, groupedMultTail) = splitAt multSize groupedMult
@@ -198,30 +200,32 @@ buildNgramsTermsList user uCid mCid groupParams (nt, _mapListSize)= do
                                             selectedTerms
 
   let
-    groupedTreeScores_SetNodeId :: HashMap Text (GroupedTreeScores (Set NodeId))
+    groupedTreeScores_SetNodeId :: HashMap NgramsTerm (GroupedTreeScores (Set NodeId))
     groupedTreeScores_SetNodeId = setScoresWithMap mapTextDocIds (groupedMonoHead <> groupedMultHead)
 
   -- | Coocurrences computation
   --, t1 >= t2 -- permute byAxis diag  -- since matrix symmetric
-  let mapCooc = HM.filter (>2)
-             $ HM.fromList [ ((t1, t2), Set.size $ Set.intersection s1 s2)
+  let mapCooc = HashMap.filter (>2)
+              $ HashMap.fromList [ ((t1, t2), Set.size $ Set.intersection s1 s2)
                            | (t1, s1) <- mapStemNodeIds
                            , (t2, s2) <- mapStemNodeIds
                            ]
           where
-            mapStemNodeIds = HM.toList
-                           $ HM.map viewScores
+            mapStemNodeIds = HashMap.toList
+                           $ HashMap.map viewScores
                            $ groupedTreeScores_SetNodeId
   let
     -- computing scores
-    mapScores f = Map.fromList
+    mapScores f = HashMap.fromList
                 $ map (\g -> (view scored_terms g, f g))
                 $ normalizeGlobal
                 $ map normalizeLocal
-                $ scored' mapCooc
+                $ scored'
+                $ Map.fromList -- TODO remove this
+                $ HashMap.toList mapCooc
 
   let
-    groupedTreeScores_SpeGen :: Map Text (GroupedTreeScores (Scored Text))
+    groupedTreeScores_SpeGen :: HashMap NgramsTerm (GroupedTreeScores (Scored NgramsTerm))
     groupedTreeScores_SpeGen = setScoresWithMap (mapScores identity)
                                                 (  groupedMonoHead
                                                 <> groupedMultHead
@@ -230,10 +234,10 @@ buildNgramsTermsList user uCid mCid groupParams (nt, _mapListSize)= do
   let
     -- sort / partition / split
     -- filter mono/multi again
-    (monoScored, multScored) = Map.partitionWithKey (\t _v -> size t < 2) groupedTreeScores_SpeGen
+    (monoScored, multScored) = HashMap.partitionWithKey (\(NgramsTerm t) _v -> size t < 2) groupedTreeScores_SpeGen
 
       -- filter with max score
-    partitionWithMaxScore = Map.partition (\g -> (view scored_genInc $ view gts'_score g)
+    partitionWithMaxScore = HashMap.partition (\g -> (view scored_genInc $ view gts'_score g)
                                                > (view scored_speExc $ view gts'_score g)
                                           )
 
@@ -247,8 +251,8 @@ buildNgramsTermsList user uCid mCid groupParams (nt, _mapListSize)= do
     inclSize = 0.4  :: Double
     exclSize = 1 - inclSize
 
-    splitAt' n' = (both (Map.fromList)) . (List.splitAt (round $ n' * listSizeLocal))
-    sortOn   f  = (List.sortOn (Down . (view (gts'_score . f)) . snd)) . Map.toList
+    splitAt' n' = (both (HashMap.fromList)) . (List.splitAt (round $ n' * listSizeLocal))
+    sortOn   f  = (List.sortOn (Down . (view (gts'_score . f)) . snd)) . HashMap.toList
 
 
     monoInc_size = splitAt' $ monoSize * inclSize / 2
@@ -259,9 +263,7 @@ buildNgramsTermsList user uCid mCid groupParams (nt, _mapListSize)= do
     (multScoredInclHead, multScoredInclTail) = multExc_size $ (sortOn scored_genInc) multScoredIncl
     (multScoredExclHead, multScoredExclTail) = multExc_size $ (sortOn scored_speExc) multScoredExcl
 
-
 ------------------------------------------------------------
-
     -- Final Step building the Typed list
     termListHead = maps <> cands
       where

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

@@ -19,48 +19,50 @@ module Gargantext.Core.Text.List.Group
   where
 
 import Control.Lens (view)
+import Data.HashMap.Strict (HashMap)
 import Data.Map (Map)
 import Data.Maybe (fromMaybe)
 import Data.Monoid (Monoid, mempty)
 import Data.Text (Text)
-import Gargantext.Core.Text.List.Social.Prelude
+import Gargantext.API.Ngrams.Types (NgramsTerm(..))
 import Gargantext.Core.Text.List.Group.Prelude
 import Gargantext.Core.Text.List.Group.WithScores
+import Gargantext.Core.Text.List.Social.Prelude
 import Gargantext.Prelude
-import qualified Data.Map  as Map
-
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.Map            as Map
 ------------------------------------------------------------------------
 toGroupedTree :: (Ord a, Monoid a)
-              => FlowCont Text FlowListScores
-              -> Map Text a
-              -> FlowCont Text (GroupedTreeScores a)
+              => FlowCont NgramsTerm FlowListScores
+              -> HashMap NgramsTerm a
+              -> FlowCont NgramsTerm (GroupedTreeScores a)
 toGroupedTree flc scores =
   groupWithScores' flc scoring
     where
-      scoring t = fromMaybe mempty $ Map.lookup t scores
+      scoring t = fromMaybe mempty $ HashMap.lookup t scores
 
 
 ------------------------------------------------------------------------
-setScoresWithMap :: (Ord a, Ord b, Monoid b) => Map Text b
-                 -> Map Text (GroupedTreeScores a)
-                 -> Map Text (GroupedTreeScores b)
+setScoresWithMap :: (Ord a, Ord b, Monoid b) => HashMap NgramsTerm b
+                 -> HashMap NgramsTerm (GroupedTreeScores a)
+                 -> HashMap NgramsTerm (GroupedTreeScores b)
 setScoresWithMap m = setScoresWith (score m)
   where
-    score m' t = case Map.lookup t m' of
+    score m' t = case HashMap.lookup t m' of
       Nothing -> mempty
       Just  r -> r
 
 setScoresWith :: (Ord a, Ord b)
-              => (Text -> b)
-              -> Map Text (GroupedTreeScores a)
-              -> Map Text (GroupedTreeScores b)
+              => (NgramsTerm -> b)
+              -> HashMap NgramsTerm (GroupedTreeScores a)
+              -> HashMap NgramsTerm (GroupedTreeScores b)
 {-
 -- | This Type level lenses solution does not work
 setScoresWith f = Map.mapWithKey (\k v -> over gts'_children (setScoresWith f)
                                        $  set  gts'_score    (f k) v
                                  )
 -}
-setScoresWith f = Map.mapWithKey (\k v -> v { _gts'_score    = f k
+setScoresWith f = HashMap.mapWithKey (\k v -> v { _gts'_score    = f k
                                             , _gts'_children = setScoresWith f
                                                              $ view gts'_children v
                                             }

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

@@ -17,29 +17,30 @@ module Gargantext.Core.Text.List.Group.Prelude
   where
 
 import Control.Lens (makeLenses, view, set, over)
+import Data.HashMap.Strict (HashMap)
+import Data.Map (Map)
+import Data.Maybe (fromMaybe)
 import Data.Monoid
 import Data.Semigroup
 import Data.Set (Set)
-import Data.Text (Text)
-import Data.Maybe (fromMaybe)
-import Data.Map (Map)
+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.Core.Text.Metrics (Scored(..), scored_genInc)
-import Gargantext.API.Ngrams.Types (NgramsElement, mkNgramsElement, NgramsTerm(..), RootParent(..), mSetFromList)
 import Gargantext.Prelude
-import qualified Data.Set  as Set
-import qualified Data.Map  as Map
+import qualified Data.HashMap.Strict as HashMap
 import qualified Data.List as List
+import qualified Data.Map  as Map
+import qualified Data.Set  as Set
 
-type Stem = Text
+type Stem = NgramsTerm
 ------------------------------------------------------------------------
 -- | Main Types to group With Scores but preserving Tree dependencies
 -- Therefore there is a need of Tree of GroupedTextScores
 -- to target continuation type for the flow (FlowCont Text GroupedTreeScores)
 data GroupedTreeScores score =
   GroupedTreeScores { _gts'_listType :: !(Maybe ListType)
-                    , _gts'_children :: !(Map Text (GroupedTreeScores score))
+                    , _gts'_children :: !(HashMap NgramsTerm (GroupedTreeScores score))
                     , _gts'_score    :: !score
                     } deriving (Show, Ord, Eq)
 
@@ -76,7 +77,7 @@ class ToNgramsElement a where
   toNgramsElement :: a -> [NgramsElement]
 
 class HasTerms a where
-  hasTerms :: a -> Set Text
+  hasTerms :: a -> Set NgramsTerm
 
 ------------------------------------------------------------------------
 -- | Instances declartion for (GroupedTreeScores a)
@@ -87,8 +88,8 @@ instance SetListType (GroupedTreeScores a) where
   setListType lt g = over gts'_children (setListType lt)
                 $ set gts'_listType lt g
 
-instance SetListType (Map Text (GroupedTreeScores a)) where
-  setListType lt = Map.map (set gts'_listType lt)
+instance SetListType (HashMap NgramsTerm (GroupedTreeScores a)) where
+  setListType lt = HashMap.map (set gts'_listType lt)
 
                             ------
 
@@ -99,7 +100,7 @@ instance ViewScores (GroupedTreeScores Double) Double where
   viewScores g = sum $ parent : children
     where
       parent   = view gts'_score g
-      children = map viewScores $ Map.elems $ view gts'_children g
+      children = map viewScores $ HashMap.elems $ view gts'_children g
 
 
 instance ViewScore (GroupedTreeScores (Set NodeId)) Int where
@@ -109,57 +110,55 @@ instance ViewScores (GroupedTreeScores (Set NodeId)) (Set NodeId) where
   viewScores g = Set.unions $ parent : children
     where
       parent   = view gts'_score g
-      children = map viewScores $ Map.elems $ view gts'_children g
+      children = map viewScores $ HashMap.elems $ view gts'_children g
 
 
-instance ViewScore (GroupedTreeScores (Scored Text)) Double where
+instance ViewScore (GroupedTreeScores (Scored NgramsTerm)) Double where
   viewScore = view (gts'_score . scored_genInc)
 
                             ------
-instance HasTerms (Map Text (GroupedTreeScores a)) where
-  hasTerms = Set.unions . (map hasTerms) . Map.toList
+instance HasTerms (HashMap NgramsTerm (GroupedTreeScores a)) where
+  hasTerms = Set.unions . (map hasTerms) . HashMap.toList
 
-instance HasTerms (Text, GroupedTreeScores a) where
+instance HasTerms (NgramsTerm, GroupedTreeScores a) where
   hasTerms (t, g) = Set.singleton t  <> children
     where
       children = Set.unions
                $ map hasTerms
-               $ Map.toList
+               $ HashMap.toList
                $ view gts'_children g
 
                             ------
 
-instance ToNgramsElement (Map Text (GroupedTreeScores a)) where
-  toNgramsElement = List.concat . (map toNgramsElement) . Map.toList
+instance ToNgramsElement (HashMap NgramsTerm (GroupedTreeScores a)) where
+  toNgramsElement = List.concat . (map toNgramsElement) . HashMap.toList
 
 
-instance ToNgramsElement (Text, GroupedTreeScores a) where
+instance ToNgramsElement (NgramsTerm, GroupedTreeScores a) where
   toNgramsElement (t, gts) = parent : children
     where
-      parent = mkNgramsElement (NgramsTerm t)
+      parent = mkNgramsElement t
                                (fromMaybe CandidateTerm $ viewListType gts)
                                Nothing
-                               (mSetFromList $ map NgramsTerm
-                                             $ Map.keys
+                               (mSetFromList $ HashMap.keys
                                              $ view gts'_children gts
                                )
       children = List.concat
-               $ map (childrenWith (NgramsTerm t) (NgramsTerm t) )
-               $ Map.toList
+               $ map (childrenWith t t)
+               $ HashMap.toList
                $ view gts'_children gts
 
       childrenWith root parent' (t', gts') = parent'' : children'
         where
-          parent''   = mkNgramsElement (NgramsTerm t')
+          parent''   = mkNgramsElement t'
                                       (fromMaybe CandidateTerm $ viewListType gts')
                                       (Just $ RootParent root parent')
-                                      (mSetFromList $ map NgramsTerm
-                                                    $ Map.keys
+                                      (mSetFromList $ HashMap.keys
                                                     $ view gts'_children gts'
                                       )
           children' = List.concat
-                    $ map (childrenWith root (NgramsTerm t') )
-                    $ Map.toList
+                    $ map (childrenWith root t' )
+                    $ HashMap.toList
                     $ view gts'_children gts'
 
 

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

@@ -16,23 +16,24 @@ module Gargantext.Core.Text.List.Group.WithScores
   where
 
 import Control.Lens (view, set, over)
-import Data.Semigroup
+import Data.HashMap.Strict (HashMap)
 import Data.Map (Map)
-import Data.Monoid (Monoid, mempty)
 import Data.Maybe (fromMaybe)
-import Data.Text (Text)
-import Gargantext.Core.Text.List.Social.Prelude
+import Data.Monoid (Monoid, mempty)
+import Data.Semigroup
+import Gargantext.API.Ngrams.Types (NgramsTerm(..))
 import Gargantext.Core.Text.List.Group.Prelude
+import Gargantext.Core.Text.List.Social.Prelude
 import Gargantext.Prelude
-import qualified Data.Map  as Map
+import qualified Data.Map            as Map
+import qualified Data.HashMap.Strict as HashMap
 
-------------------------------------------------------------------------
 ------------------------------------------------------------------------
 -- | Main function
 groupWithScores' :: (Eq a, Ord a, Monoid a)
-                => FlowCont Text FlowListScores
-                -> (Text -> a) -- Map Text (a)
-                -> FlowCont Text (GroupedTreeScores 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
@@ -40,28 +41,25 @@ groupWithScores' flc scores = FlowCont  groups orphans
             $ toMapMaybeParent scores
             $ (view flc_scores flc <> view flc_cont flc)
 
-    -- orphans should be filtered already
-    orphans = mempty {- toGroupedTree
-            $ toMapMaybeParent scores
-            $ view flc_cont flc
-            -}
-
+    -- orphans should be filtered already then becomes empty
+    orphans = mempty
+   
 
 ------------------------------------------------------------------------
 toMapMaybeParent :: (Eq a, Ord a, Monoid a)
-                 => (Text -> a)
-                 -> Map Text FlowListScores
-                 -> Map (Maybe Parent) (Map Text (GroupedTreeScores a))
-toMapMaybeParent f =  Map.fromListWith (<>)
+                 => (NgramsTerm -> a)
+                 -> HashMap NgramsTerm FlowListScores
+                 -> HashMap (Maybe Parent) (HashMap NgramsTerm (GroupedTreeScores a))
+toMapMaybeParent f =  HashMap.fromListWith (<>)
                    . (map (fromScores'' f))
-                   .  Map.toList
+                   .  HashMap.toList
 
 fromScores'' :: (Eq a, Ord a, Monoid a)
-             => (Text -> a)
-             -> (Text, FlowListScores)
-             -> (Maybe Parent, Map Text (GroupedTreeScores a))
+             => (NgramsTerm -> a)
+             -> (NgramsTerm, FlowListScores)
+             -> (Maybe Parent, HashMap NgramsTerm (GroupedTreeScores a))
 fromScores'' f' (t, fs) = ( maybeParent
-                          , Map.fromList [( t, set gts'_score (f' t)
+                          , HashMap.fromList [( t, set gts'_score (f' t)
                                              $ set gts'_listType maybeList mempty
                                          )]
                           )
@@ -71,23 +69,23 @@ fromScores'' f' (t, fs) = ( maybeParent
 
 ------------------------------------------------------------------------
 toGroupedTree :: Eq a
-              => Map (Maybe Parent) (Map Text (GroupedTreeScores a))
-              -> Map Parent (GroupedTreeScores a)
-toGroupedTree m = case Map.lookup Nothing m of
+              => HashMap (Maybe Parent) (HashMap NgramsTerm (GroupedTreeScores a))
+              -> HashMap Parent (GroupedTreeScores a)
+toGroupedTree m = case HashMap.lookup Nothing m of
   Nothing  -> mempty
   Just  m' -> toGroupedTree' m m'
 
 
-toGroupedTree' :: Eq a => Map (Maybe Parent) (Map Text (GroupedTreeScores a))
-               -> (Map Text (GroupedTreeScores a))
-               ->  Map Parent (GroupedTreeScores a)
+toGroupedTree' :: Eq a => HashMap (Maybe Parent) (HashMap NgramsTerm (GroupedTreeScores a))
+               -> (HashMap NgramsTerm (GroupedTreeScores a))
+               ->  HashMap Parent (GroupedTreeScores a)
 toGroupedTree' m notEmpty
   | notEmpty == mempty = mempty
-  | otherwise = Map.mapWithKey (addGroup m) notEmpty
+  | otherwise = HashMap.mapWithKey (addGroup m) notEmpty
     where
       addGroup m' k v = over gts'_children ( (toGroupedTree' m')
-                                           . (Map.union ( fromMaybe mempty
-                                                        $ Map.lookup (Just k) m'
+                                           . (HashMap.union ( fromMaybe mempty
+                                                        $ HashMap.lookup (Just k) m'
                                                         )
                                              )
                                            )

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

@@ -17,29 +17,29 @@ Portability : POSIX
 module Gargantext.Core.Text.List.Group.WithStem
   where
 
+import Data.HashSet (HashSet)
 import Data.Map (Map)
 import Data.Maybe (catMaybes)
-import Data.Set (Set)
 import Data.Text (Text)
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core (Lang(..))
 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.List.Social.Prelude
 import Gargantext.Core.Text.Terms.Mono.Stem (stem)
 import Gargantext.Prelude
-import qualified Data.List as List
-import qualified Data.Map  as Map
+import qualified Data.HashSet          as Set
+import qualified Data.List             as List
+import qualified Data.Map              as Map
 import qualified Data.Map.Strict.Patch as PatchMap
-import qualified Data.Patch.Class as Patch (Replace(..))
-import qualified Data.Set  as Set
-import qualified Data.Text as Text
+import qualified Data.Patch.Class      as Patch (Replace(..))
+import qualified Data.Text             as Text
 
 ------------------------------------------------------------------------
 addScoreStem :: GroupParams
-             -> Set NgramsTerm
-             -> FlowCont Text FlowListScores
-             -> FlowCont Text FlowListScores
+             -> HashSet NgramsTerm
+             -> FlowCont NgramsTerm FlowListScores
+             -> FlowCont NgramsTerm FlowListScores
 addScoreStem groupParams ngrams fl = foldl' addScorePatch fl 
                                    $ stemPatches groupParams ngrams
 
@@ -62,36 +62,38 @@ data GroupParams = GroupParams { unGroupParams_lang     :: !Lang
 
 ------------------------------------------------------------------------
 groupWith :: GroupParams
-            -> Text
-            -> Text
+            -> NgramsTerm
+            -> NgramsTerm
 groupWith GroupIdentity  = identity
 groupWith (GroupParams l _m _n _) =
-                    Text.intercalate " "
+                    NgramsTerm
+                  . Text.intercalate " "
                   . map (stem l)
                   -- . take n
                   . List.sort
                   -- . (List.filter (\t -> Text.length t > m))
                   . Text.splitOn " "
                   . Text.replace "-" " "
+                  . unNgramsTerm
 --------------------------------------------------------------------
 stemPatches :: GroupParams
-           -> Set NgramsTerm
+           -> HashSet NgramsTerm
            -> [(NgramsTerm, NgramsPatch)]
 stemPatches groupParams = patches
                         . Map.fromListWith (<>)
-                        . map (\ng@(NgramsTerm t) -> ( groupWith groupParams t
-                                                     , Set.singleton ng)
+                        . map (\ng -> ( groupWith groupParams ng
+                                      , Set.singleton ng)
                               )
                         . Set.toList
 
 -- | For now all NgramsTerm which have same stem
 -- are grouped together
 -- Parent is taken arbitrarly for now (TODO use a score like occ)
-patches :: Map Stem (Set NgramsTerm)
+patches :: Map Stem (HashSet NgramsTerm)
             -> [(NgramsTerm, NgramsPatch)]
 patches = catMaybes . map patch . Map.elems
 
-patch :: Set NgramsTerm
+patch :: HashSet NgramsTerm
            -> Maybe (NgramsTerm, NgramsPatch)
 patch s = case Set.size s > 1 of
   False -> Nothing

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

@@ -26,8 +26,8 @@ import Gargantext.API.Ngrams.Types
 import Gargantext.Prelude
 import Data.Map.Strict.Patch hiding (PatchMap)
 
-type List = Map Text NgramsRepoElement
-type Patch = PatchMap Text (Replace (Maybe NgramsRepoElement))
+type List = Map NgramsTerm NgramsRepoElement
+type Patch = PatchMap NgramsTerm (Replace (Maybe NgramsRepoElement))
 
 -- Question: which version of Patching increment is using the FrontEnd ?
 diffList :: Versioned List -> Versioned List -> Versioned Patch

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

@@ -11,6 +11,7 @@ Portability : POSIX
 module Gargantext.Core.Text.List.Social
   where
 
+import Data.HashMap.Strict (HashMap)
 import Data.Map (Map)
 import Data.Monoid (mconcat)
 import Data.Text (Text)
@@ -56,8 +57,8 @@ flowSocialList :: ( RepoCmdM env err m
                    )
                   => FlowSocialListPriority
                   -> User -> NgramsType
-                  -> FlowCont Text FlowListScores
-                  -> m (FlowCont Text FlowListScores)
+                  -> FlowCont NgramsTerm FlowListScores
+                  -> m (FlowCont NgramsTerm FlowListScores)
 flowSocialList flowPriority user nt flc =
   mconcat <$> mapM (flowSocialListByMode'   user nt flc)
                    (flowSocialListPriority flowPriority)
@@ -69,9 +70,9 @@ flowSocialList flowPriority user nt flc =
                                , HasTreeError err
                                )
                             => User -> NgramsType
-                            -> FlowCont Text FlowListScores
+                            -> FlowCont NgramsTerm FlowListScores
                             -> NodeMode
-                            -> m (FlowCont Text FlowListScores)
+                            -> m (FlowCont NgramsTerm FlowListScores)
       flowSocialListByMode' user' nt' flc' mode =
             findListsId user' mode
         >>= flowSocialListByModeWith nt' flc'
@@ -83,9 +84,9 @@ flowSocialList flowPriority user nt flc =
                                   , HasTreeError err
                                   )
                                => NgramsType
-                               -> FlowCont Text FlowListScores
+                               -> FlowCont NgramsTerm FlowListScores
                                -> [ListId]
-                               -> m (FlowCont Text FlowListScores)
+                               -> m (FlowCont NgramsTerm FlowListScores)
       flowSocialListByModeWith nt'' flc'' listes =
         getHistoryScores History_User nt'' flc'' listes
         {-
@@ -101,13 +102,11 @@ getHistoryScores :: ( RepoCmdM env err m
                     )
                  => History
                  -> NgramsType
-                 -> FlowCont Text FlowListScores
+                 -> FlowCont NgramsTerm FlowListScores
                  -> [ListId]
-                 -> m (FlowCont Text FlowListScores)
-getHistoryScores hist nt fl listes = do
-  hist' <- addScorePatches nt listes fl <$> getHistory hist nt listes
-  -- printDebug "hist" hist'
-  pure hist'
+                 -> m (FlowCont NgramsTerm FlowListScores)
+getHistoryScores hist nt fl listes =
+  addScorePatches nt listes fl <$> getHistory hist nt listes
 
 getHistory :: ( RepoCmdM env err m
               , CmdM     env err m
@@ -117,8 +116,7 @@ getHistory :: ( RepoCmdM env err m
            => History
            -> NgramsType
            -> [ListId]
-           -> m (Map NgramsType (Map ListId [Map NgramsTerm NgramsPatch]))
+           -> m (Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch]))
 getHistory hist nt listes =
   history hist [nt] listes  <$> getRepo
 
-

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

@@ -12,14 +12,16 @@ module Gargantext.Core.Text.List.Social.History
   where
 
 import Control.Lens hiding (cons)
+import Data.HashMap.Strict (HashMap)
 import Data.Map (Map)
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Text.List.Social.Prelude
 import Gargantext.Core.Types (ListId)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Prelude
-import qualified Data.List as List
-import qualified Data.Map.Strict as Map
+import qualified Data.List           as List
+import qualified Data.Map.Strict     as Map
+import qualified Data.HashMap.Strict as HashMap
 
 -- TODO put this in Prelude
 cons :: a -> [a]
@@ -37,7 +39,7 @@ history :: History
         -> [NgramsType]
         -> [ListId]
         -> Repo s NgramsStatePatch
-        -> Map NgramsType (Map ListId [Map NgramsTerm NgramsPatch])
+        -> Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch])
 history History_User t l = clean . (history' t l)
   where
     clean = Map.map (Map.map List.init)
@@ -50,11 +52,10 @@ history History_NotUser t l = clean . (history' t l)
 history _ t l = history' t l
 
 ------------------------------------------------------------------------
-
 history' :: [NgramsType]
         -> [ListId]
         -> Repo s NgramsStatePatch
-        -> Map NgramsType (Map ListId [Map NgramsTerm NgramsPatch])
+        -> Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch])
 history' types lists = merge
                     . map (Map.map ( Map.map cons))
                     . map (Map.map ((Map.filterWithKey (\k _ -> List.elem k lists))))
@@ -63,13 +64,13 @@ history' types lists = merge
                     . view r_history
 
 
-merge :: [Map NgramsType (Map ListId [Map NgramsTerm NgramsPatch])]
-      ->  Map NgramsType (Map ListId [Map NgramsTerm NgramsPatch])
+merge :: [Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch])]
+      ->  Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch])
 merge = Map.unionsWith merge'
   where
-    merge' :: Map ListId [Map NgramsTerm NgramsPatch]
-           -> Map ListId [Map NgramsTerm NgramsPatch]
-           -> Map ListId [Map NgramsTerm NgramsPatch]
+    merge' :: Map ListId [HashMap NgramsTerm NgramsPatch]
+           -> Map ListId [HashMap NgramsTerm NgramsPatch]
+           -> Map ListId [HashMap NgramsTerm NgramsPatch]
     merge' = Map.unionWith (<>)
 
 
@@ -80,9 +81,8 @@ toMap :: PatchMap NgramsType
           )
         -> Map NgramsType
            (Map ListId
-            (Map NgramsTerm NgramsPatch
+            (HashMap NgramsTerm NgramsPatch
             )
            )
-toMap = Map.map (Map.map unNgramsTablePatch) . (Map.map unPatchMap) . unPatchMap
-
+toMap = Map.map (Map.map unNgramsTablePatch) . (Map.map unPatchMapToMap) . unPatchMapToMap
 

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

@@ -13,6 +13,8 @@ module Gargantext.Core.Text.List.Social.Patch
 
 import Control.Lens hiding (cons)
 import Data.Map (Map)
+import Data.Hashable (Hashable)
+import Data.HashMap.Strict (HashMap)
 import Data.Monoid
 import Data.Semigroup
 import Data.Text (Text)
@@ -21,25 +23,26 @@ import Gargantext.Core.Text.List.Social.Prelude
 import Gargantext.Core.Types (ListId)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Prelude
+import qualified Data.Map as Map
 import qualified Data.List as List
-import qualified Data.Map  as Map
-import qualified Data.Patch.Class as Patch (Replace(..))
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.Patch.Class    as Patch (Replace(..))
 
 addScorePatches :: NgramsType -> [ListId]
-               -> FlowCont Text FlowListScores
-               -> Map NgramsType (Map ListId [Map NgramsTerm NgramsPatch])
-               -> FlowCont Text FlowListScores
+               -> FlowCont NgramsTerm FlowListScores
+               -> Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch])
+               -> FlowCont NgramsTerm FlowListScores
 addScorePatches nt listes fl repo = foldl' (addScorePatchesList nt repo) fl listes
 
 
 addScorePatchesList :: NgramsType
-                   -> Map NgramsType (Map ListId [Map NgramsTerm NgramsPatch])
-                   -> FlowCont Text FlowListScores
+                   -> Map NgramsType (Map ListId [HashMap NgramsTerm NgramsPatch])
+                   -> FlowCont NgramsTerm FlowListScores
                    -> ListId
-                   -> FlowCont Text FlowListScores
+                   -> FlowCont NgramsTerm FlowListScores
 addScorePatchesList nt repo fl lid = foldl' addScorePatch fl patches
   where
-    patches = maybe [] (List.concat . (map Map.toList)) patches'
+    patches = maybe [] (List.concat . (map HashMap.toList)) patches'
 
     patches' = do
       lists      <- Map.lookup nt repo
@@ -48,9 +51,9 @@ addScorePatchesList nt repo fl lid = foldl' addScorePatch fl patches
 
 
 
-addScorePatch :: FlowCont Text FlowListScores
+addScorePatch :: FlowCont NgramsTerm FlowListScores
               -> (NgramsTerm , NgramsPatch)
-              -> FlowCont Text FlowListScores
+              -> FlowCont NgramsTerm FlowListScores
 
 {- | Case of changing listType only. Patches look like:
 
@@ -65,59 +68,59 @@ Children are not modified in this specific case.
 -- | Old list get -1 score
 -- New list get +1 score
 -- Hence others lists lay around 0 score
-addScorePatch fl (NgramsTerm t, (NgramsPatch children' (Patch.Replace old_list new_list))) =
+addScorePatch fl (t, (NgramsPatch children' (Patch.Replace old_list new_list))) =
   -- | Adding New Children score
-  addScorePatch fl' (NgramsTerm t, NgramsPatch children' Patch.Keep)
+  addScorePatch fl' (t, NgramsPatch children' Patch.Keep)
     where
       -- | Adding New ListType score
       fl' = fl & flc_scores . at t %~ (score fls_listType old_list (-1))
           & flc_scores . at t %~ (score fls_listType new_list ( 1))
-          & flc_cont   %~ (Map.delete t)
+          & flc_cont   %~ (HashMap.delete t)
 
 -- | Patching existing Ngrams with children
-addScorePatch fl (NgramsTerm p, NgramsPatch children' Patch.Keep) =
+addScorePatch fl (p, NgramsPatch children' Patch.Keep) =
   foldl' addChild fl $ patchMSet_toList children'
     where
       -- | Adding a child
-      addChild fl' (NgramsTerm t, Patch.Replace Nothing (Just _)) = doLink ( 1) p t fl'
+      addChild fl' (t, Patch.Replace Nothing (Just _)) = doLink ( 1) p t fl'
       -- | Removing a child
-      addChild fl' (NgramsTerm t, Patch.Replace (Just _) Nothing) = doLink (-1) p t fl'
+      addChild fl' (t, Patch.Replace (Just _) Nothing) = doLink (-1) p t fl'
 
       -- | This case should not happen: does Nothing
       addChild fl' _ = fl'
 
 -- | Inserting a new Ngrams
-addScorePatch fl (NgramsTerm t, NgramsReplace Nothing (Just nre)) =
+addScorePatch fl (t, NgramsReplace Nothing (Just nre)) =
   childrenScore 1 t (nre ^. nre_children) 
   $ fl & flc_scores . at t %~ (score fls_listType $ nre ^. nre_list) 1
-       & flc_cont   %~ (Map.delete t)
+       & flc_cont   %~ (HashMap.delete t)
 
-addScorePatch fl (NgramsTerm t, NgramsReplace (Just old_nre) maybe_new_nre) =
+addScorePatch fl (t, NgramsReplace (Just old_nre) maybe_new_nre) =
   let fl' = childrenScore (-1) t (old_nre ^. nre_children) 
             $ fl & flc_scores . at t %~ (score fls_listType $ old_nre ^. nre_list) (-1)
-                 & flc_cont   %~ (Map.delete t)
+                 & flc_cont   %~ (HashMap.delete t)
     in case maybe_new_nre of
       Nothing      -> fl'
-      Just new_nre -> addScorePatch fl' (NgramsTerm t, NgramsReplace Nothing (Just new_nre))
+      Just new_nre -> addScorePatch fl' (t, NgramsReplace Nothing (Just new_nre))
 
-addScorePatch fl (NgramsTerm _, NgramsReplace Nothing Nothing) = fl
+addScorePatch fl (_, NgramsReplace Nothing Nothing) = fl
 
 -------------------------------------------------------------------------------
 -- | Utils
 childrenScore :: Int
-              -> Text
+              -> NgramsTerm
               -> MSet NgramsTerm
-              -> FlowCont Text FlowListScores
-              -> FlowCont Text FlowListScores
+              -> FlowCont NgramsTerm FlowListScores
+              -> FlowCont NgramsTerm FlowListScores
 childrenScore n parent children' fl =
   foldl' add' fl $ unMSet children'
     where
-        add' fl' (NgramsTerm t) = doLink n parent t fl'
+        add' fl' t = doLink n parent t fl'
 
 ------------------------------------------------------------------------
-doLink :: Ord a
+doLink :: (Ord a, Hashable a)
        => Int
-       -> Text
+       -> NgramsTerm
        -> a
        -> FlowCont a FlowListScores
        -> FlowCont a FlowListScores
@@ -134,8 +137,8 @@ score field list n m = (Just mempty <> m)
                      %~ (<> Just n)
 
 ------------------------------------------------------------------------
-patchMSet_toList :: Ord a => PatchMSet a -> [(a,AddRem)]
-patchMSet_toList = Map.toList . unPatchMap . unPatchMSet
+patchMSet_toList :: (Ord a, Hashable a) => PatchMSet a -> [(a,AddRem)]
+patchMSet_toList = HashMap.toList . unPatchMapToHashMap . unPatchMSet
 
 unMSet :: MSet a -> [a]
 unMSet (MSet a) = Map.keys a

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

@@ -20,6 +20,8 @@ module Gargantext.Core.Text.List.Social.Prelude
 
 import Control.Lens
 import Data.Map (Map)
+import Data.HashMap.Strict (HashMap)
+import Data.Hashable (Hashable)
 import Data.Monoid
 import Data.Semigroup (Semigroup(..))
 import Data.Text (Text)
@@ -28,23 +30,25 @@ import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Text.Metrics.Freq (getMaxFromMap)
 import Gargantext.Core.Types.Main
 import Gargantext.Prelude
-import qualified Data.Map   as Map
+import qualified Gargantext.Data.HashMap.Strict.Utils as HashMap
+import qualified Data.Map.Strict       as Map
+import qualified Data.HashMap.Strict   as HashMap
 import qualified Data.Map.Strict.Patch as PatchMap
 
 ------------------------------------------------------------------------
-type Parent = Text
+type Parent = NgramsTerm
 ------------------------------------------------------------------------
 -- | DataType inspired by continuation Monad (but simpler)
 data FlowCont a b =
-  FlowCont { _flc_scores :: Map a b
-           , _flc_cont   :: Map a b
+  FlowCont { _flc_scores :: HashMap a b
+           , _flc_cont   :: HashMap a b
            }
     deriving (Show)
 
-instance (Ord a, Eq b) => Monoid (FlowCont a b) where
+instance (Ord a, Eq b, Hashable a) => Monoid (FlowCont a b) where
   mempty = FlowCont mempty mempty
 
-instance (Eq a, Ord a, Eq b) => Semigroup (FlowCont a b) where
+instance (Eq a, Ord a, Eq b, Hashable a) => Semigroup (FlowCont a b) where
   (<>) (FlowCont  m1    s1)
        (FlowCont  m2    s2)
       = FlowCont (m1 <> m2)
@@ -54,10 +58,10 @@ makeLenses ''FlowCont
 
 -- | Datatype definition
 data FlowListScores =
-  FlowListScores { _fls_listType :: Map ListType Int
-                 , _fls_parents  :: Map Parent   Int
+  FlowListScores { _fls_listType :: HashMap ListType Int
+                 , _fls_parents  :: HashMap Parent   Int
                 -- You can add any score by incrementing this type
-                -- , _flc_score   :: Map Score Int
+                -- , _flc_score   :: HashMap Score Int
                  }
     deriving (Show, Generic, Eq)
 
@@ -75,16 +79,16 @@ instance Semigroup FlowListScores where
                        (l1 <> l2)
 
 instance Monoid FlowListScores where
-  mempty = FlowListScores Map.empty Map.empty
+  mempty = FlowListScores HashMap.empty HashMap.empty
 
 ------------------------------------------------------------------------
 -- | Tools to inherit groupings
 ------------------------------------------------------------------------
 -- | Tools
-parentUnionsMerge :: (Ord a, Ord b, Num c)
-                   => [Map a (Map b c)]
-                   ->  Map a (Map b c)
-parentUnionsMerge = Map.unionsWith (Map.unionWith (+))
+parentUnionsMerge :: (Ord a, Ord b, Num c, Hashable a, Hashable b)
+                   => [HashMap a (HashMap b c)]
+                   ->  HashMap a (HashMap b c)
+parentUnionsMerge = HashMap.unionsWith (HashMap.unionWith (+))
 
 -- This Parent union is specific
 -- [Private, Shared, Public]
@@ -92,10 +96,10 @@ parentUnionsMerge = Map.unionsWith (Map.unionWith (+))
 -- Private > Shared > Public
 -- if data have not been tagged privately, then use others tags
 -- This unions behavior takes first key only and ignore others
-parentUnionsExcl :: Ord a
-                 => [Map a b]
-                 ->  Map a b
-parentUnionsExcl = Map.unions
+parentUnionsExcl :: (Ord a, Hashable a)
+                 => [HashMap a b]
+                 ->  HashMap a b
+parentUnionsExcl = HashMap.unions
 
 ------------------------------------------------------------------------
 -- | Takes key with max value if and only if value > 0
@@ -107,27 +111,29 @@ parentUnionsExcl = Map.unions
 -- Nothing
 -- TODO duplicate with getMaxFromMap and improve it (lookup value should not be needed)
 -- TODO put in custom Prelude
-keyWithMaxValue :: (Ord a, Ord b, Num b)
-                => Map a b -> Maybe a
+keyWithMaxValue :: (Ord a, Ord b, Num b, Hashable a)
+                => HashMap a b -> Maybe a
 keyWithMaxValue m = do
-  maxKey   <- headMay $ getMaxFromMap m
-  maxValue <- Map.lookup maxKey m
+  maxKey   <- headMay $ HashMap.getKeyWithMaxValue m
+  maxValue <- HashMap.lookup maxKey m
   if maxValue > 0
      then pure maxKey
      else Nothing
 
 
-findMax :: (Ord b, Num b) => Map a b -> Maybe (a,b)
-findMax m = case Map.null m of
+findMax :: (Ord b, Num b, Hashable a) => HashMap a b -> Maybe (a,b)
+findMax m = case HashMap.null m of
   True  -> Nothing
-  False -> Just $ Map.findMax m
+  False -> Just $ HashMap.findMax m
 
 
 ------------------------------------------------------------------------
-unPatchMap :: Ord a => PatchMap a b -> Map a b
-unPatchMap = Map.fromList . PatchMap.toList
+unPatchMapToHashMap :: (Ord a, Hashable a) => PatchMap a b -> HashMap a b
+unPatchMapToHashMap = HashMap.fromList . PatchMap.toList
 
-unNgramsTablePatch :: NgramsTablePatch -> Map NgramsTerm NgramsPatch
-unNgramsTablePatch (NgramsTablePatch p) = unPatchMap p
+unPatchMapToMap :: Ord a => PatchMap a b -> Map a b
+unPatchMapToMap = Map.fromList . PatchMap.toList
 
+unNgramsTablePatch :: NgramsTablePatch -> HashMap NgramsTerm NgramsPatch
+unNgramsTablePatch (NgramsTablePatch p) = unPatchMapToHashMap p
 

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

@@ -18,73 +18,74 @@ module Gargantext.Core.Text.List.Social.Scores
   where
 
 import Control.Lens
-import Data.Map (Map)
+import Data.HashMap.Strict (HashMap)
 import Data.Monoid (mempty)
 import Data.Set (Set)
 import Data.Text (Text)
 import Gargantext.API.Ngrams.Types
-import Gargantext.Core.Types.Main
 import Gargantext.Core.Text.List.Social.Prelude
+import Gargantext.Core.Types.Main
 import Gargantext.Prelude
-import qualified Data.Map   as Map
+import qualified Gargantext.Data.HashMap.Strict.Utils as HashMap
+import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Set   as Set
 
 ------------------------------------------------------------------------
--- | Generates Score from list of Map Text NgramsRepoElement
+-- | Generates Score from list of HashMap Text NgramsRepoElement
 toFlowListScores :: KeepAllParents
-                 ->  FlowCont Text FlowListScores
-                 -> [Map Text NgramsRepoElement]
-                 ->  FlowCont Text FlowListScores
+                 ->  FlowCont NgramsTerm FlowListScores
+                 -> [HashMap NgramsTerm NgramsRepoElement]
+                 ->  FlowCont NgramsTerm FlowListScores
 toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) mempty
 
   where
     toFlowListScores_Level1 :: KeepAllParents
-                            -> FlowCont Text FlowListScores
-                            -> FlowCont Text FlowListScores
-                            -> Map Text NgramsRepoElement
-                            -> FlowCont Text FlowListScores
+                            -> FlowCont NgramsTerm FlowListScores
+                            -> FlowCont NgramsTerm FlowListScores
+                            -> HashMap NgramsTerm NgramsRepoElement
+                            -> FlowCont NgramsTerm 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')
+                 (Set.fromList $ HashMap.keys $ view flc_cont flc_origin')
 
     toFlowListScores_Level2 :: KeepAllParents
-                            -> Map Text NgramsRepoElement
-                            -> FlowCont Text FlowListScores
-                            -> FlowCont Text FlowListScores
-                            -> Text
-                            -> FlowCont Text FlowListScores
+                            -> HashMap NgramsTerm NgramsRepoElement
+                            -> FlowCont NgramsTerm FlowListScores
+                            -> FlowCont NgramsTerm FlowListScores
+                            -> NgramsTerm
+                            -> FlowCont NgramsTerm 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'
+      case HashMap.lookup t ngramsRepo of
+        Nothing  -> over flc_cont   (HashMap.union $ HashMap.singleton t mempty) flc_dest'
         Just nre -> updateScoresParent k'' ngramsRepo nre flc_origin''
                   $ updateScores       k'' t nre setText flc_dest'
           where
             setText = Set.fromList
-                    $ Map.keys
+                    $ HashMap.keys
                     $ view flc_cont flc_origin''
 
 
-    updateScoresParent :: KeepAllParents -> Map Text NgramsRepoElement -> NgramsRepoElement
-                 -> FlowCont Text FlowListScores
-                 -> FlowCont Text FlowListScores
-                 -> FlowCont Text FlowListScores
+    updateScoresParent :: KeepAllParents -> HashMap NgramsTerm NgramsRepoElement -> NgramsRepoElement
+                       -> FlowCont NgramsTerm FlowListScores
+                       -> FlowCont NgramsTerm FlowListScores
+                       -> FlowCont NgramsTerm FlowListScores
     updateScoresParent keep@(KeepAllParents k''') ngramsRepo nre flc_origin'' flc_dest'' = case k''' of
                   False -> flc_dest''
                   True  -> case view nre_parent nre of
-                    Nothing                  -> flc_dest''
-                    Just (NgramsTerm parent) -> toFlowListScores_Level2 keep ngramsRepo flc_origin'' flc_dest'' parent
+                    Nothing     -> flc_dest''
+                    Just parent -> toFlowListScores_Level2 keep ngramsRepo flc_origin'' flc_dest'' parent
 
 
 ------------------------------------------------------------------------
 updateScores :: KeepAllParents
-             -> Text -> NgramsRepoElement -> Set Text
-             -> FlowCont Text FlowListScores
-             -> FlowCont Text FlowListScores
+             -> NgramsTerm -> NgramsRepoElement -> Set NgramsTerm
+             -> FlowCont NgramsTerm FlowListScores
+             -> FlowCont NgramsTerm FlowListScores
 updateScores k t nre setText mtf =
-    over flc_cont   ( Map.delete t)
-  $ over flc_scores ((Map.alter (addParent k nre setText  ) t)
-                    .(Map.alter (addList $ view nre_list nre) t)
+    over flc_cont   ( HashMap.delete t)
+  $ over flc_scores ((HashMap.alter (addParent k nre setText  ) t)
+                    .(HashMap.alter (addList $ view nre_list nre) t)
                     ) mtf
 
 ------------------------------------------------------------------------
@@ -103,8 +104,8 @@ addList l (Just fls) =
 -- "the addList function looks like an ASCII bird"
 
 -- | Concrete function to pass to PatchMap
-addListScore :: ListType -> Map ListType Int -> Map ListType Int
-addListScore l m = Map.alter (plus l) l  m
+addListScore :: ListType -> HashMap ListType Int -> HashMap ListType Int
+addListScore l m = HashMap.alter (plus l) l  m
   where
     plus CandidateTerm Nothing  = Just 1
     plus CandidateTerm (Just x) = Just $ x + 1
@@ -118,7 +119,7 @@ addListScore l m = Map.alter (plus l) l  m
 ------------------------------------------------------------------------
 data KeepAllParents = KeepAllParents Bool
 
-addParent :: KeepAllParents -> NgramsRepoElement -> Set Text
+addParent :: KeepAllParents -> NgramsRepoElement -> Set NgramsTerm
           -> Maybe FlowListScores
           -> Maybe FlowListScores
 
@@ -133,16 +134,16 @@ addParent k nre ss (Just fls{-(FlowListScores mapList mapParent)-}) =
 addParentScore :: Num a
            => KeepAllParents
            -> Maybe NgramsTerm
-           -> Set Text
-           -> Map Text a
-           -> Map Text a
+           -> Set NgramsTerm
+           -> HashMap NgramsTerm a
+           -> HashMap NgramsTerm a
 addParentScore _ Nothing                                   _ss mapParent = mapParent
-addParentScore (KeepAllParents keep) (Just (NgramsTerm p')) ss mapParent =
+addParentScore (KeepAllParents keep) (Just p') ss mapParent =
   case keep of
-    True  -> Map.alter addCount p' mapParent
+    True  -> HashMap.alter addCount p' mapParent
     False -> case Set.member p' ss of
                False -> mapParent
-               True  -> Map.alter addCount p' mapParent
+               True  -> HashMap.alter addCount p' mapParent
   where
         addCount Nothing  = Just 1
         addCount (Just n) = Just $ n + 1

src/Gargantext/Core/Text/Metrics.hs

@@ -20,24 +20,26 @@ module Gargantext.Core.Text.Metrics
 --import Math.KMeans (kmeans, euclidSq, elements)
 import Control.Lens (makeLenses)
 import Data.Map (Map)
-import Data.Semigroup (Semigroup)
 import Data.Monoid (Monoid, mempty)
-import Gargantext.Prelude
+import Data.HashMap.Strict (HashMap)
+import Data.Semigroup (Semigroup)
 import Gargantext.Core.Methods.Distances.Accelerate.SpeGen
-import Gargantext.Core.Viz.Graph.Index
 import Gargantext.Core.Statistics (pcaReduceTo, Dimension(..))
+import Gargantext.Core.Viz.Graph.Index
+import Gargantext.Prelude
 import qualified Data.Array.Accelerate as DAA
 import qualified Data.Array.Accelerate.Interpreter as DAA
 import qualified Data.Map  as Map
-
 import qualified Data.Vector as V
 import qualified Data.Vector.Storable as Vec
+import qualified Data.HashMap.Strict as HashMap
+
 
 type MapListSize = Int
 type InclusionSize = Int
 
-scored :: Ord t => Map (t,t) Int -> V.Vector (Scored t)
-scored = map2scored . (pcaReduceTo (Dimension 2)) . scored2map
+scored :: Ord t => HashMap (t,t) Int -> V.Vector (Scored t)
+scored = map2scored . (pcaReduceTo (Dimension 2)) . scored2map . Map.fromList . HashMap.toList
   where
     scored2map :: Ord t => Map (t,t) Int -> Map t (Vec.Vector Double)
     scored2map m = Map.fromList $ map (\(Scored t i s) -> (t, Vec.fromList [i,s])) $ scored' m

src/Gargantext/Core/Text/Terms/Multi/PosTagging.hs

@@ -107,8 +107,6 @@ $(deriveJSON (unPrefix "_") ''PosSentences)
 --             },
 -- 
 
-
-
 corenlp' :: ( FromJSON a
             , ConvertibleStrings p ByteString
             )

src/Gargantext/Core/Types/Main.hs

@@ -20,6 +20,7 @@ module Gargantext.Core.Types.Main where
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Aeson.TH (deriveJSON)
 import Data.Either (Either(..))
+import Data.Hashable (Hashable)
 import Data.Map (fromList, lookup)
 import Data.Semigroup (Semigroup(..))
 import Data.Swagger
@@ -59,6 +60,7 @@ instance ToSchema ListType
 instance ToParamSchema ListType
 instance Arbitrary ListType where
   arbitrary = elements [minBound..maxBound]
+instance Hashable ListType
 
 instance Semigroup ListType
   where

src/Gargantext/Core/Viz/Chart.hs

@@ -34,11 +34,14 @@ import Gargantext.Core.Text.Metrics.Count (occurrencesWith)
 -- Pie Chart
 import Gargantext.API.Ngrams.NgramsTree
 import Gargantext.API.Ngrams.Tools
+import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types
 import Gargantext.Database.Action.Flow
 import Gargantext.Database.Action.Metrics.NgramsByNode
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Core.Viz.Types
+import qualified Data.HashMap.Strict as HashMap
+
 
 histoData :: CorpusId -> Cmd err Histo
 histoData cId = do
@@ -60,20 +63,20 @@ chartData cId nt lt = do
   ts <- mapTermListRoot ls nt <$> getRepo
   let
     dico = filterListWithRoot lt ts
-    terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
-    group dico' x = case Map.lookup x dico' of
+    terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico
+    group dico' x = case HashMap.lookup x dico' of
         Nothing -> x
         Just x' -> maybe x identity x'
 
   (_total,mapTerms) <- countNodesByNgramsWith (group dico)
                     <$> getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
-  let (dates, count) = V.unzip $ fmap (\(t,(d,_)) -> (t, d)) $ V.fromList $ Map.toList mapTerms
-  pure (Histo (dates) (round <$> count))
+  let (dates, count) = V.unzip $ fmap (\(NgramsTerm t,(d,_)) -> (t, d)) $ V.fromList $ HashMap.toList mapTerms
+  pure (Histo dates (round <$> count))
 
 
 treeData :: FlowCmdM env err m
         => CorpusId -> NgramsType -> ListType
-        -> m [NgramsTree]
+        -> m (V.Vector NgramsTree)
 treeData cId nt lt = do
   ls' <- selectNodesWithUsername NodeList userMaster
   ls <- map (_node_id) <$> getListsWithParentId cId
@@ -81,10 +84,10 @@ treeData cId nt lt = do
 
   let
     dico = filterListWithRoot lt ts
-    terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
+    terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico
 
   cs' <- getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
 
   m  <- getListNgrams ls nt
-  pure $ toTree lt cs' m
+  pure $ V.fromList $ toTree lt cs' m
 

src/Gargantext/Core/Viz/Graph/API.hs

@@ -18,38 +18,37 @@ module Gargantext.Core.Viz.Graph.API
 
 import Control.Lens (set, (^.), _Just, (^?))
 import Data.Aeson
-import qualified Data.Map as Map
 import Data.Swagger
 import Data.Text
 import Debug.Trace (trace)
 import GHC.Generics (Generic)
-import Servant
-import Servant.Job.Async
-import Servant.XML
-
 import Gargantext.API.Admin.Orchestrator.Types
-import Gargantext.API.Ngrams.Types (NgramsRepo, r_version)
 import Gargantext.API.Ngrams.Tools
+import Gargantext.API.Ngrams.Types (NgramsRepo, r_version)
 import Gargantext.API.Prelude
+import Gargantext.Core.Methods.Distances (Distance(..), GraphMetric(..))
 import Gargantext.Core.Types.Main
+import Gargantext.Core.Viz.Graph
+import Gargantext.Core.Viz.Graph.GEXF ()
+import Gargantext.Core.Viz.Graph.Tools -- (cooc2graph)
 import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
 import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Config
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Query.Table.Node
-import Gargantext.Database.Query.Table.Node.User (getNodeUser)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.Select
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
+import Gargantext.Database.Query.Table.Node.User (getNodeUser)
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.Node (node_parentId, node_hyperdata, node_name, node_userId)
 import Gargantext.Prelude
-import Gargantext.Core.Viz.Graph
-import Gargantext.Core.Viz.Graph.GEXF ()
-import Gargantext.Core.Viz.Graph.Tools -- (cooc2graph)
-import Gargantext.Core.Methods.Distances (Distance(..), GraphMetric(..))
-
+import Servant
+import Servant.Job.Async
+import Servant.XML
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.Map as Map
 ------------------------------------------------------------------------
 -- | There is no Delete specific API for Graph since it can be deleted
 -- as simple Node.
@@ -150,10 +149,10 @@ computeGraph cId d nt repo = do
   let ngs = filterListWithRoot MapTerm $ mapTermListRoot [lId] nt repo
 
   -- TODO split diagonal
-  myCooc <- HM.filter (>1)
+  myCooc <- HashMap.filter (>1)
          <$> getCoocByNgrams (Diagonal True)
          <$> groupNodesByNgrams ngs
-         <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
+         <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
 
   graph <- liftBase $ cooc2graph d 0 myCooc
 

src/Gargantext/Core/Viz/Graph/Tools.hs

@@ -13,28 +13,31 @@ Portability : POSIX
 module Gargantext.Core.Viz.Graph.Tools
   where
 
-import Debug.Trace (trace)
-import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
 -- import Data.Graph.Clustering.Louvain (hLouvain, {-iLouvainMap-})
 import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
+import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
 import Data.Map (Map)
-import qualified Data.Set as Set
+import Data.HashMap.Strict (HashMap)
 import Data.Text (Text)
-import Gargantext.Prelude
+import Debug.Trace (trace)
+import GHC.Float (sin, cos)
+import Gargantext.API.Ngrams.Types (NgramsTerm(..))
+import Gargantext.Core.Methods.Distances (Distance(..), measure)
+import Gargantext.Core.Methods.Graph.BAC.Proxemy (confluence)
 import Gargantext.Core.Statistics
 import Gargantext.Core.Viz.Graph
 import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness)
-import Gargantext.Core.Methods.Distances (Distance(..), measure)
-import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index)
 import Gargantext.Core.Viz.Graph.IGraph (mkGraphUfromEdges)
-import Gargantext.Core.Methods.Graph.BAC.Proxemy (confluence)
-import GHC.Float (sin, cos)
-import qualified IGraph as Igraph
+import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index)
+import Gargantext.Prelude
 import IGraph.Random -- (Gen(..))
+import qualified Data.List                as List
+import qualified Data.Map                 as Map
+import qualified Data.Set                 as Set
+import qualified Data.Vector.Storable     as Vec
+import qualified IGraph                   as Igraph
 import qualified IGraph.Algorithms.Layout as Layout
-import qualified Data.Vector.Storable as Vec
-import qualified Data.Map  as Map
-import qualified Data.List as List
+import qualified Data.HashMap.Strict      as HashMap
 
 type Threshold = Double
 
@@ -54,13 +57,15 @@ cooc2graph' distance threshold myCooc = distanceMap
 
 cooc2graph :: Distance
            -> Threshold
-           -> (Map (Text, Text) Int)
+           -> HashMap (NgramsTerm, NgramsTerm) Int
            -> IO Graph
 cooc2graph distance threshold myCooc = do
   printDebug "cooc2graph" distance
   let
-    (ti, _) = createIndices myCooc
-    myCooc' = toIndex ti myCooc
+    -- TODO remove below
+    theMatrix = Map.fromList $ HashMap.toList myCooc
+    (ti, _) = createIndices theMatrix
+    myCooc' = toIndex ti theMatrix
     matCooc = map2mat 0 (Map.size ti)
             $ Map.filterWithKey (\(a,b) _ -> a /= b) 
             $ Map.filter (> 1) myCooc'
@@ -87,7 +92,7 @@ cooc2graph distance threshold myCooc = do
                 $ bridgeness rivers partitions distanceMap
     confluence' = confluence (Map.keys bridgeness') 3 True False
 
-  pure $ data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
+  pure $ data2graph (Map.toList $ Map.mapKeys unNgramsTerm ti) myCooc' bridgeness' confluence' partitions
 
 
 

src/Gargantext/Core/Viz/Phylo/Main.hs

@@ -14,34 +14,32 @@ Portability : POSIX
 module Gargantext.Core.Viz.Phylo.Main
   where
 
-
 import Data.GraphViz
-import qualified Data.ByteString as DB
-import qualified Data.List as List
-import qualified Data.Map  as Map
 import Data.Maybe
-import qualified Data.Text as Text
 import Data.Text (Text)
 import Debug.Trace (trace)
 import GHC.IO (FilePath)
-
 import Gargantext.API.Ngrams.Tools (getTermsWith)
-import Gargantext.Core.Types
-import Gargantext.Database.Action.Flow
-import Gargantext.Database.Admin.Types.Hyperdata
-import Gargantext.Database.Query.Table.Node(defaultList)
-import Gargantext.Database.Query.Table.NodeNode (selectDocs)
-import Gargantext.Database.Schema.Ngrams (NgramsType(..))
-import Gargantext.Prelude
+import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Text.Context (TermList)
 import Gargantext.Core.Text.Terms.WithList
-
+import Gargantext.Core.Types
 import Gargantext.Core.Viz.Phylo hiding (Svg, Dot)
 import Gargantext.Core.Viz.Phylo.LevelMaker (toPhylo)
 import Gargantext.Core.Viz.Phylo.Tools
 import Gargantext.Core.Viz.Phylo.View.Export
 import Gargantext.Core.Viz.Phylo.View.ViewMaker    -- TODO Just Maker is fine
-
+import Gargantext.Database.Action.Flow
+import Gargantext.Database.Admin.Types.Hyperdata
+import Gargantext.Database.Query.Table.Node(defaultList)
+import Gargantext.Database.Query.Table.NodeNode (selectDocs)
+import Gargantext.Database.Schema.Ngrams (NgramsType(..))
+import Gargantext.Prelude
+import qualified Data.ByteString as DB
+import qualified Data.List as List
+import qualified Data.Map  as Map
+import qualified Data.Text as Text
+import qualified Data.HashMap.Strict as HashMap
 
 type MinSizeBranch = Int
 
@@ -51,7 +49,7 @@ flowPhylo :: FlowCmdM env err m
 flowPhylo cId = do
 
   list     <- defaultList cId
-  termList <- Map.toList <$> getTermsWith Text.words [list] NgramsTerms MapTerm
+  termList <- HashMap.toList <$> getTermsWith (Text.words . unNgramsTerm) [list] NgramsTerms MapTerm
 
   docs' <- catMaybes
         <$> map (\h -> (,) <$> _hd_publication_year h

src/Gargantext/Data/HashMap/Strict/Utils.hs

@@ -5,5 +5,21 @@ import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HM
 import Gargantext.Prelude
 
+
 unionsWith :: (Foldable f, Eq k, Hashable k) => (a->a->a) -> f (HashMap k a) -> HashMap k a
 unionsWith f = foldl' (HM.unionWith f) HM.empty
+
+partition :: Hashable k => (a -> Bool) -> HashMap k a -> (HashMap k a, HashMap k a) 
+partition = undefined
+
+
+partitionWithKey :: Hashable k => (k -> a -> Bool) -> HashMap k a -> (HashMap k a, HashMap k a)
+partitionWithKey = undefined 
+
+findMax :: Hashable k => HashMap k a -> (k, a) 
+findMax = undefined
+
+-- getKeyWithMaxValue :: Hashable k => HashMap k a -> Maybe k
+getKeyWithMaxValue :: Hashable k => HashMap k a -> [k]
+getKeyWithMaxValue = undefined
+

src/Gargantext/Database/Action/Flow/Pairing.hs

@@ -40,11 +40,11 @@ import Gargantext.Database.Schema.Ngrams -- (NgramsType(..))
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude hiding (sum)
 import Opaleye
-import qualified Data.List as List
-import qualified Data.Map  as Map
-import qualified Data.Set  as Set
-import qualified Data.Text as DT
-
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.List           as List
+import qualified Data.Map            as Map
+import qualified Data.Set            as Set
+import qualified Data.Text           as DT
 
 -- | isPairedWith
 -- All NodeAnnuaire paired with a Corpus of NodeId nId:
@@ -184,4 +184,4 @@ getNgramsDocId cId lId nt = do
   let ngs = filterListWithRoot MapTerm $ mapTermListRoot [lId] nt repo
 
   groupNodesByNgrams ngs
-    <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
+    <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)

src/Gargantext/Database/Action/Metrics.hs

@@ -10,18 +10,16 @@ Portability : POSIX
 Node API
 -}
 
-
-
 module Gargantext.Database.Action.Metrics
   where
 
+import Data.HashMap.Strict (HashMap)
 import Data.Map (Map)
-import qualified Data.Map    as Map
 import Data.Text (Text)
 import Data.Vector (Vector)
-
-import Gargantext.API.Ngrams.Types (TabType(..), ngramsTypeFromTabType)
 import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, Diagonal(..), getCoocByNgrams, mapTermListRoot, RootTerm, getRepo)
+import Gargantext.API.Ngrams.Types (TabType(..), ngramsTypeFromTabType, NgramsTerm)
+import Gargantext.Core.Text.Metrics (scored, Scored(..), {-localMetrics, toScored-})
 import Gargantext.Core.Types (ListType(..), Limit, NodeType(..))
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser{-, getTficfWith-})
@@ -30,21 +28,23 @@ import Gargantext.Database.Admin.Types.Node (ListId, CorpusId)
 import Gargantext.Database.Query.Table.Node (defaultList)
 import Gargantext.Database.Query.Table.Node.Select
 import Gargantext.Prelude
-import Gargantext.Core.Text.Metrics (scored, Scored(..), {-localMetrics, toScored-})
+import qualified Data.HashMap.Strict as HM
+import qualified Data.Map            as Map
 
 getMetrics :: FlowCmdM env err m
             => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
-            -> m (Map Text (ListType, Maybe Text), Vector (Scored Text))
+            -> m (HashMap NgramsTerm (ListType, Maybe NgramsTerm), Vector (Scored NgramsTerm))
 getMetrics cId maybeListId tabType maybeLimit = do
   (ngs, _, myCooc) <- getNgramsCooc cId maybeListId tabType maybeLimit
+  -- TODO HashMap
   pure (ngs, scored myCooc)
 
 
 getNgramsCooc :: (FlowCmdM env err m)
             => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
-            -> m ( Map Text (ListType, Maybe Text)
-                 , Map Text (Maybe RootTerm)
-                 , HashMap (Text, Text) Int
+            -> m ( HashMap NgramsTerm (ListType, Maybe NgramsTerm)
+                 , HashMap NgramsTerm (Maybe RootTerm)
+                 , HashMap (NgramsTerm, NgramsTerm) Int
                  )
 getNgramsCooc cId maybeListId tabType maybeLimit = do
   (ngs', ngs) <- getNgrams cId maybeListId tabType
@@ -59,14 +59,16 @@ getNgramsCooc cId maybeListId tabType maybeLimit = do
   myCooc <- HM.filter (>1) <$> getCoocByNgrams (Diagonal True)
                            <$> groupNodesByNgrams ngs
                            <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) (ngramsTypeFromTabType tabType)
-                                                            (take' maybeLimit $ Map.keys ngs)
+                                                            (take' maybeLimit $ HM.keys ngs)
   pure $ (ngs', ngs, myCooc)
 
 
 
 getNgrams :: (FlowCmdM env err m)
             => CorpusId -> Maybe ListId -> TabType
-            -> m (Map Text (ListType, Maybe Text), Map Text (Maybe RootTerm))
+            -> m ( HashMap NgramsTerm (ListType, Maybe NgramsTerm)
+                 , HashMap NgramsTerm (Maybe RootTerm)
+                 )
 getNgrams cId maybeListId tabType = do
 
   lId <- case maybeListId of
@@ -74,7 +76,7 @@ getNgrams cId maybeListId tabType = do
     Just lId' -> pure lId'
 
   lists <- mapTermListRoot [lId] (ngramsTypeFromTabType tabType) <$> getRepo
-  let maybeSyn = Map.unions $ map (\t -> filterListWithRoot t lists)
+  let maybeSyn = HM.unions $ map (\t -> filterListWithRoot t lists)
                              [MapTerm, StopTerm, CandidateTerm]
   pure (lists, maybeSyn)
 

src/Gargantext/Database/Action/Metrics/Lists.hs

@@ -19,17 +19,16 @@ Portability : POSIX
 module Gargantext.Database.Action.Metrics.Lists
   where
 
+import Gargantext.API.Ngrams.Types (TabType(..), NgramsTerm(..))
+import Gargantext.Core.Text.Metrics (Scored(..))
+import Gargantext.Core.Types -- (NodePoly(..), NodeCorpus, ListId)
+import Gargantext.Database.Action.Flow.Types (FlowCmdM)
+import Gargantext.Prelude hiding (sum, head)
 import Prelude hiding (null, id, map, sum)
 import qualified Data.Map as Map
 import qualified Data.Vector as Vec
-
 import qualified Gargantext.Database.Action.Metrics as Metrics
-import Gargantext.API.Ngrams.Types (TabType(..))
-import Gargantext.Core.Types -- (NodePoly(..), NodeCorpus, ListId)
-import Gargantext.Database.Action.Flow.Types (FlowCmdM)
-import Gargantext.Prelude hiding (sum, head)
-import Gargantext.Core.Text.Metrics (Scored(..))
-
+import qualified Data.HashMap.Strict as HashMap
 {-
 trainModel :: FlowCmdM env ServantErr m
              => Username -> m Score
@@ -50,7 +49,7 @@ getMetrics' cId maybeListId tabType maybeLimit = do
 
   let
     metrics      = map (\(Scored t s1 s2) -> (listType t ngs', [Vec.fromList [s1,s2]])) scores
-    listType t m = maybe (panic errorMsg) fst $ Map.lookup t m
+    listType t m = maybe (panic errorMsg) fst $ HashMap.lookup t m
     errorMsg     = "API.Node.metrics: key absent"
   
   {-

src/Gargantext/Database/Action/Metrics/NgramsByNode.hs

@@ -16,10 +16,9 @@ Ngrams by node enable contextual metrics.
 module Gargantext.Database.Action.Metrics.NgramsByNode
   where
 
-
-import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HM
 --import Data.Map.Strict.Patch (PatchMap, Replace, diff)
+import Data.HashMap.Strict (HashMap)
+import Data.Map (Map)
 import Data.Set (Set)
 import Data.Text (Text)
 import Data.Tuple.Extra (first, second, swap)
@@ -27,16 +26,17 @@ import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import Debug.Trace (trace)
 import Gargantext.API.Ngrams.Types (NgramsTerm(..))
+import Gargantext.Data.HashMap.Strict.Utils as HM
 import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
 import Gargantext.Database.Prelude (Cmd, runPGSQuery)
 import Gargantext.Database.Schema.Ngrams (ngramsTypeId, NgramsType(..))
-import Gargantext.Data.HashMap.Strict.Utils as HM
 import Gargantext.Prelude
+import qualified Data.HashMap.Strict as HM
+import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Database.PostgreSQL.Simple as DPS
 
-
 -- | fst is size of Supra Corpus
 --   snd is Texts and size of Occurrences (different docs)
 countNodesByNgramsWith :: (NgramsTerm -> NgramsTerm)
@@ -224,7 +224,7 @@ getNodesByNgramsOnlyUser :: CorpusId
                          -> [NgramsTerm]
                          -> Cmd err (HashMap NgramsTerm (Set NodeId))
 getNodesByNgramsOnlyUser cId ls nt ngs =
-     unionsWith           (<>)
+     HM.unionsWith        (<>)
    . map (HM.fromListWith (<>)
    . map (second Set.singleton))
   <$> mapM (selectNgramsOnlyByNodeUser cId ls nt)
@@ -235,11 +235,12 @@ getNgramsByNodeOnlyUser :: NodeId
                         -> [ListId]
                         -> NgramsType
                         -> [NgramsTerm]
-                        -> Cmd err (HashMap NodeId (Set NgramsTerm))
+                        -> Cmd err (Map NodeId (Set NgramsTerm))
 getNgramsByNodeOnlyUser cId ls nt ngs =
-     unionsWith           (<>)
-   . map (HM.fromListWith (<>)
-   . map (second Set.singleton))
+     Map.unionsWith         (<>)
+   . map ( Map.fromListWith (<>)
+         . map (second Set.singleton)
+         )
    . map (map swap)
   <$> mapM (selectNgramsOnlyByNodeUser cId ls nt)
            (splitEvery 1000 ngs)
@@ -319,7 +320,7 @@ getNgramsByDocOnlyUser :: DocId
                        -> [NgramsTerm]
                        -> Cmd err (HashMap NgramsTerm (Set NodeId))
 getNgramsByDocOnlyUser cId ls nt ngs =
-  unionsWith (<>)
+  HM.unionsWith (<>)
   . map (HM.fromListWith (<>) . map (second Set.singleton))
   <$> mapM (selectNgramsOnlyByDocUser cId ls nt) (splitEvery 1000 ngs)
 

src/Gargantext/Database/Action/Metrics/TFICF.hs

@@ -19,7 +19,6 @@ module Gargantext.Database.Action.Metrics.TFICF
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HM
 import Data.Maybe (fromMaybe)
-import Data.Text (Text)
 import Gargantext.Core.Text.Metrics.TFICF
 import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsUser, getOccByNgramsOnlyFast)
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
@@ -50,4 +49,4 @@ getTficf cId mId nt = do
                         (Total $ fromIntegral countLocal))
             (TficfSupra (Count $ fromMaybe 0 $ HM.lookup t mapTextDoubleGlobal)
                         (Total $ fromIntegral countGlobal))
-    ) mapTextDoubleLocal
\ No newline at end of file
+    ) mapTextDoubleLocal

src/Gargantext/Database/Schema/Ngrams.hs

@@ -19,6 +19,7 @@ Ngrams connection to the Database.
 module Gargantext.Database.Schema.Ngrams
   where
 
+import Data.Hashable (Hashable)
 import Codec.Serialise (Serialise())
 import Control.Lens (over)
 import Control.Monad (mzero)
@@ -81,6 +82,7 @@ data NgramsType = Authors | Institutes | Sources | NgramsTerms
   deriving (Eq, Show, Read, Ord, Enum, Bounded, Generic)
 
 instance Serialise NgramsType
+instance Hashable  NgramsType
 
 ngramsTypes :: [NgramsType]
 ngramsTypes = [minBound..]
@@ -153,6 +155,7 @@ text2ngrams txt = UnsafeNgrams txt' $ length $ splitOn " " txt'
   where
     txt' = strip txt
 
+
 -------------------------------------------------------------------------
 -- | TODO put it in Gargantext.Core.Text.Ngrams
 -- Named entity are typed ngrams of Terms Ngrams

src/Gargantext/Prelude/Crypto/Hash.hs

@@ -45,6 +45,7 @@ instance {-# OVERLAPPING #-} IsHashable String where
 instance IsHashable Text where
   hash = hash . Text.unpack
 
+
 instance IsHashable (Set Hash) where
   hash = hash . foldl (<>) "" . Set.toList