[FEAT] Invitation through Shared node
[gargantext.git] / src / Gargantext / API / Ngrams / Tools.hs
index ad57701cbfc9cd4d82a7fc6e4b87218e9e6e674c..5ee381ee5ed60dfab90c0726c720c77c04eb6a88 100644 (file)
@@ -9,9 +9,6 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes        #-}
 
 module Gargantext.API.Ngrams.Tools
   where
@@ -20,32 +17,35 @@ import Control.Concurrent
 import Control.Lens (_Just, (^.), at, view)
 import Control.Monad.Reader
 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
+
+import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types (ListType(..), NodeId, ListId)
 import Gargantext.Database.Schema.Ngrams (NgramsType)
 import Gargantext.Prelude
-import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
 
+mergeNgramsElement :: NgramsRepoElement -> NgramsRepoElement -> NgramsRepoElement
+mergeNgramsElement _neOld neNew = neNew
 
 type RootTerm = Text
 
 getRepo :: RepoCmdM env err m => m NgramsRepo
 getRepo = do
   v <- view repoVar
-  liftIO $ readMVar v
+  liftBase $ readMVar v
 
 listNgramsFromRepo :: [ListId] -> NgramsType
                    -> NgramsRepo -> Map Text NgramsRepoElement
-listNgramsFromRepo nodeIds ngramsType repo = ngrams
+listNgramsFromRepo nodeIds ngramsType repo = Map.mapKeys unNgramsTerm ngrams
   where
     ngramsMap = repo ^. r_state . at ngramsType . _Just
 
     ngrams    = Map.unionsWith mergeNgramsElement
-              [ ngramsMap ^. at nodeId . _Just | nodeId <- nodeIds ]
+                [ ngramsMap ^. at nodeId . _Just | nodeId <- nodeIds ]
 
 -- TODO-ACCESS: We want to do the security check before entering here.
 --              Add a static capability parameter would be nice.
@@ -71,21 +71,24 @@ getTermsWith f ls ngt lt = Map.fromListWith (<>)
       Nothing -> (f'' t, [])
       Just  r -> (f'' r, map f'' [t])
 
-mapTermListRoot :: [ListId] -> NgramsType
-                -> NgramsRepo -> Map Text (ListType, (Maybe Text))
+mapTermListRoot :: [ListId]
+                -> NgramsType
+                -> NgramsRepo
+                -> Map Text (ListType, (Maybe Text))
 mapTermListRoot nodeIds ngramsType repo =
-  Map.fromList [ (t, (_nre_list nre, _nre_root nre))
+  Map.fromList [ (t, (_nre_list nre, unNgramsTerm <$> _nre_root nre))
                | (t, nre) <- Map.toList ngrams
                ]
   where ngrams = listNgramsFromRepo nodeIds ngramsType repo
 
-filterListWithRoot :: ListType -> Map Text (ListType, Maybe Text)
-                      -> Map Text (Maybe RootTerm)
+filterListWithRoot :: ListType
+                   -> Map Text (ListType, Maybe Text)
+                   -> Map Text (Maybe RootTerm)
 filterListWithRoot lt m = Map.fromList
                     $ map (\(t,(_,r)) -> (t,r))
-                    $ filter isGraphTerm (Map.toList m)
+                    $ filter isMapTerm (Map.toList m)
   where
-    isGraphTerm (_t,(l, maybeRoot)) = case maybeRoot of
+    isMapTerm (_t,(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