[FIX] History patch working, bug several NRE fixed, needs stemming scores now
[gargantext.git] / src / Gargantext / API / Ngrams / Tools.hs
index 0f33b7c0e171393d951ab18837fa852353d66326..d4dfc1c38266ede03a1191f92f83cf5447a2c965 100644 (file)
@@ -9,9 +9,6 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes        #-}
 
 module Gargantext.API.Ngrams.Tools
   where
@@ -20,37 +17,46 @@ 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
 
--- 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 = do
-  v    <- view repoVar
-  repo <- liftIO $ readMVar v
+getRepo :: RepoCmdM env err m => m NgramsRepo
+getRepo = do
+  v <- view repoVar
+  liftBase $ readMVar v
 
-  let
+listNgramsFromRepo :: [ListId] -> NgramsType
+                   -> NgramsRepo -> Map Text NgramsRepoElement
+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 ]
+
+
 
-  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]
@@ -61,27 +67,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, 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 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