Bind periodic actions to the main loop

bin/gargantext-server/Main.hs

@@ -29,10 +29,8 @@ import GHC.IO.Exception (IOException)
 import Gargantext.API (startGargantext, Mode(..)) -- , startGargantextMock)
 import Gargantext.API.Admin.EnvTypes (DevEnv)
 import Gargantext.API.Dev (withDevEnv, runCmdDev)
-import Gargantext.Database.Prelude (Cmd'', Cmd, execPGSQuery)
 import Gargantext.Prelude
 import Options.Generic
-import System.Cron.Schedule
 import System.Exit (exitSuccess)
 import qualified Paths_gargantext as PG -- cabal magic build module
 
@@ -83,22 +81,3 @@ main = do
   putStrLn $ "Starting with " <> show myMode <> " mode."
   start
   ---------------------------------------------------------------
-
-  putStrLn $ "Starting Schedule Jobs"
-
-  withDevEnv (unpack myIniFile') $ \env -> do
-    tids <- execSchedule $ do
-           addJob (runCmdDev env refreshIndex) "5 * * * *"
-    putStrLn ("Refresh Index Cron Job started" <> show tids)
-
-
-
-
-refreshIndex :: Cmd'' DevEnv IOException ()
-refreshIndex = do
-  _ <- execPGSQuery [sql| refresh materialized view context_node_ngrams_view; |] ()
-  pure ()
-
-
-
-

gargantext.cabal

@@ -56,6 +56,7 @@ library
       Gargantext.Core.Text.Corpus.Parsers
       Gargantext.Core.Text.Corpus.Parsers.CSV
       Gargantext.Core.Text.Corpus.Parsers.Date.Parsec
+      Gargantext.Core.Text.Corpus.Parsers.JSON
       Gargantext.Core.Text.List.Formats.CSV
       Gargantext.Core.Text.Metrics
       Gargantext.Core.Text.Metrics.CharByChar
@@ -393,6 +394,7 @@ library
     , crawlerISTEX
     , crawlerIsidore
     , crawlerPubMed
+    , cron
     , cryptohash
     , data-time-segment
     , deepseq
@@ -793,7 +795,6 @@ executable gargantext-server
       base
     , cassava
     , containers
-    , cron
     , extra
     , full-text-search
     , gargantext

package.yaml

@@ -178,6 +178,7 @@ library:
   - crawlerISTEX
   - crawlerIsidore
   - crawlerPubMed
+  - cron
   - cryptohash
   - data-time-segment
   - deepseq
@@ -333,7 +334,6 @@ executables:
       - base
       - cassava
       - containers
-      - cron
       - full-text-search
       - gargantext
       - gargantext-prelude

src/Gargantext/API.hs

@@ -26,16 +26,20 @@ Pouillard (who mainly made it).
 
 -}
 
