[nodeStory] add immediate saver

This is used to save when quitting the server. Previous, debounce
save, didn't work properly on exit.

bin/gargantext-server/Main.hs

@@ -80,4 +80,3 @@ main = do
 
   putStrLn $ "Starting with " <> show myMode <> " mode."
   start
-

bin/gargantext-upgrade/Main.hs

@@ -62,7 +62,7 @@ main = do
            , ""
            , "Press ENTER if you want to continue, CTRL+C if you want to stop."
            ]
-  
+
   _ok  <- getLine
 
   cfg       <- readConfig         iniPath
@@ -88,7 +88,7 @@ main = do
     _ <- runCmdDev env (initFirstTriggers secret :: Cmd GargError [Int64])
     _ <- runCmdDev env (contextsTriggers         :: Cmd GargError ())
 
-   -- Move nodes to contexts table 
+   -- Move nodes to contexts table
     _ <- runCmdDev env sqlNodes2Contexts
 
    -- Update the hashes
@@ -283,6 +283,3 @@ sqlSchema = do
         CREATE INDEX IF NOT EXISTS context_node_node_id_idx ON public.context_node_ngrams USING btree (node_id);
 
   |]
-
-
-

src/Gargantext/API.hs

@@ -47,7 +47,7 @@ import Gargantext.API.Admin.Auth.Types (AuthContext)
 import Gargantext.API.Admin.Settings (newEnv)
 import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings)
 import Gargantext.API.EKG
-import Gargantext.API.Ngrams (saveNodeStory)
+import Gargantext.API.Ngrams (saveNodeStoryImmediate)
 import Gargantext.API.Prelude
 import Gargantext.API.Routes
 import Gargantext.API.Server (server)
@@ -92,10 +92,10 @@ portRouteInfo port = do
   putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 
 -- TODO clean this Monad condition (more generic) ?
-stopGargantext :: HasNodeStorySaver env => env -> IO ()
+stopGargantext :: HasNodeStoryImmediateSaver env => env -> IO ()
 stopGargantext env = do
   putStrLn "----- Stopping gargantext -----"
