Merge branch 'dev-merge' into dev

package.yaml

@@ -150,6 +150,7 @@ library:
   - full-text-search
   - fullstop
   - graphviz
+  - hashable
   - haskell-igraph
   - hlcm
   - hsparql

src/Gargantext/API/Metrics.hs

@@ -19,7 +19,8 @@ module Gargantext.API.Metrics
     where
 
 import Control.Lens
-import qualified Data.Map as Map
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HM
 import Data.Text (Text)
 import Data.Time (UTCTime)
 import Servant
@@ -78,7 +79,7 @@ getScatter cId maybeListId tabType _maybeLimit = do
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let HyperdataList { _hl_scatter = scatterMap } = node ^. node_hyperdata
-      mChart = Map.lookup tabType scatterMap
+      mChart = HM.lookup tabType scatterMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -111,9 +112,9 @@ updateScatter' cId maybeListId tabType maybeLimit = do
   (ngs', scores) <- Metrics.getMetrics cId maybeListId tabType maybeLimit
 
   let
-    metrics      = map (\(Scored t s1 s2) -> Metric t s1 s2 (listType t ngs'))
-                 $ map normalizeLocal scores
-    listType t m = maybe (panic errorMsg) fst $ Map.lookup t m
+    metrics      = fmap (\(Scored t s1 s2) -> Metric 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"
 
   listId <- case maybeListId of
@@ -122,7 +123,7 @@ updateScatter' cId maybeListId tabType maybeLimit = do
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let hl = node ^. node_hyperdata
       scatterMap = hl ^. hl_scatter
-  _ <- updateHyperdata listId $ hl { _hl_scatter = Map.insert tabType (Metrics metrics) scatterMap }
+  _ <- updateHyperdata listId $ hl { _hl_scatter = HM.insert tabType (Metrics metrics) scatterMap }
 
   pure $ Metrics metrics
 
@@ -172,7 +173,7 @@ getChart cId _start _end maybeListId tabType = do
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let chartMap = node ^. node_hyperdata ^. hl_chart
-      mChart = Map.lookup tabType chartMap
+      mChart = HM.lookup tabType chartMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -209,7 +210,7 @@ updateChart' cId maybeListId tabType _maybeLimit = do
   let hl = node ^. node_hyperdata
       chartMap = hl ^. hl_chart
   h <- histoData cId
-  _ <- updateHyperdata listId $ hl { _hl_chart = Map.insert tabType (ChartMetrics h) chartMap }
+  _ <- updateHyperdata listId $ hl { _hl_chart = HM.insert tabType (ChartMetrics h) chartMap }
 
   pure $ ChartMetrics h
 
@@ -258,7 +259,7 @@ getPie cId _start _end maybeListId tabType = do
     Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let pieMap = node ^. node_hyperdata ^. hl_pie
-      mChart = Map.lookup tabType pieMap
+      mChart = HM.lookup tabType pieMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -296,7 +297,7 @@ updatePie' cId maybeListId tabType _maybeLimit = do
       pieMap = hl ^. hl_pie
 
   p <- chartData cId (ngramsTypeFromTabType tabType) MapTerm
-  _ <- updateHyperdata listId $ hl { _hl_pie = Map.insert tabType (ChartMetrics p) pieMap }
+  _ <- updateHyperdata listId $ hl { _hl_pie = HM.insert tabType (ChartMetrics p) pieMap }
 
   pure $ ChartMetrics p
 
@@ -349,7 +350,7 @@ getTree cId _start _end maybeListId tabType listType = do
 
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let treeMap = node ^. node_hyperdata ^. hl_tree
-      mChart = Map.lookup tabType treeMap
+      mChart = HM.lookup tabType treeMap
 
   chart <- case mChart of
     Just chart -> pure chart
@@ -387,7 +388,7 @@ updateTree' cId maybeListId tabType listType = do
   let hl = node ^. node_hyperdata
       treeMap = hl ^. hl_tree
   t <- treeData cId (ngramsTypeFromTabType tabType) listType
-  _ <- updateHyperdata listId $ hl { _hl_tree = Map.insert tabType (ChartMetrics t) treeMap }
+  _ <- updateHyperdata listId $ hl { _hl_tree = HM.insert tabType (ChartMetrics t) treeMap }
 
   pure $ ChartMetrics t
 

src/Gargantext/API/Ngrams/Tools.hs

@@ -9,13 +9,18 @@ Portability : POSIX
 
 -}
 
+{-# LANGUAGE TypeFamilies #-}
 
 module Gargantext.API.Ngrams.Tools
   where
 
 import Control.Concurrent
-import Control.Lens (_Just, (^.), at, view)
+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.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
@@ -31,7 +36,7 @@ import Gargantext.Prelude
 mergeNgramsElement :: NgramsRepoElement -> NgramsRepoElement -> NgramsRepoElement
 mergeNgramsElement _neOld neNew = neNew
 
-type RootTerm = Text
+type RootTerm = NgramsTerm
 
 getRepo :: RepoCmdM env err m => m NgramsRepo
 getRepo = do
@@ -39,8 +44,8 @@ getRepo = do
   liftBase $ readMVar v
 
 listNgramsFromRepo :: [ListId] -> NgramsType
-                   -> NgramsRepo -> Map Text NgramsRepoElement
-listNgramsFromRepo nodeIds ngramsType repo = Map.mapKeys unNgramsTerm ngrams
+                   -> NgramsRepo -> Map NgramsTerm NgramsRepoElement
+listNgramsFromRepo nodeIds ngramsType repo = ngrams
   where
     ngramsMap = repo ^. r_state . at ngramsType . _Just
 
@@ -55,73 +60,88 @@ listNgramsFromRepo nodeIds ngramsType repo = Map.mapKeys unNgramsTerm ngrams
 --              be properly guarded.
 getListNgrams :: RepoCmdM env err m
               => [ListId] -> NgramsType
-              -> m (Map Text NgramsRepoElement)
+              -> m (Map NgramsTerm NgramsRepoElement)
 getListNgrams nodeIds ngramsType = listNgramsFromRepo nodeIds ngramsType <$> getRepo
 
-getTermsWith :: (RepoCmdM env err m, Ord a)
-          => (Text -> a ) -> [ListId]
+getTermsWith :: (RepoCmdM env err m, Eq a, Hashable a)
+          => (NgramsTerm -> a) -> [ListId]
           -> NgramsType -> ListType
-          -> m (Map a [a])
-getTermsWith f ls ngt lt = Map.fromListWith (<>)
-                      <$> map (toTreeWith f)
+          -> m (HashMap a [a])
+getTermsWith f ls ngt lt = HM.fromListWith (<>)
+                      <$> map toTreeWith
                       <$> Map.toList
-                      <$> Map.filter (\f' -> (fst f') == lt)
+                      <$> Map.filter (\f' -> fst f' == lt)
                       <$> mapTermListRoot ls ngt
                       <$> getRepo
   where
-    toTreeWith f'' (t, (_lt, maybeRoot)) = case maybeRoot of
-      Nothing -> (f'' t, [])
-      Just  r -> (f'' r, map f'' [t])
+    toTreeWith (t, (_lt, maybeRoot)) = case maybeRoot of
+      Nothing -> (f t, [])
+      Just  r -> (f r, [f t])
 
 mapTermListRoot :: [ListId]
                 -> NgramsType
                 -> NgramsRepo
-                -> Map Text (ListType, (Maybe Text))
+                -> Map NgramsTerm (ListType, Maybe NgramsTerm)
 mapTermListRoot nodeIds ngramsType repo =
-  Map.fromList [ (t, (_nre_list nre, unNgramsTerm <$> _nre_root nre))
-               | (t, nre) <- Map.toList ngrams
-               ]
-  where ngrams = listNgramsFromRepo nodeIds ngramsType repo
+  (\nre -> (_nre_list nre, _nre_root nre)) <$>
+  listNgramsFromRepo nodeIds ngramsType repo
+
+filterListWithRootHashMap :: ListType
+                          -> HashMap NgramsTerm (ListType, Maybe NgramsTerm)
+                          -> HashMap NgramsTerm (Maybe RootTerm)
+filterListWithRootHashMap lt m = snd <$> HM.filter isMapTerm m
+  where
+    isMapTerm (l, maybeRoot) = case maybeRoot of
+      Nothing -> l == lt
+      Just  r -> case HM.lookup r m of
+        Nothing -> panic $ "Garg.API.Ngrams.Tools: filterWithRoot, unknown key: " <> unNgramsTerm r
+        Just  (l',_) -> l' == lt
 
 filterListWithRoot :: ListType
-                   -> Map Text (ListType, Maybe Text)
-                   -> Map Text (Maybe RootTerm)
-filterListWithRoot lt m = Map.fromList
-                    $ map (\(t,(_,r)) -> (t,r))
-                    $ filter isMapTerm (Map.toList m)
+                   -> Map NgramsTerm (ListType, Maybe NgramsTerm)
+                   -> Map NgramsTerm (Maybe RootTerm)
+filterListWithRoot lt m = snd <$> Map.filter isMapTerm m
   where
-    isMapTerm (_t,(l, maybeRoot)) = case maybeRoot of
+    isMapTerm (l, maybeRoot) = case maybeRoot of
       Nothing -> l == lt
       Just  r -> case Map.lookup r m of
-        Nothing -> panic $ "Garg.API.Ngrams.Tools: filterWithRoot, unknown key: " <> r
+        Nothing -> panic $ "Garg.API.Ngrams.Tools: filterWithRoot, unknown key: " <> unNgramsTerm r
         Just  (l',_) -> l' == lt
 
-groupNodesByNgrams :: Map Text (Maybe RootTerm)
-                   -> Map Text (Set NodeId)
-                   -> Map Text (Set NodeId)
-groupNodesByNgrams syn occs = Map.fromListWith (<>) occs'
+groupNodesByNgrams :: ( At root_map
+                      , Index root_map ~ NgramsTerm
+                      , IxValue root_map ~ Maybe RootTerm
+                      )
+                   => root_map
+                   -> HashMap NgramsTerm (Set NodeId)
+                   -> HashMap NgramsTerm (Set NodeId)
+groupNodesByNgrams syn occs = HM.fromListWith (<>) occs'
   where
-    occs' = map toSyn (Map.toList occs)
-    toSyn (t,ns) = case Map.lookup t syn of
-      Nothing -> panic $ "[Garg.API.Ngrams.Tools.groupNodesByNgrams] unknown key: " <> t
+    occs' = map toSyn (HM.toList occs)
+    toSyn (t,ns) = case syn ^. at t of
+      Nothing -> panic $ "[Garg.API.Ngrams.Tools.groupNodesByNgrams] unknown key: " <> unNgramsTerm t
       Just  r -> case r of
         Nothing  -> (t, ns)
         Just  r' -> (r',ns)
 
 data Diagonal = Diagonal Bool
 
-getCoocByNgrams :: Diagonal -> Map Text (Set NodeId) -> Map (Text, Text) Int
+getCoocByNgrams :: Diagonal -> HashMap Text (Set NodeId) -> HashMap (Text, Text) Int
 getCoocByNgrams = getCoocByNgrams' identity
 
 
-getCoocByNgrams' :: (Ord a, Ord c) => (b -> Set c) -> Diagonal -> Map a b -> Map (a, a) Int
+getCoocByNgrams' :: (Hashable a, Ord a, Ord c) => (b -> Set c) -> Diagonal -> HashMap a b -> HashMap (a, a) Int
 getCoocByNgrams' f (Diagonal diag) m =
-  Map.fromList [( (t1,t2)
+  HM.fromList [( (t1,t2)
                , maybe 0 Set.size $ Set.intersection
-                                  <$> (fmap f $ Map.lookup t1 m)
-                                  <*> (fmap f $ Map.lookup t2 m)
-                ) | (t1,t2) <- case diag of
-                                 True   -> [ (x,y) | x <- Map.keys m, y <- Map.keys m, x <= y]
-                                 False  -> listToCombi identity (Map.keys m)
+                                 <$> (fmap f $ HM.lookup t1 m)
+                                 <*> (fmap f $ HM.lookup t2 m)
+               )
+              | (t1,t2) <- if diag then
+                             [ (x,y) | x <- ks, y <- ks, x <= y] -- TODO if we keep a Data.Map here it might be
+                                                                 -- more efficient to enumerate all the y <= x.
+                           else
+                             listToCombi identity ks
               ]
 
+  where ks = HM.keys m
\ No newline at end of file

src/Gargantext/API/Ngrams/Types.hs

@@ -19,6 +19,7 @@ import Data.Aeson hiding ((.=))
 import Data.Aeson.TH (deriveJSON)
 import Data.Either (Either(..))
 import Data.Foldable
+import Data.Hashable (Hashable)
 import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
 import qualified Data.List as List
 import Data.Map.Strict (Map)
@@ -60,6 +61,9 @@ data TabType   = Docs   | Trash   | MoreFav | MoreTrash
                | Contacts
   deriving (Bounded, Enum, Eq, Generic, Ord, Show)
 
+
+instance Hashable TabType
+
 instance FromHttpApiData TabType
    where
     parseUrlPiece "Docs"       = pure Docs
@@ -120,7 +124,7 @@ 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)
+  deriving (Ord, Eq, Show, Generic, ToJSONKey, ToJSON, FromJSON, Semigroup, Arbitrary, Serialise, ToSchema, Hashable)
 
 instance FromJSONKey NgramsTerm where
   fromJSONKey = FromJSONKeyTextParser $ \t -> pure $ NgramsTerm $ strip t

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

@@ -17,6 +17,7 @@ module Gargantext.API.Node.Corpus.Export
   where
 
 
+import Data.HashMap.Strict (HashMap)
 import Data.Map (Map)
 import Data.Maybe (fromMaybe)
 import Data.Set (Set)
@@ -76,7 +77,7 @@ getNodeNgrams :: HasNodeError err
         -> Maybe ListId
         -> NgramsType
         -> NgramsRepo
-        -> Cmd err (Map NodeId (Set Text))
+        -> Cmd err (HashMap NodeId (Set Text))
 getNodeNgrams cId lId' nt repo = do
   lId <- case lId' of
     Nothing -> defaultList cId

src/Gargantext/Core/Text/List.hs

@@ -188,19 +188,19 @@ buildNgramsTermsList user uCid mCid groupParams (nt, _mapListSize)= do
                                             selectedTerms
 
   let
-    groupedTreeScores_SetNodeId :: Map Text (GroupedTreeScores (Set NodeId))
+    groupedTreeScores_SetNodeId :: HashMap Text (GroupedTreeScores (Set NodeId))
     groupedTreeScores_SetNodeId = setScoresWithMap mapTextDocIds (groupedMonoHead <> groupedMultHead)
 
   -- | Coocurrences computation
   --, t1 >= t2 -- permute byAxis diag  -- since matrix symmetric
-  let mapCooc = Map.filter (>2)
-            $ Map.fromList [ ((t1, t2), Set.size $ Set.intersection s1 s2)
+  let mapCooc = HM.filter (>2)
+             $ HM.fromList [ ((t1, t2), Set.size $ Set.intersection s1 s2)
                            | (t1, s1) <- mapStemNodeIds
                            , (t2, s2) <- mapStemNodeIds
                            ]
           where
-            mapStemNodeIds = Map.toList
-                           $ Map.map viewScores
+            mapStemNodeIds = HM.toList
+                           $ HM.map viewScores
                            $ groupedTreeScores_SetNodeId
   let
     -- computing scores

src/Gargantext/Core/Text/Metrics.hs

@@ -30,19 +30,20 @@ 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
 
 type MapListSize = Int
 type InclusionSize = Int
 
-scored :: Ord t => Map (t,t) Int -> [Scored t]
+scored :: Ord t => Map (t,t) Int -> V.Vector (Scored t)
 scored = map2scored . (pcaReduceTo (Dimension 2)) . scored2map
   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
 
-    map2scored :: Ord t => Map t (Vec.Vector Double) -> [Scored t]
-    map2scored = map (\(t, ds) -> Scored t (Vec.head ds) (Vec.last ds)) . Map.toList
+    map2scored :: Ord t => Map t (Vec.Vector Double) -> V.Vector (Scored t)
+    map2scored = V.map (\(t, ds) -> Scored t (Vec.head ds) (Vec.last ds)) . V.fromList . Map.toList
 
 -- TODO change type with (x,y)
 data Scored ts = Scored

src/Gargantext/Core/Viz/Chart.hs

@@ -14,11 +14,12 @@ Portability : POSIX
 module Gargantext.Core.Viz.Chart
   where
 
-import Data.List (unzip, sortOn)
+import Data.List (sortOn)
 import Data.Map (toList)
 import qualified Data.List as List
 import qualified Data.Map as Map
 import Data.Maybe (catMaybes)
+import qualified Data.Vector as V
 
 import Gargantext.Core.Types.Main
 import Gargantext.Database.Admin.Config
@@ -42,8 +43,9 @@ import Gargantext.Core.Viz.Types
 histoData :: CorpusId -> Cmd err Histo
 histoData cId = do
   dates <- selectDocsDates cId
-  let (ls, css) = unzip
-                $ sortOn fst
+  let (ls, css) = V.unzip
+                $ V.fromList
+                $ sortOn fst -- TODO Vector.sortOn
                 $ toList
                 $ occurrencesWith identity dates
   pure (Histo ls css)
@@ -65,8 +67,8 @@ chartData cId nt lt = do
 
   (_total,mapTerms) <- countNodesByNgramsWith (group dico)
                     <$> getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
-  let (dates, count) = unzip $ map (\(t,(d,_)) -> (t, d)) $ Map.toList mapTerms
-  pure (Histo dates (map round count))
+  let (dates, count) = V.unzip $ fmap (\(t,(d,_)) -> (t, d)) $ V.fromList $ Map.toList mapTerms
+  pure (Histo (dates) (round <$> count))
 
 
 treeData :: FlowCmdM env err m

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

@@ -150,7 +150,7 @@ computeGraph cId d nt repo = do
   let ngs = filterListWithRoot MapTerm $ mapTermListRoot [lId] nt repo
 
   -- TODO split diagonal
-  myCooc <- Map.filter (>1)
+  myCooc <- HM.filter (>1)
          <$> getCoocByNgrams (Diagonal True)
          <$> groupNodesByNgrams ngs
          <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)

src/Gargantext/Core/Viz/Types.hs

@@ -9,6 +9,8 @@ module Gargantext.Core.Viz.Types where
 
 import Data.Aeson.TH (deriveJSON)
 import Data.Swagger
+import Data.Vector (Vector)
+import qualified Data.Vector as V
 import Protolude
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
@@ -23,8 +25,8 @@ data Chart = ChartHisto | ChartScatter | ChartPie
   deriving (Generic)
 
 -- TODO use UTCTime
-data Histo = Histo { histo_dates :: ![Text]
-                   , histo_count :: ![Int]
+data Histo = Histo { histo_dates :: !(Vector Text)
+                   , histo_count :: !(Vector Int)
                    }
   deriving (Show, Generic)
 
@@ -32,7 +34,7 @@ instance ToSchema Histo where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "histo_")
 instance Arbitrary Histo
   where
-    arbitrary = elements [ Histo ["2012"] [1]
-                         , Histo ["2013"] [1]
+    arbitrary = elements [ Histo (V.singleton "2012") (V.singleton 1)
+                         , Histo (V.singleton "2013") (V.singleton 1)
                          ]
 deriveJSON (unPrefix "histo_") ''Histo

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

@@ -17,13 +17,14 @@ module Gargantext.Database.Action.Flow.Pairing
     where
 
 import Control.Lens (_Just, (^.))
-import Data.Map (Map, fromList, fromListWith)
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HM
 import Data.Maybe (catMaybes, fromMaybe)
 import Data.Set (Set)
-import Data.Text (Text)
 import Gargantext.API.Ngrams.Tools
+import Gargantext.API.Ngrams.Types (NgramsTerm(..))
 import Gargantext.API.Prelude (GargNoServer)
-import Gargantext.Core.Types (TableResult(..), Term)
+import Gargantext.Core.Types (TableResult(..))
 import Gargantext.Core.Types.Main
 import Gargantext.Database
 import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
@@ -79,7 +80,7 @@ dataPairing :: AnnuaireId
              -> (CorpusId, ListId, NgramsType)
              -> (ContactName -> Projected)
              -> (DocAuthor   -> Projected)
-             -> GargNoServer (Map ContactId (Set DocId))
+             -> GargNoServer (HashMap ContactId (Set DocId))
 dataPairing aId (cId, lId, ngt) fc fa = do
   mc <- getNgramsContactId aId
   md <- getNgramsDocId cId lId ngt
@@ -87,14 +88,14 @@ dataPairing aId (cId, lId, ngt) fc fa = do
   printDebug "ngramsContactId" mc
   printDebug "ngramsDocId"     md
   let
-    from = projectionFrom (Set.fromList $ Map.keys mc) fc
-    to   = projectionTo   (Set.fromList $ Map.keys md) fa
+    from = projectionFrom (Set.fromList $ HM.keys mc) fc
+    to   = projectionTo   (Set.fromList $ HM.keys md) fa
 
   pure $ fusion mc $ align from to md
 
 
 
-prepareInsert :: Map ContactId (Set DocId) -> [NodeNode]
+prepareInsert :: HashMap ContactId (Set DocId) -> [NodeNode]
 prepareInsert m =  map (\(n1,n2) -> NodeNode n1 n2 Nothing Nothing)
                 $ List.concat
                 $ map (\(contactId, setDocIds)
@@ -102,21 +103,21 @@ prepareInsert m =  map (\(n1,n2) -> NodeNode n1 n2 Nothing Nothing)
                                  -> (contactId, setDocId)
                                ) $ Set.toList setDocIds
                        )
-                $ Map.toList m
+                $ HM.toList m
 
 ------------------------------------------------------------------------
-type ContactName = Text
-type DocAuthor   = Text
-type Projected   = Text
+type ContactName = NgramsTerm
+type DocAuthor   = NgramsTerm
+type Projected   = NgramsTerm
 
-projectionFrom :: Set ContactName -> (ContactName -> Projected) -> Map ContactName Projected
-projectionFrom ss f = fromList $ map (\s -> (s, f s)) (Set.toList ss)
+projectionFrom :: Set ContactName -> (ContactName -> Projected) -> HashMap ContactName Projected
+projectionFrom ss f = HM.fromList $ map (\s -> (s, f s)) (Set.toList ss)  -- use HS.toMap
 
-projectionTo :: Set DocAuthor -> (DocAuthor -> Projected) -> Map Projected (Set DocAuthor)
-projectionTo ss f = fromListWith (<>) $ map (\s -> (f s, Set.singleton s)) (Set.toList ss)
+projectionTo :: Set DocAuthor -> (DocAuthor -> Projected) -> HashMap Projected (Set DocAuthor)
+projectionTo ss f = HM.fromListWith (<>) $ map (\s -> (f s, Set.singleton s)) (Set.toList ss)  -- use HS.toMap
 ------------------------------------------------------------------------
-takeName :: Term -> Term
-takeName texte = DT.toLower texte'
+takeName :: NgramsTerm -> NgramsTerm
+takeName (NgramsTerm texte) = NgramsTerm $ DT.toLower texte'
   where
     texte' = maybe texte (\x -> if DT.length x > 3 then x else texte)
                            (lastName' texte)
@@ -124,51 +125,51 @@ takeName texte = DT.toLower texte'
 
 
 ------------------------------------------------------------------------
-align :: Map ContactName Projected
-      -> Map Projected (Set DocAuthor)
-      -> Map DocAuthor (Set DocId)
-      -> Map ContactName (Set DocId)
-align mc ma md = fromListWith (<>)
+align :: HashMap ContactName Projected
+      -> HashMap Projected (Set DocAuthor)
+      -> HashMap DocAuthor (Set DocId)
+      -> HashMap ContactName (Set DocId)
+align mc ma md = HM.fromListWith (<>)
                $ map (\c -> (c, getProjection md $ testProjection c mc ma))
-               $ Map.keys mc
+               $ HM.keys mc
   where
-    getProjection :: Map DocAuthor (Set DocId) -> Set DocAuthor -> Set DocId
+    getProjection :: HashMap DocAuthor (Set DocId) -> Set DocAuthor -> Set DocId
     getProjection ma' sa' =
       if Set.null sa'
          then Set.empty
          else Set.unions $ sets ma' sa'
            where
              sets ma'' sa'' = Set.map (\s -> lookup s ma'') sa''
-             lookup s' ma''= fromMaybe Set.empty (Map.lookup s' ma'')
+             lookup s' ma''= fromMaybe Set.empty (HM.lookup s' ma'')
 
     testProjection :: ContactName
-                   -> Map ContactName Projected
-                   -> Map Projected (Set DocAuthor)
+                   -> HashMap ContactName Projected
+                   -> HashMap Projected (Set DocAuthor)
                    -> Set DocAuthor
-    testProjection cn' mc' ma' = case Map.lookup cn' mc' of
+    testProjection cn' mc' ma' = case HM.lookup cn' mc' of
       Nothing -> Set.empty
-      Just  c -> case Map.lookup c ma' of
+      Just  c -> case HM.lookup c ma' of
         Nothing -> Set.empty
         Just  a -> a
 
-fusion :: Map ContactName (Set ContactId)
-       -> Map ContactName (Set DocId)
-       -> Map ContactId   (Set DocId)
-fusion mc md = Map.fromListWith (<>)
+fusion :: HashMap ContactName (Set ContactId)
+       -> HashMap ContactName (Set DocId)
+       -> HashMap ContactId   (Set DocId)
+fusion mc md = HM.fromListWith (<>)
              $ catMaybes
-             $ [ (,) <$> Just cId <*> Map.lookup cn md
-                      | (cn, setContactId) <- Map.toList mc
+             $ [ (,) <$> Just cId <*> HM.lookup cn md
+                      | (cn, setContactId) <- HM.toList mc
                       , cId <- Set.toList setContactId
                ]
 ------------------------------------------------------------------------
 
 getNgramsContactId :: AnnuaireId
-                   -> Cmd err (Map ContactName (Set NodeId))
+                   -> Cmd err (HashMap ContactName (Set NodeId))
 getNgramsContactId aId = do
   contacts <- getAllContacts aId
-  pure $ fromListWith (<>)
+  pure $ HM.fromListWith (<>)
        $ catMaybes
-       $ map (\contact -> (,) <$> contact^.(node_hyperdata . hc_who . _Just . cw_lastName)
+       $ map (\contact -> (,) <$> (NgramsTerm <$> contact^.(node_hyperdata . hc_who . _Just . cw_lastName))
                               <*> Just ( Set.singleton (contact^.node_id))
               ) (tr_docs contacts)
 
@@ -176,7 +177,7 @@ getNgramsContactId aId = do
 getNgramsDocId :: CorpusId
                 -> ListId
                 -> NgramsType
-                -> GargNoServer (Map DocAuthor (Set NodeId))
+                -> GargNoServer (HashMap DocAuthor (Set NodeId))
 getNgramsDocId cId lId nt = do
   repo <- getRepo
   lIds <- selectNodesWithUsername NodeList userMaster

src/Gargantext/Database/Action/Metrics.hs

@@ -18,6 +18,7 @@ module Gargantext.Database.Action.Metrics
 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)
@@ -33,7 +34,7 @@ import Gargantext.Core.Text.Metrics (scored, Scored(..), {-localMetrics, toScore
 
 getMetrics :: FlowCmdM env err m
             => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
-            -> m (Map Text (ListType, Maybe Text), [Scored Text])
+            -> m (Map Text (ListType, Maybe Text), Vector (Scored Text))
 getMetrics cId maybeListId tabType maybeLimit = do
   (ngs, _, myCooc) <- getNgramsCooc cId maybeListId tabType maybeLimit
   pure (ngs, scored myCooc)
@@ -43,7 +44,7 @@ getNgramsCooc :: (FlowCmdM env err m)
             => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
             -> m ( Map Text (ListType, Maybe Text)
                  , Map Text (Maybe RootTerm)
-                 , Map (Text, Text) Int
+                 , HashMap (Text, Text) Int
                  )
 getNgramsCooc cId maybeListId tabType maybeLimit = do
   (ngs', ngs) <- getNgrams cId maybeListId tabType
@@ -55,7 +56,7 @@ getNgramsCooc cId maybeListId tabType maybeLimit = do
   lId  <- defaultList cId
   lIds <- selectNodesWithUsername NodeList userMaster
 
-  myCooc <- Map.filter (>1) <$> getCoocByNgrams (Diagonal True)
+  myCooc <- HM.filter (>1) <$> getCoocByNgrams (Diagonal True)
                            <$> groupNodesByNgrams ngs
                            <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) (ngramsTypeFromTabType tabType)
                                                             (take' maybeLimit $ Map.keys ngs)

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

@@ -56,5 +56,5 @@ getMetrics' cId maybeListId tabType maybeLimit = do
   {-
   _ <- Learn.grid 100 110 metrics' metrics'
   --}
-  pure $ Map.fromListWith (<>) metrics
+  pure $ Map.fromListWith (<>) $ Vec.toList metrics
 

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

@@ -16,7 +16,8 @@ module Gargantext.Database.Action.Metrics.TFICF
 
 -- import Debug.Trace (trace)
 -- import Gargantext.Core (Lang(..))
-import Data.Map.Strict (Map, toList, fromList)
+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
@@ -25,31 +26,28 @@ import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Query.Table.NodeNode (selectCountDocs)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
+import Gargantext.API.Ngrams.Types
 import Gargantext.Prelude
-import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 
 getTficf :: UserCorpusId
          -> MasterCorpusId
          -> NgramsType
-         -> Cmd err (Map Text Double)
+         -> Cmd err (HashMap NgramsTerm Double)
 getTficf cId mId nt = do
-  mapTextDoubleLocal <- Map.filter (> 1)
-     <$> Map.map (fromIntegral . Set.size)
+  mapTextDoubleLocal <- HM.filter (> 1)
+     <$> HM.map (fromIntegral . Set.size)
      <$> getNodesByNgramsUser cId nt
 
-  mapTextDoubleGlobal <- Map.map fromIntegral
-                     <$> getOccByNgramsOnlyFast mId nt (Map.keys mapTextDoubleLocal)
+  mapTextDoubleGlobal <- HM.map fromIntegral
+                     <$> getOccByNgramsOnlyFast mId nt (HM.keys mapTextDoubleLocal)
 
   countLocal  <- selectCountDocs cId
   countGlobal <- selectCountDocs mId
 
-  pure $ fromList [ ( t
-                    , tficf (TficfInfra (Count n                                               )
-                                        (Total $ fromIntegral countLocal ))
-                            (TficfSupra (Count $ fromMaybe 0 $ Map.lookup t mapTextDoubleGlobal)
+  pure $ HM.mapWithKey (\t n ->
+      tficf (TficfInfra (Count n                                               )
+                        (Total $ fromIntegral countLocal))
+            (TficfSupra (Count $ fromMaybe 0 $ HM.lookup t mapTextDoubleGlobal)
                         (Total $ fromIntegral countGlobal))
-                    )
-                  | (t, n) <- toList mapTextDoubleLocal
+    ) mapTextDoubleLocal
\ No newline at end of file
-                  ]
-

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

@@ -21,8 +21,10 @@ Portability : POSIX
 module Gargantext.Database.Admin.Types.Hyperdata.List
   where
 
-import Data.Map (Map)
-import qualified Data.Map as Map
+import Data.Vector (Vector)
+--import qualified Data.Vector as V
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HM
 import Control.Applicative
 
 import Gargantext.Prelude
@@ -34,11 +36,11 @@ import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metrics)
 
 ------------------------------------------------------------------------
 data HyperdataList =
-  HyperdataList { _hl_chart   :: !(Map TabType (ChartMetrics Histo))
+  HyperdataList { _hl_chart   :: !(HashMap TabType (ChartMetrics Histo))
                 , _hl_list    :: !(Maybe Text)
-                , _hl_pie     :: !(Map TabType (ChartMetrics Histo))
-                , _hl_scatter :: !(Map TabType Metrics)
-                , _hl_tree    :: !(Map TabType (ChartMetrics [NgramsTree]))
+                , _hl_pie     :: !(HashMap TabType (ChartMetrics Histo))
+                , _hl_scatter :: !(HashMap TabType Metrics)
+                , _hl_tree    :: !(HashMap TabType (ChartMetrics (Vector NgramsTree)))
                 } deriving (Show, Generic)
   -- HyperdataList { _hl_chart   :: !(Maybe (ChartMetrics Histo))
   --               , _hl_list    :: !(Maybe Text)
@@ -49,11 +51,11 @@ data HyperdataList =
 
 defaultHyperdataList :: HyperdataList
 defaultHyperdataList =
-  HyperdataList { _hl_chart   = Map.empty
+  HyperdataList { _hl_chart   = HM.empty
                 , _hl_list    = Nothing
-                , _hl_pie     = Map.empty
-                , _hl_scatter = Map.empty
-                , _hl_tree    = Map.empty
+                , _hl_pie     = HM.empty
+                , _hl_scatter = HM.empty
+                , _hl_tree    = HM.empty
                 }
 
 ------------------------------------------------------------------------

src/Gargantext/Database/Admin/Types/Metrics.hs

@@ -5,6 +5,8 @@ module Gargantext.Database.Admin.Types.Metrics where
 
 import Data.Aeson.TH (deriveJSON)
 import Data.Swagger
+import Data.Vector (Vector)
+import qualified Data.Vector as V
 import Protolude
 import Test.QuickCheck.Arbitrary
 
@@ -13,15 +15,15 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 
 ----------------------------------------------------------------------------
 
-data Metrics = Metrics
-  { metrics_data :: [Metric]}
+newtype Metrics = Metrics
+  { metrics_data :: Vector Metric}
   deriving (Generic, Show)
 
 instance ToSchema Metrics where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "metrics_")
 instance Arbitrary Metrics
   where
-    arbitrary = Metrics <$> arbitrary
+    arbitrary = (Metrics . V.fromList) <$> arbitrary
 
 data Metric = Metric
   { m_label :: !Text
@@ -43,7 +45,7 @@ deriveJSON (unPrefix "metrics_") ''Metrics
 deriveJSON (unPrefix "m_") ''Metric
 
 
-data ChartMetrics a = ChartMetrics { chartMetrics_data :: a }
+newtype ChartMetrics a = ChartMetrics { chartMetrics_data :: a }
   deriving (Generic, Show)
 
 instance (Typeable a, ToSchema a) => ToSchema (ChartMetrics a) where

src/Gargantext/Database/Admin/Types/Node.hs

@@ -24,6 +24,7 @@ import Control.Monad (mzero)
 import Data.Aeson
 import Data.Aeson.TH (deriveJSON)
 import Data.Either
+import Data.Hashable (Hashable)
 import Data.Swagger
 import Data.Text (Text, unpack)
 import Data.Time (UTCTime)
@@ -130,7 +131,7 @@ pgNodeId = O.pgInt4 . id2int
 
 ------------------------------------------------------------------------
 newtype NodeId = NodeId Int
-  deriving (Show, Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON)
+  deriving (Show, Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON, Hashable)
 
 unNodeId :: NodeId -> Int
 unNodeId (NodeId n) = n