+{-# LANGUAGE BangPatterns         #-}
+{-# LANGUAGE NumericUnderscores   #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TypeOperators        #-}
 module Gargantext.API
       where
 
-import Control.Exception (catch, finally, SomeException)
+import Control.Concurrent
+import Control.Exception (catch, finally, SomeException, displayException)
 import Control.Lens
 import Control.Monad.Except
 import Control.Monad.Reader (runReaderT)
 import Data.Either
+import Data.Foldable (foldlM)
 import Data.List (lookup)
 import Data.Text (pack)
 import Data.Text.Encoding (encodeUtf8)
@@ -52,7 +56,7 @@ import Gargantext.API.Ngrams (saveNodeStoryImmediate)
 import Gargantext.API.Routes
 import Gargantext.API.Server (server)
 import Gargantext.Core.NodeStory
-import qualified Gargantext.Database.Prelude as DB
+import Gargantext.Database.GargDB (refreshNgramsMaterializedView)
 import Gargantext.Prelude hiding (putStrLn)
 import Network.HTTP.Types hiding (Query)
 import Network.Wai
@@ -62,6 +66,8 @@ import Network.Wai.Middleware.RequestLogger
 import Paths_gargantext (getDataDir)
 import Servant
 import System.FilePath
+import qualified Gargantext.Database.Prelude as DB
+import qualified System.Cron.Schedule as Cron
 
 data Mode = Dev | Mock | Prod
   deriving (Show, Read, Generic)
@@ -74,7 +80,8 @@ startGargantext mode port file = do
   portRouteInfo port
   app <- makeApp env
   mid <- makeDevMiddleware mode
-  run port (mid app) `finally` stopGargantext env
+  periodicActions <- schedulePeriodicActions env
+  run port (mid app) `finally` stopGargantext env periodicActions
 
   where runDbCheck env = do
           r <- runExceptT (runReaderT DB.dbCheck env) `catch`
@@ -91,9 +98,12 @@ portRouteInfo port = do
   putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
   putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 
+-- | Stops the gargantext server and cancels all the periodic actions
+-- scheduled to run up to that point.
 -- TODO clean this Monad condition (more generic) ?
-stopGargantext :: HasNodeStoryImmediateSaver env => env -> IO ()
-stopGargantext env = do
+stopGargantext :: HasNodeStoryImmediateSaver env => env -> [ThreadId] -> IO ()
+stopGargantext env scheduledPeriodicActions = do
+  forM_ scheduledPeriodicActions killThread
   putStrLn "----- Stopping gargantext -----"
   runReaderT saveNodeStoryImmediate env
 
@@ -105,6 +115,27 @@ startGargantextMock port = do
   run port application
 -}
 
+-- | Schedules all sorts of useful periodic actions to be run while
+-- the server is alive accepting requests.
+schedulePeriodicActions :: DB.CmdCommon env => env -> IO [ThreadId]
+schedulePeriodicActions env =
+  -- Add your scheduled actions here.
+  let actions = [
+          refreshDBViews
+        ]
+  in foldlM (\ !acc action -> (`mappend` acc) <$> Cron.execSchedule action) [] actions
+
+  where
+
+    refreshDBViews :: Cron.Schedule ()
+    refreshDBViews = do
+      let doRefresh = do
+            res <- DB.runCmd env refreshNgramsMaterializedView
+            case res of
+              Left e   -> liftIO $ putStrLn $ pack ("Refreshing Ngrams materialized view failed: " <> displayException e)
+              Right () -> pure ()
+      Cron.addJob doRefresh "5 * * * *"
+
 ----------------------------------------------------------------------
 
 fireWall :: Applicative f => Request -> FireWall -> f Bool

src/Gargantext/Database/GargDB.hs

@@ -12,17 +12,21 @@ TODO_2: quantitative tests (coded)
 
 -}
 
+{-# LANGUAGE QuasiQuotes #-}
+
 module Gargantext.Database.GargDB
   where
 
 import Control.Exception
 import Control.Lens (view)
+import Control.Monad (void)
 import Control.Monad.Reader (MonadReader)
+import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Data.Aeson (ToJSON, toJSON)
 import Data.Text (Text)
 import Data.Tuple.Extra (both)
 import GHC.IO (FilePath)
-import Gargantext.Database.Prelude (HasConfig(..))
+import Gargantext.Database.Prelude (HasConfig(..), Cmd, execPGSQuery)
 import Gargantext.Prelude
 import Gargantext.Prelude.Config
 import Gargantext.Prelude.Crypto.Hash
@@ -205,3 +209,9 @@ onDisk_2 action fp1 fp2 = do
         | isDoesNotExistError e = return ()
         | otherwise = throwIO e
 ------------------------------------------------------------------------
+
+-- | Refreshes the \"context_node_ngrams_view\" materialized view. This
+-- function will be run periodically.
+refreshNgramsMaterializedView :: Cmd IOException ()
+refreshNgramsMaterializedView =
+  void $ execPGSQuery [sql| refresh materialized view context_node_ngrams_view; |] ()