-  runReaderT saveNodeStory env
+  runReaderT saveNodeStoryImmediate env
 
 {-
 startGargantextMock :: PortNumber -> IO ()

src/Gargantext/API/Admin/EnvTypes.hs

@@ -53,6 +53,9 @@ instance HasNodeStoryVar Env where
 instance HasNodeStorySaver Env where
   hasNodeStorySaver = hasNodeStory . nse_saver
 
+instance HasNodeStoryImmediateSaver Env where
+  hasNodeStoryImmediateSaver = hasNodeStory . nse_saver_immediate
+
 instance HasSettings Env where
   settings = env_settings
 
@@ -104,5 +107,8 @@ instance HasNodeStoryVar DevEnv where
 instance HasNodeStorySaver DevEnv where
   hasNodeStorySaver = hasNodeStory . nse_saver
 
+instance HasNodeStoryImmediateSaver DevEnv where
+  hasNodeStoryImmediateSaver = hasNodeStory . nse_saver_immediate
+
 instance HasMail DevEnv where
   mailSettings = dev_env_mail

src/Gargantext/API/Dev.hs

@@ -17,7 +17,7 @@ import Control.Monad (fail)
 import Control.Monad.Reader (runReaderT)
 import Gargantext.API.Admin.EnvTypes
 import Gargantext.API.Admin.Settings
-import Gargantext.API.Ngrams (saveNodeStory)
+import Gargantext.API.Ngrams (saveNodeStoryImmediate)
 import Gargantext.API.Prelude
 import Gargantext.Core.NodeStory
 import Gargantext.Database.Prelude
@@ -66,7 +66,7 @@ runCmdDev :: Show err => DevEnv -> Cmd'' DevEnv err a -> IO a
 runCmdDev env f =
   (either (fail . show) pure =<< runCmd env f)
     `finally`
-  runReaderT saveNodeStory env
+  runReaderT saveNodeStoryImmediate env
 
 runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
 runCmdDevNoErr = runCmdDev

src/Gargantext/API/Ngrams.hs

@@ -55,6 +55,7 @@ module Gargantext.API.Ngrams
   , r_history
   , NgramsRepoElement(..)
   , saveNodeStory
+  , saveNodeStoryImmediate
   , initRepo
 
   , TabType(..)
@@ -179,7 +180,22 @@ mkChildrenGroups addOrRem nt patches =
 
 saveNodeStory :: ( MonadReader env m, MonadBase IO m, HasNodeStorySaver env )
          => m ()
-saveNodeStory = liftBase =<< view hasNodeStorySaver
+saveNodeStory = do
+  saver <- view hasNodeStorySaver
+  liftBase $ do
+    Gargantext.Prelude.putStrLn "---- Running node story saver ----"
+    saver
+    Gargantext.Prelude.putStrLn "---- Node story saver finished ----"
+
+
+saveNodeStoryImmediate :: ( MonadReader env m, MonadBase IO m, HasNodeStoryImmediateSaver env )
+         => m ()
+saveNodeStoryImmediate = do
+  saver <- view hasNodeStoryImmediateSaver
+  liftBase $ do
+    Gargantext.Prelude.putStrLn "---- Running node story immediate saver ----"
+    saver
+    Gargantext.Prelude.putStrLn "---- Node story immediate saver finished ----"
 
 
 listTypeConflictResolution :: ListType -> ListType -> ListType

src/Gargantext/Core/NodeStory.hs

@@ -54,6 +54,8 @@ module Gargantext.Core.NodeStory
   , hasNodeStoryVar
   , HasNodeStorySaver
   , hasNodeStorySaver
+  , HasNodeStoryImmediateSaver
+  , hasNodeStoryImmediateSaver
   , NodeStory(..)
   , NgramsStatePatch'
   , NodeListStory
@@ -62,6 +64,7 @@ module Gargantext.Core.NodeStory
   , initNodeStory
   , nse_getter
   , nse_saver
+  , nse_saver_immediate
   , nse_var
   , unNodeStory
   , getNodeArchiveHistory
@@ -123,6 +126,7 @@ import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
 data NodeStoryEnv = NodeStoryEnv
   { _nse_var    :: !(MVar NodeListStory)
   , _nse_saver  :: !(IO ())
+  , _nse_saver_immediate :: !(IO ())
   , _nse_getter :: [NodeId] -> IO (MVar NodeListStory)
   --, _nse_cleaner :: !(IO ()) -- every 12 hours: cleans the repos of unused NodeStories
   -- , _nse_lock  :: !FileLock -- TODO (it depends on the option: if with database or file only)
@@ -148,6 +152,9 @@ class HasNodeStoryVar env where
 class HasNodeStorySaver env where
   hasNodeStorySaver :: Getter env (IO ())
 
+class HasNodeStoryImmediateSaver env where
+  hasNodeStoryImmediateSaver :: Getter env (IO ())
+
 ------------------------------------------------------------------------
 
 {- | Node Story for each NodeType where the Key of the Map is NodeId
@@ -592,6 +599,11 @@ readNodeStoryEnv :: Pool PGS.Connection -> IO NodeStoryEnv
 readNodeStoryEnv pool = do
   mvar <- nodeStoryVar pool Nothing []
   saver <- mkNodeStorySaver pool mvar
+  let saver_immediate = modifyMVar_ mvar $ \ns -> do
+        withResource pool $ \c -> do
+          --printDebug "[mkNodeStorySaver] will call writeNodeStories, ns" ns
+          writeNodeStories c ns
+          pure $ clearHistory ns
   -- let saver = modifyMVar_ mvar $ \mv -> do
   --       writeNodeStories pool mv
   --       printDebug "[readNodeStoryEnv] saver" mv
@@ -600,6 +612,7 @@ readNodeStoryEnv pool = do
   --       return mv'
   pure $ NodeStoryEnv { _nse_var    = mvar
                       , _nse_saver  = saver
+                      , _nse_saver_immediate = saver_immediate
                       , _nse_getter = nodeStoryVar pool (Just mvar) }
 
 nodeStoryVar :: Pool PGS.Connection -> Maybe (MVar NodeListStory) -> [NodeId] -> IO (MVar NodeListStory)

src/Gargantext/Core/NodeStoryFile.hs

@@ -57,8 +57,10 @@ readNodeStoryEnv :: NodeStoryDir -> IO NodeStoryEnv
 readNodeStoryEnv nsd = do
   mvar  <- nodeStoryVar nsd Nothing []
   saver <- mkNodeStorySaver nsd mvar
+  let saver_immediate = withMVar mvar (writeNodeStories nsd)
   pure $ NodeStoryEnv { _nse_var = mvar
                       , _nse_saver = saver
+                      , _nse_saver_immediate = saver_immediate
                       , _nse_getter = nodeStoryVar nsd (Just mvar) }
 
 ------------------------------------------------------------------------