Integrate cleanEnv in runCmdDev*

bin/gargantext-import/Main.hs

@@ -24,29 +24,29 @@ import Servant (ServantErr)
 import Gargantext.Prelude
 import Gargantext.Database.Flow (FlowCmdM, flowCorpus)
 import Gargantext.Text.Parsers (FileFormat(CsvHalFormat))
-import Gargantext.Database.Utils (Cmd, connectGargandb, runCmdDev)
+import Gargantext.Database.Utils (Cmd, )
 import Gargantext.Database.Types.Node (CorpusId)
 --import Gargantext.Database.Schema.User (insertUsers, gargantuaUser, simpleUser)
 import Gargantext.API.Node () -- instances
-import Gargantext.API.Settings (newDevEnvWith, cleanEnv, DevEnv)
+import Gargantext.API.Settings (newDevEnvWith, runCmdDev, cleanEnv, DevEnv)
 import System.Environment (getArgs)
 
 main :: IO ()
 main = do
   [iniPath, name, corpusPath] <- getArgs
 
-  env <- newDevEnvWith iniPath
+  {-let createUsers :: Cmd ServantErr Int64
+      createUsers = insertUsers [gargantuaUser,simpleUser]
+  -}
+
+  let cmdCorpus :: forall m. FlowCmdM DevEnv ServantErr m => m CorpusId
+      cmdCorpus = flowCorpus CsvHalFormat corpusPath (cs name)
 
-  (do
-    {-let createUsers :: Cmd ServantErr Int64
-        createUsers = insertUsers [gargantuaUser,simpleUser]
-    _ <- runCmdDev env createUsers
-    -}
-
-    let cmd :: FlowCmdM DevEnv ServantErr m => m CorpusId
-        cmd = flowCorpus CsvHalFormat corpusPath (cs name)
-    _ <- runCmdDev env cmd
-    pure ()
-    ) `finally` cleanEnv env
+     -- cmd = {-createUsers >>-} cmdCorpus
+
+  env <- newDevEnvWith iniPath
+  -- Better if we keep only one call to runCmdDev.
+  _ <- runCmdDev env cmdCorpus
+  pure ()
 
 

src/Gargantext/API/Settings.hs

@@ -17,7 +17,9 @@ Portability : POSIX
 {-# LANGUAGE ScopedTypeVariables         #-}
 {-# LANGUAGE TemplateHaskell             #-}
 {-# LANGUAGE OverloadedStrings           #-}
+{-# LANGUAGE FlexibleContexts            #-}
 {-# LANGUAGE FlexibleInstances           #-}
+{-# LANGUAGE RankNTypes                  #-}
 
 module Gargantext.API.Settings
     where
@@ -48,10 +50,11 @@ import qualified Jose.Jwk as Jose
 import qualified Jose.Jwa as Jose
 
 import Control.Concurrent
+import Control.Exception (finally)
 import Control.Monad.Logger
 import Control.Lens
 import Gargantext.Prelude
-import Gargantext.Database.Utils (databaseParameters, HasConnection(..))
+import Gargantext.Database.Utils (databaseParameters, HasConnection(..), Cmd', runCmd)
 import Gargantext.API.Ngrams (NgramsRepo, HasRepoVar(..), initMockRepo, r_version)
 import Gargantext.API.Orchestrator.Types
 
@@ -171,9 +174,6 @@ readRepo = do
       else
         pure initMockRepo
 
-cleanEnv :: HasRepoVar env => env -> IO ()
-cleanEnv env = encodeFile repoSnapshot =<< readMVar (env ^. repoVar)
-
 newEnv :: PortNumber -> FilePath -> IO Env
 newEnv port file = do
   manager <- newTlsManager
@@ -221,3 +221,27 @@ newDevEnvWith file = do
 
 newDevEnv :: IO DevEnv
 newDevEnv = newDevEnvWith "gargantext.ini"
+
+-- So far `cleanEnv` is just writing the repo file.
+-- Therefor it is called in `runCmdDev*` for convenience.
+cleanEnv :: HasRepoVar env => env -> IO ()
+cleanEnv env = encodeFile repoSnapshot =<< readMVar (env ^. repoVar)
+
+-- Use only for dev
+-- In particular this writes the repo file after running
+-- the command.
+-- This function is constrained to the DevEnv rather than
+-- using HasConnection and HasRepoVar.
+-- This is to avoid calling cleanEnv unintentionally on a prod env.
+runCmdDev :: Show err => DevEnv -> Cmd' DevEnv err a -> IO a
+runCmdDev env f = do
+  (either (fail . show) pure =<< runCmd env f)
+    `finally` cleanEnv env
+
+-- Use only for dev
+runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
+runCmdDevNoErr = runCmdDev
+
+-- Use only for dev
+runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServantErr a -> IO a
+runCmdDevServantErr = runCmdDev

src/Gargantext/Database/Cooc.hs

@@ -20,13 +20,14 @@ module Gargantext.Database.Cooc where
 import Database.PostgreSQL.Simple.SqlQQ
 
 import Gargantext.Prelude
-import Gargantext.Database.Utils (Cmd, HasConnection, runCmdDevNoErr, runPGSQuery)
+import Gargantext.Database.Utils (Cmd, runPGSQuery)
+import Gargantext.API.Settings (runCmdDevNoErr, DevEnv)
 
 type CorpusId    = Int
 type MainListId  = Int
 type GroupListId = Int
 
-coocTest :: HasConnection env => env -> IO [(Int, Int, Int)]
+coocTest :: DevEnv -> IO [(Int, Int, Int)]
 coocTest env = runCmdDevNoErr env $ dBcooc 421968 446602 446599
 
 dBcooc :: CorpusId -> MainListId -> GroupListId -> Cmd err [(Int, Int, Int)]

src/Gargantext/Database/Utils.hs

@@ -37,7 +37,6 @@ import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(Conversion
 import Database.PostgreSQL.Simple.Internal  (Field)
 import Gargantext.Prelude
 import Opaleye (Query, Unpackspec, showSqlForPostgres, FromFields, Select, runQuery)
-import Servant (ServantErr)
 import System.IO (FilePath)
 import Text.Read (read)
 import qualified Data.ByteString      as DB
@@ -75,20 +74,6 @@ runCmd :: HasConnection env => env
        -> IO (Either err a)
 runCmd env m = runExceptT $ runReaderT m env
 
--- Use only for dev
-runCmdDev :: (HasConnection env, Show err) => env
-          -> Cmd' env err a
-          -> IO a
-runCmdDev env f = either (fail . show) pure =<< runCmd env f
-
--- Use only for dev
-runCmdDevNoErr :: HasConnection env => env -> Cmd' env () a -> IO a
-runCmdDevNoErr = runCmdDev
-
--- Use only for dev
-runCmdDevServantErr :: HasConnection env => env -> Cmd ServantErr a -> IO a
-runCmdDevServantErr = runCmdDev
-
 runOpaQuery :: Default FromFields fields haskells => Select fields -> Cmd err [haskells]
 runOpaQuery q = mkCmd $ \c -> runQuery c q