[NGRAMS-REPO] Basic flow insertion

bin/gargantext-import/Main.hs

@@ -26,6 +26,7 @@ import Gargantext.Database.Utils (Cmd, connectGargandb, runCmdDevWith)
 import Gargantext.Database.Types.Node (NodeId)
 --import Gargantext.Database.Schema.User (insertUsers, gargantuaUser, simpleUser)
 import Gargantext.API.Node () -- instances
+import Gargantext.API.Ngrams (RepoCmdM)
 import System.Environment (getArgs)
 
 main :: IO ()
@@ -36,9 +37,12 @@ main = do
       createUsers = insertUsers [gargantuaUser,simpleUser]
   _ <- runCmdDevWith iniPath createUsers
   -}
-  let cmd :: Cmd ServantErr NodeId
+
+  {- -- TODO missing repo var...
+  let cmd :: RepoCmdM env ServantErr m => m NodeId
       cmd = flowCorpus CsvHalFormat corpusPath (cs name)
   r <- runCmdDevWith iniPath cmd
+  -}
   pure ()
 
 

package.yaml

@@ -28,6 +28,7 @@ library:
   - Gargantext.API.Auth
   - Gargantext.API.Count
   - Gargantext.API.FrontEnd
+  - Gargantext.API.Ngrams
   - Gargantext.API.Node
   - Gargantext.API.Orchestrator
   - Gargantext.API.Search

src/Gargantext/API/Ngrams.hs

@@ -34,7 +34,7 @@ add get
 module Gargantext.API.Ngrams
   where
 
-import Prelude (Enum, Bounded, Semigroup(..), minBound, maxBound {-, round-})
+import Prelude (Enum, Bounded, Semigroup(..), minBound, maxBound {-, round-}, error)
 -- import Gargantext.Database.Schema.User  (UserId)
 import Data.Functor (($>))
 import Data.Patch.Class (Replace, replace, Action(act), Applicable(..),
@@ -611,6 +611,18 @@ instance HasInvalidError ServantErr where
 assertValid :: (MonadError e m, HasInvalidError e) => Validation -> m ()
 assertValid v = when (not $ validationIsValid v) $ throwError $ _InvalidError # v
 
+-- Current state:
+--   Insertions are not considered as patches,
+--   they do not extend history,
+--   they do not bump version.
+insertNewListOfNgramsElements :: RepoCmdM env err m => ListId
+                              -> Map NgramsType [NgramsElement] -> m ()
+insertNewListOfNgramsElements listId m = do
+  var <- view repoVar
+  liftIO $ modifyMVar_ var $ pure . (r_state . at listId %~ insertNewOnly m')
+  where
+    m' = (Map.fromList . fmap (\n -> (n ^. ne_ngrams, n))) <$> m
+
 -- Apply the given patch to the DB and returns the patch to be applied on the
 -- cilent.
 -- TODO:

src/Gargantext/Database/Flow.hs

@@ -23,6 +23,7 @@ import Control.Monad.IO.Class (liftIO)
 --import Gargantext.Database.Node.Contact (HyperdataContact(..))
 import Data.Map (Map, lookup)
 import Data.Maybe (Maybe(..), catMaybes)
+import Data.Monoid
 import Data.Text (Text, splitOn, intercalate)
 import Data.Tuple.Extra (both)
 import Data.List (concat)
@@ -52,10 +53,13 @@ import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile)
 import Gargantext.Prelude
 import Gargantext.Text.Parsers (parseDocs, FileFormat)
 import System.FilePath (FilePath)
+
+import Gargantext.API.Ngrams (NgramsElement(..), insertNewListOfNgramsElements, RepoCmdM)
+
 import qualified Data.Map as DM
 
 
-flowCorpus :: HasNodeError err => FileFormat -> FilePath -> CorpusName -> Cmd err CorpusId
+flowCorpus :: RepoCmdM env err m => FileFormat -> FilePath -> CorpusName -> m CorpusId
 flowCorpus ff fp cName = do
   hyperdataDocuments' <- map addUniqIdsDoc <$> liftIO (parseDocs ff fp)
   params <- flowInsert NodeCorpus hyperdataDocuments' cName
@@ -104,10 +108,10 @@ flowInsertAnnuaire name children = do
 -- TODO-EVENTS:
 --   InsertedNgrams ?
 --   InsertedNodeNgrams ?
-flowCorpus' :: HasNodeError err
+flowCorpus' :: RepoCmdM env err m
             => NodeType -> [HyperdataDocument]
             -> ([ReturnId], UserId, CorpusId, UserId, CorpusId)
-            -> Cmd err CorpusId
+            -> m CorpusId
 flowCorpus' NodeCorpus hyperdataDocuments (ids,_masterUserId,_masterCorpusId, userId,userCorpusId) = do
 --------------------------------------------------
   -- List Ngrams Flow
@@ -288,13 +292,19 @@ flowList uId cId _ngs = do
 
   pure lId
 
-flowListUser :: HasNodeError err => UserId -> CorpusId -> Int -> Cmd err NodeId
+flowListUser :: RepoCmdM env err m
+             => UserId -> CorpusId -> Int -> m NodeId
 flowListUser uId cId n = do
   lId <- getOrMkList cId uId
   -- is <- insertLists lId $ ngrams2list ngs
 
   ngs <- take n <$> sortWith tficf_score <$> getTficf userMaster cId lId NgramsTerms
-  _ <- insertNodeNgrams [ NodeNgram lId (tficf_ngramsId ng) Nothing (ngramsTypeId NgramsTerms) (fromIntegral $ listTypeId GraphList) 1 | ng <- ngs]
+--  _ <- insertNodeNgrams [ NodeNgram lId (tficf_ngramsId ng) Nothing (ngramsTypeId NgramsTerms) (fromIntegral $ listTypeId GraphList) 1 | ng <- ngs]
+
+  insertNewListOfNgramsElements lId $
+    DM.singleton NgramsTerms
+      [ NgramsElement (tficf_ngramsTerms ng) GraphList 1 Nothing mempty
+      | ng <- ngs ]
 
   pure lId