[NGRAMS-REPO] Refactor Repo env

src/Gargantext/API.hs

@@ -73,7 +73,7 @@ import Gargantext.Prelude
 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
 
 import Gargantext.API.Auth (AuthRequest, AuthResponse, auth)
-import Gargantext.API.Ngrams (HasRepoVar(..), HasRepoSaver(..), saveRepo)
+import Gargantext.API.Ngrams (HasRepo(..), HasRepoSaver(..), saveRepo)
 import Gargantext.API.Node ( GargServer
                            , Roots    , roots
                            , NodeAPI  , nodeAPI
@@ -278,7 +278,7 @@ type API = SwaggerFrontAPI :<|> GargAPI :<|> Get '[HTML] Html
 ---------------------------------------------------------------------
 -- | Server declarations
 
-server :: (HasConnection env, HasRepoVar env, HasRepoSaver env)
+server :: (HasConnection env, HasRepo env)
        => env -> IO (Server API)
 server env = do
   -- orchestrator <- scrapyOrchestrator env
@@ -318,7 +318,7 @@ gargMock :: Server GargAPI
 gargMock = mock apiGarg Proxy
 
 ---------------------------------------------------------------------
-makeApp :: (HasConnection env, HasRepoVar env, HasRepoSaver env) 
+makeApp :: (HasConnection env, HasRepo env)
         => env -> IO Application
 makeApp = fmap (serve api) . server
 

src/Gargantext/API/Ngrams.hs

@@ -601,6 +601,14 @@ initMockRepo = Repo 1 s []
       $ Map.fromList
       [ (n ^. ne_ngrams, n) | n <- mockTable ^. _NgramsTable ]
 
+data RepoEnv = RepoEnv
+  { _renv_var   :: !(MVar NgramsRepo)
+  , _renv_saver :: !(IO ())
+  }
+  deriving (Generic)
+
+makeLenses ''RepoEnv
+
 class HasRepoVar env where
   repoVar :: Getter env (MVar NgramsRepo)
 
@@ -610,15 +618,23 @@ instance HasRepoVar (MVar NgramsRepo) where
 class HasRepoSaver env where
   repoSaver :: Getter env (IO ())
 
-instance HasRepoSaver (IO ()) where
-  repoSaver = identity
+class (HasRepoVar env, HasRepoSaver env) => HasRepo env where
+  repoEnv :: Getter env RepoEnv
+
+instance HasRepo RepoEnv where
+  repoEnv = identity
+
+instance HasRepoVar RepoEnv where
+  repoVar = renv_var
+
+instance HasRepoSaver RepoEnv where
+  repoSaver = renv_saver
 
 type RepoCmdM env err m =
   ( MonadReader env m
   , MonadError err m
   , MonadIO m
-  , HasRepoVar env
-  , HasRepoSaver env
+  , HasRepo env
   )
 ------------------------------------------------------------------------
 

src/Gargantext/API/Node.hs

@@ -47,7 +47,7 @@ import Data.Time (UTCTime)
 import GHC.Generics (Generic)
 import Servant
 
-import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, TableNgramsApiGet, tableNgramsPatch, getTableNgrams, HasRepoVar, HasRepoSaver)
+import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, TableNgramsApiGet, tableNgramsPatch, getTableNgrams, HasRepo)
 import Gargantext.Prelude
 import Gargantext.Database.Types.Node
 import Gargantext.Database.Utils -- (Cmd, CmdM)
@@ -76,7 +76,7 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
 type GargServer api =
   forall env m.
-    (CmdM env ServantErr m, HasRepoVar env, HasRepoSaver env)
+    (CmdM env ServantErr m, HasRepo env)
     => ServerT api m
 
 -------------------------------------------------------------------

src/Gargantext/API/Settings.hs

