[NGRAMS-REPO] fix putListNgrams (no need for addListNgrams)

parent 0638f3db
...@@ -54,7 +54,7 @@ import Data.Map.Strict (Map) ...@@ -54,7 +54,7 @@ import Data.Map.Strict (Map)
--import qualified Data.Set as Set --import qualified Data.Set as Set
import Control.Category ((>>>)) import Control.Category ((>>>))
import Control.Concurrent import Control.Concurrent
import Control.Lens (makeLenses, makePrisms, Getter, Prism', prism', Iso', iso, from, (^..), (.~), (#), to, {-withIndex, folded, ifolded,-} view, (^.), (+~), (<>~), (%~), at, _Just, Each(..), itraverse_, (.=), both, mapped) import Control.Lens (makeLenses, makePrisms, Getter, Prism', prism', Iso', iso, from, (^..), (.~), (#), to, {-withIndex, folded, ifolded,-} view, (^.), (+~), (%~), at, _Just, Each(..), itraverse_, (.=), both, mapped)
import Control.Monad (guard) import Control.Monad (guard)
import Control.Monad.Error.Class (MonadError, throwError) import Control.Monad.Error.Class (MonadError, throwError)
import Control.Monad.Reader import Control.Monad.Reader
...@@ -677,7 +677,6 @@ copyListNgrams srcListId dstListId ngramsType = do ...@@ -677,7 +677,6 @@ copyListNgrams srcListId dstListId ngramsType = do
where where
f :: Map NodeId NgramsTableMap -> Map NodeId NgramsTableMap f :: Map NodeId NgramsTableMap -> Map NodeId NgramsTableMap
f m = m & at dstListId %~ insertNewOnly (m ^. at srcListId) f m = m & at dstListId %~ insertNewOnly (m ^. at srcListId)
-}
-- TODO refactor with putListNgrams -- TODO refactor with putListNgrams
-- The list must be non-empty! -- The list must be non-empty!
...@@ -692,6 +691,7 @@ addListNgrams listId ngramsType nes = do ...@@ -692,6 +691,7 @@ addListNgrams listId ngramsType nes = do
saveRepo saveRepo
where where
m = Map.fromList $ (\n -> (n ^. ne_ngrams, n)) <$> nes m = Map.fromList $ (\n -> (n ^. ne_ngrams, n)) <$> nes
-}
putListNgrams :: RepoCmdM env err m putListNgrams :: RepoCmdM env err m
=> NodeId -> NgramsType => NodeId -> NgramsType
...@@ -699,7 +699,7 @@ putListNgrams :: RepoCmdM env err m ...@@ -699,7 +699,7 @@ putListNgrams :: RepoCmdM env err m
putListNgrams listId ngramsType nes = do putListNgrams listId ngramsType nes = do
var <- view repoVar var <- view repoVar
liftIO $ modifyMVar_ var $ liftIO $ modifyMVar_ var $
pure . (r_state . at ngramsType %~ (Just . (at listId %~ insertNewOnly (Just m)) . something)) pure . (r_state . at ngramsType %~ (Just . (at listId %~ (Just . (m <>) . something)) . something))
saveRepo saveRepo
where where
m = Map.fromList $ (\n -> (n ^. ne_ngrams, n)) <$> nes m = Map.fromList $ (\n -> (n ^. ne_ngrams, n)) <$> nes
......
...@@ -59,7 +59,7 @@ import Gargantext.Text.Parsers (parseDocs, FileFormat) ...@@ -59,7 +59,7 @@ import Gargantext.Text.Parsers (parseDocs, FileFormat)
import System.FilePath (FilePath) import System.FilePath (FilePath)
import Gargantext.API.Ngrams (HasRepoVar) import Gargantext.API.Ngrams (HasRepoVar)
import Servant (ServantErr) import Servant (ServantErr)
import Gargantext.API.Ngrams (NgramsElement(..), putListNgrams, addListNgrams, RepoCmdM) import Gargantext.API.Ngrams (NgramsElement(..), putListNgrams, RepoCmdM)
--import Gargantext.Database.Schema.User (insertUsers, simpleUser, gargantuaUser) --import Gargantext.Database.Schema.User (insertUsers, simpleUser, gargantuaUser)
import qualified Data.Map as DM import qualified Data.Map as DM
...@@ -274,7 +274,7 @@ flowListUser uId cId ngsM n = do ...@@ -274,7 +274,7 @@ flowListUser uId cId ngsM n = do
<$> getTficf userMaster cId lId NgramsTerms <$> getTficf userMaster cId lId NgramsTerms
flowListBase lId ngsM flowListBase lId ngsM
addListNgrams lId NgramsTerms $ putListNgrams lId NgramsTerms $
[ NgramsElement (tficf_ngramsTerms ng) GraphList 1 Nothing mempty [ NgramsElement (tficf_ngramsTerms ng) GraphList 1 Nothing mempty
| ng <- ngs | ng <- ngs
] ]
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment