[NGRAMS-REPO] Basic flow insertion

parent b97feff8
...@@ -26,6 +26,7 @@ import Gargantext.Database.Utils (Cmd, connectGargandb, runCmdDevWith) ...@@ -26,6 +26,7 @@ import Gargantext.Database.Utils (Cmd, connectGargandb, runCmdDevWith)
import Gargantext.Database.Types.Node (NodeId) import Gargantext.Database.Types.Node (NodeId)
--import Gargantext.Database.Schema.User (insertUsers, gargantuaUser, simpleUser) --import Gargantext.Database.Schema.User (insertUsers, gargantuaUser, simpleUser)
import Gargantext.API.Node () -- instances import Gargantext.API.Node () -- instances
import Gargantext.API.Ngrams (RepoCmdM)
import System.Environment (getArgs) import System.Environment (getArgs)
main :: IO () main :: IO ()
...@@ -36,9 +37,12 @@ main = do ...@@ -36,9 +37,12 @@ main = do
createUsers = insertUsers [gargantuaUser,simpleUser] createUsers = insertUsers [gargantuaUser,simpleUser]
_ <- runCmdDevWith iniPath createUsers _ <- 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) cmd = flowCorpus CsvHalFormat corpusPath (cs name)
r <- runCmdDevWith iniPath cmd r <- runCmdDevWith iniPath cmd
-}
pure () pure ()
...@@ -28,6 +28,7 @@ library: ...@@ -28,6 +28,7 @@ library:
- Gargantext.API.Auth - Gargantext.API.Auth
- Gargantext.API.Count - Gargantext.API.Count
- Gargantext.API.FrontEnd - Gargantext.API.FrontEnd
- Gargantext.API.Ngrams
- Gargantext.API.Node - Gargantext.API.Node
- Gargantext.API.Orchestrator - Gargantext.API.Orchestrator
- Gargantext.API.Search - Gargantext.API.Search
......
...@@ -34,7 +34,7 @@ add get ...@@ -34,7 +34,7 @@ add get
module Gargantext.API.Ngrams module Gargantext.API.Ngrams
where 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 Gargantext.Database.Schema.User (UserId)
import Data.Functor (($>)) import Data.Functor (($>))
import Data.Patch.Class (Replace, replace, Action(act), Applicable(..), import Data.Patch.Class (Replace, replace, Action(act), Applicable(..),
...@@ -611,6 +611,18 @@ instance HasInvalidError ServantErr where ...@@ -611,6 +611,18 @@ instance HasInvalidError ServantErr where
assertValid :: (MonadError e m, HasInvalidError e) => Validation -> m () assertValid :: (MonadError e m, HasInvalidError e) => Validation -> m ()
assertValid v = when (not $ validationIsValid v) $ throwError $ _InvalidError # v 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 -- Apply the given patch to the DB and returns the patch to be applied on the
-- cilent. -- cilent.
-- TODO: -- TODO:
......
...@@ -23,6 +23,7 @@ import Control.Monad.IO.Class (liftIO) ...@@ -23,6 +23,7 @@ import Control.Monad.IO.Class (liftIO)
--import Gargantext.Database.Node.Contact (HyperdataContact(..)) --import Gargantext.Database.Node.Contact (HyperdataContact(..))
import Data.Map (Map, lookup) import Data.Map (Map, lookup)
import Data.Maybe (Maybe(..), catMaybes) import Data.Maybe (Maybe(..), catMaybes)
import Data.Monoid
import Data.Text (Text, splitOn, intercalate) import Data.Text (Text, splitOn, intercalate)
import Data.Tuple.Extra (both) import Data.Tuple.Extra (both)
import Data.List (concat) import Data.List (concat)
...@@ -52,10 +53,13 @@ import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile) ...@@ -52,10 +53,13 @@ import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Text.Parsers (parseDocs, FileFormat) import Gargantext.Text.Parsers (parseDocs, FileFormat)
import System.FilePath (FilePath) import System.FilePath (FilePath)
import Gargantext.API.Ngrams (NgramsElement(..), insertNewListOfNgramsElements, RepoCmdM)
import qualified Data.Map as DM 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 flowCorpus ff fp cName = do
hyperdataDocuments' <- map addUniqIdsDoc <$> liftIO (parseDocs ff fp) hyperdataDocuments' <- map addUniqIdsDoc <$> liftIO (parseDocs ff fp)
params <- flowInsert NodeCorpus hyperdataDocuments' cName params <- flowInsert NodeCorpus hyperdataDocuments' cName
...@@ -104,10 +108,10 @@ flowInsertAnnuaire name children = do ...@@ -104,10 +108,10 @@ flowInsertAnnuaire name children = do
-- TODO-EVENTS: -- TODO-EVENTS:
-- InsertedNgrams ? -- InsertedNgrams ?
-- InsertedNodeNgrams ? -- InsertedNodeNgrams ?
flowCorpus' :: HasNodeError err flowCorpus' :: RepoCmdM env err m
=> NodeType -> [HyperdataDocument] => NodeType -> [HyperdataDocument]
-> ([ReturnId], UserId, CorpusId, UserId, CorpusId) -> ([ReturnId], UserId, CorpusId, UserId, CorpusId)
-> Cmd err CorpusId -> m CorpusId
flowCorpus' NodeCorpus hyperdataDocuments (ids,_masterUserId,_masterCorpusId, userId,userCorpusId) = do flowCorpus' NodeCorpus hyperdataDocuments (ids,_masterUserId,_masterCorpusId, userId,userCorpusId) = do
-------------------------------------------------- --------------------------------------------------
-- List Ngrams Flow -- List Ngrams Flow
...@@ -288,13 +292,19 @@ flowList uId cId _ngs = do ...@@ -288,13 +292,19 @@ flowList uId cId _ngs = do
pure lId 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 flowListUser uId cId n = do
lId <- getOrMkList cId uId lId <- getOrMkList cId uId
-- is <- insertLists lId $ ngrams2list ngs -- is <- insertLists lId $ ngrams2list ngs
ngs <- take n <$> sortWith tficf_score <$> getTficf userMaster cId lId NgramsTerms 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 pure lId
......
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