@@ -60,7 +60,7 @@ import Control.Monad.Reader
 import Control.Lens
 import Gargantext.Prelude
 import Gargantext.Database.Utils (databaseParameters, HasConnection(..), Cmd', runCmd)
-import Gargantext.API.Ngrams (NgramsRepo, HasRepoVar(..), HasRepoSaver(..), r_version, saveRepo, initRepo)
+import Gargantext.API.Ngrams (NgramsRepo, HasRepoVar(..), HasRepoSaver(..), HasRepo(..), RepoEnv(..), r_version, saveRepo, initRepo)
 import Gargantext.API.Orchestrator.Types
 
 type PortNumber = Int
@@ -137,14 +137,13 @@ optSetting name d = do
 data FireWall = FireWall { unFireWall :: Bool }
 
 data Env = Env
-  { _env_settings   :: !Settings
-  , _env_logger     :: !LoggerSet
-  , _env_conn       :: !Connection
-  , _env_repo_var   :: !(MVar NgramsRepo)
-  , _env_repo_saver :: !(IO ())
-  , _env_manager    :: !Manager
-  , _env_self_url   :: !BaseUrl
-  , _env_scrapers   :: !ScrapersEnv
+  { _env_settings :: !Settings
+  , _env_logger   :: !LoggerSet
+  , _env_conn     :: !Connection
+  , _env_repo     :: !RepoEnv
+  , _env_manager  :: !Manager
+  , _env_self_url :: !BaseUrl
+  , _env_scrapers :: !ScrapersEnv
   }
   deriving (Generic)
 
@@ -154,10 +153,13 @@ instance HasConnection Env where
   connection = env_conn
 
 instance HasRepoVar Env where
-  repoVar = env_repo_var
+  repoVar = repoEnv . repoVar
 
 instance HasRepoSaver Env where
-  repoSaver = env_repo_saver
+  repoSaver = repoEnv . repoSaver
+
+instance HasRepo Env where
+  repoEnv = env_repo
 
 data MockEnv = MockEnv
   { _menv_firewall :: !FireWall
@@ -169,8 +171,24 @@ makeLenses ''MockEnv
 repoSnapshot :: FilePath
 repoSnapshot = "repo.json"
 
-readRepo :: IO (MVar NgramsRepo)
-readRepo = do
+ignoreExc :: IO () -> IO ()
+ignoreExc = handle $ \(_ :: SomeException) -> return ()
+
+repoSaverAction :: ToJSON a => a -> IO ()
+repoSaverAction a = ignoreExc $ do
+  -- TODO file locking
+  withTempFile "." "tmp-repo.json" $ \fp h -> do
+    L.hPut h $ encode a
+    hClose h
+    renameFile fp repoSnapshot
+
+mkRepoSaver :: MVar NgramsRepo -> IO (IO ())
+mkRepoSaver repo_var = do
+  (saveAction, _) <- mkDebounce (10 :: Second) repoSaverAction
+  pure $ readMVar repo_var >>= saveAction
+
+readRepoEnv :: IO RepoEnv
+readRepoEnv = do
   -- | Does file exist ? :: Bool
   repoFile <- doesFileExist repoSnapshot
 
@@ -179,7 +197,7 @@ readRepo = do
              then (>0) <$> getFileSize repoSnapshot
              else pure False
 
-  newMVar =<<
+  mvar <- newMVar =<<
     if repoExists
       then do
         e_repo <- eitherDecodeFileStrict repoSnapshot
@@ -190,21 +208,8 @@ readRepo = do
       else
         pure initRepo
 
-ignoreExc :: IO () -> IO ()
-ignoreExc = handle $ \(_ :: SomeException) -> return ()
-
-repoSaverAction :: ToJSON a => a -> IO ()
-repoSaverAction a = ignoreExc $ do
-  -- TODO file locking
-  withTempFile "." "tmp-repo.json" $ \fp h -> do
-    L.hPut h $ encode a
-    hClose h
-    renameFile fp repoSnapshot
-
-mkRepoSaver :: MVar NgramsRepo -> IO (IO ())
-mkRepoSaver repo_var = do
-  (saveAction, _) <- mkDebounce (10 :: Second) repoSaverAction
-  pure $ readMVar repo_var >>= saveAction
+  saver <- mkRepoSaver mvar
+  pure $ RepoEnv { _renv_var = mvar, _renv_saver = saver }
 
 newEnv :: PortNumber -> FilePath -> IO Env
 newEnv port file = do
@@ -212,31 +217,27 @@ newEnv port file = do
   settings <- pure (devSettings & appPort .~ port) -- TODO read from 'file'
   when (port /= settings ^. appPort) $
     panic "TODO: conflicting settings of port"
-  
+
   self_url <- parseBaseUrl $ "http://0.0.0.0:" <> show port
   param    <- databaseParameters file
   conn     <- connect param
-  
-  repo_var     <- readRepo
-  repo_saver   <- mkRepoSaver repo_var
+  repo     <- readRepoEnv
   scrapers_env <- newJobEnv defaultSettings manager
   logger <- newStderrLoggerSet defaultBufSize
-  
+
   pure $ Env
     { _env_settings   = settings
     , _env_logger     = logger
     , _env_conn       = conn
-    , _env_repo_var   = repo_var
-    , _env_repo_saver = repo_saver
+    , _env_repo       = repo
     , _env_manager    = manager
     , _env_scrapers   = scrapers_env
     , _env_self_url   = self_url
     }
 
 data DevEnv = DevEnv
-  { _dev_env_conn       :: !Connection
-  , _dev_env_repo_var   :: !(MVar NgramsRepo)
-  , _dev_env_repo_saver :: !(IO ())
+  { _dev_env_conn :: !Connection
+  , _dev_env_repo :: !RepoEnv
   }
 
 makeLenses ''DevEnv
@@ -245,21 +246,22 @@ instance HasConnection DevEnv where
   connection = dev_env_conn
 
 instance HasRepoVar DevEnv where
-  repoVar = dev_env_repo_var
+  repoVar = repoEnv . repoVar
 
 instance HasRepoSaver DevEnv where
-  repoSaver = dev_env_repo_saver
+  repoSaver = repoEnv . repoSaver
+
+instance HasRepo DevEnv where
+  repoEnv = dev_env_repo
 
 newDevEnvWith :: FilePath -> IO DevEnv
 newDevEnvWith file = do
-  param      <- databaseParameters file
-  conn       <- connect param
-  repo_var   <- readRepo
-  repo_saver <- mkRepoSaver repo_var
+  param <- databaseParameters file
+  conn  <- connect param
+  repo  <- readRepoEnv
   pure $ DevEnv
-    { _dev_env_conn       = conn
-    , _dev_env_repo_var   = repo_var
-    , _dev_env_repo_saver = repo_saver
+    { _dev_env_conn = conn
+    , _dev_env_repo = repo
     }
 
 -- | Run Cmd Sugar for the Repl (GHCI)