[OPTIM + FIX] TFICF
[gargantext.git] / src / Gargantext / API / Ngrams / Tools.hs
index 4407da02b62926d41c85cc0c84eec8fd0d3db0b4..f7ea35f4c5c935c80751777f742a15f74cc164aa 100644 (file)
@@ -9,9 +9,6 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes        #-}
 
 module Gargantext.API.Ngrams.Tools
   where
@@ -30,24 +27,30 @@ import Gargantext.Prelude
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 
-
 type RootTerm = Text
 
+getRepo :: RepoCmdM env err m => m NgramsRepo
+getRepo = do
+  v <- view repoVar
+  liftBase $ readMVar v
 
-getListNgrams :: RepoCmdM env err m
-               => [ListId] -> NgramsType
-               -> m (Map Text NgramsRepoElement)
-getListNgrams nodeIds ngramsType = do
-  v    <- view repoVar
-  repo <- liftIO $ readMVar v
-
-  let
+listNgramsFromRepo :: [ListId] -> NgramsType
+                   -> NgramsRepo -> Map Text NgramsRepoElement
+listNgramsFromRepo nodeIds ngramsType repo = ngrams
+  where
     ngramsMap = repo ^. r_state . at ngramsType . _Just
 
     ngrams    = Map.unionsWith mergeNgramsElement
               [ ngramsMap ^. at nodeId . _Just | nodeId <- nodeIds ]
 
-  pure ngrams
+-- TODO-ACCESS: We want to do the security check before entering here.
+--              Add a static capability parameter would be nice.
+--              Ideally this is the access to `repoVar` which needs to
+--              be properly guarded.
+getListNgrams :: RepoCmdM env err m
+              => [ListId] -> NgramsType
+              -> m (Map Text NgramsRepoElement)
+getListNgrams nodeIds ngramsType = listNgramsFromRepo nodeIds ngramsType <$> getRepo
 
 getTermsWith :: (RepoCmdM env err m, Ord a)
           => (Text -> a ) -> [ListId]
@@ -58,27 +61,30 @@ getTermsWith f ls ngt lt = Map.fromListWith (<>)
                       <$> Map.toList
                       <$> 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])
 
-mapTermListRoot :: RepoCmdM env err m
-               => [ListId] -> NgramsType
-               -> m (Map Text (ListType, (Maybe Text)))
-mapTermListRoot nodeIds ngramsType = do
-  ngrams <- getListNgrams nodeIds ngramsType
-  pure $ Map.fromList [(t, (_nre_list nre, _nre_root nre))
-                      | (t, nre) <- Map.toList ngrams
-                      ]
-
-filterListWithRoot :: ListType -> Map Text (ListType, Maybe Text)
-                      -> Map Text (Maybe RootTerm)
+mapTermListRoot :: [ListId]
+                -> NgramsType
+                -> NgramsRepo
+                -> Map Text (ListType, (Maybe Text))
+mapTermListRoot nodeIds ngramsType repo =
+  Map.fromList [ (t, (_nre_list nre, _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 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
@@ -104,14 +110,12 @@ getCoocByNgrams = getCoocByNgrams' identity
 
 getCoocByNgrams' :: (Ord a, Ord c) => (b -> Set c) -> Diagonal -> Map a b -> Map (a, a) Int
 getCoocByNgrams' f (Diagonal diag) m =
-  Map.fromList [((t1,t2)
-                ,maybe 0 Set.size $ Set.intersection
-                                 <$> (fmap f $ Map.lookup t1 m)
-                                 <*> (fmap f $ Map.lookup t2 m)
+  Map.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)
                ]
 
-
-