Merge branch 'dev-ngrams-repo' of...

Merge branch 'dev-ngrams-repo' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell-gargantext into dev-ngrams-repo

bin/gargantext-import/Main.hs

@@ -14,35 +14,36 @@ Import a corpus binary.
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE Strict            #-}
 
 module Main where
 
 import Servant (ServantErr)
 import Gargantext.Prelude
-import Gargantext.Database.Flow (flowCorpus)
+import Gargantext.Database.Flow (FlowCmdM, flowCorpus)
 import Gargantext.Text.Parsers (FileFormat(CsvHalFormat))
-import Gargantext.Database.Utils (Cmd, connectGargandb, runCmdDevWith)
-import Gargantext.Database.Types.Node (NodeId)
+import Gargantext.Database.Utils (Cmd, connectGargandb, runCmdDev)
+import Gargantext.Database.Types.Node (CorpusId)
 --import Gargantext.Database.Schema.User (insertUsers, gargantuaUser, simpleUser)
 import Gargantext.API.Node () -- instances
-import Gargantext.API.Ngrams (RepoCmdM)
+import Gargantext.API.Settings (newDevEnvWith, 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]
-  _ <- runCmdDevWith iniPath createUsers
+  _ <- runCmdDev env createUsers
   -}
 
-  {- -- TODO missing repo var...
-  let cmd :: RepoCmdM env ServantErr m => m NodeId
+  let cmd :: FlowCmdM DevEnv ServantErr m => m CorpusId
       cmd = flowCorpus CsvHalFormat corpusPath (cs name)
-  r <- runCmdDevWith iniPath cmd
-  -}
+  r <- runCmdDev env cmd
   pure ()
 
 

src/Gargantext/API.hs

@@ -72,6 +72,7 @@ import Gargantext.Prelude
 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
 
 import Gargantext.API.Auth (AuthRequest, AuthResponse, auth)
+import Gargantext.API.Ngrams (HasRepoVar)
 import Gargantext.API.Node ( GargServer
                            , Roots    , roots
                            , NodeAPI  , nodeAPI
@@ -83,6 +84,7 @@ import Gargantext.API.Node ( GargServer
                            , HyperdataAnnuaire
                            )
 --import Gargantext.Database.Node.Contact (HyperdataContact)
+import Gargantext.Database.Utils (HasConnection)
 import Gargantext.Database.Types.Node (NodeId, CorpusId, AnnuaireId)
 import Gargantext.API.Count  ( CountAPI, count, Query)
 import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
@@ -163,9 +165,8 @@ makeMockApp env = do
 
 
 
-makeDevApp :: Env -> IO Application
-makeDevApp env = do
-    serverApp <- makeApp env
+makeDevMiddleware :: IO Middleware
+makeDevMiddleware = do
 
     -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
     --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
@@ -192,8 +193,8 @@ makeDevApp env = do
     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
     --          $ Warp.defaultSettings
     
-    --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
-    pure $ logStdoutDev $ corsMiddleware $ serverApp
+    --pure (warpS, logWare . checkOriginAndHost . corsMiddleware)
+    pure $ logStdoutDev . corsMiddleware
 
 ---------------------------------------------------------------------
 -- | API Global
@@ -276,7 +277,8 @@ type API = SwaggerFrontAPI :<|> GargAPI :<|> Get '[HTML] Html
 ---------------------------------------------------------------------
 -- | Server declarations
 
-server :: Env -> IO (Server API)
+server :: (HasConnection env, HasRepoVar env) => env
+       -> IO (Server API)
 server env = do
   -- orchestrator <- scrapyOrchestrator env
   pure $  swaggerFront
@@ -312,7 +314,7 @@ gargMock :: Server GargAPI
 gargMock = mock apiGarg Proxy
 
 ---------------------------------------------------------------------
-makeApp :: Env -> IO Application
+makeApp :: (HasConnection env, HasRepoVar env) => env -> IO Application
 makeApp = fmap (serve api) . server
 
 appMock :: Application
@@ -372,8 +374,9 @@ startGargantext :: PortNumber -> FilePath -> IO ()
 startGargantext port file = do
   env <- newEnv port file
   portRouteInfo port
-  app <- makeDevApp env
-  run port app
+  app <- makeApp env
+  mid <- makeDevMiddleware
+  run port $ mid app
 
 startGargantextMock :: PortNumber -> IO ()
 startGargantextMock port = do

src/Gargantext/API/Settings.hs

@@ -173,3 +173,29 @@ newEnv port file = do
     , _env_scrapers = scrapers_env
     , _env_self_url = self_url
     }
+
+data DevEnv = DevEnv
+  { _dev_env_conn     :: !Connection
+  , _dev_env_repo_var :: !(MVar NgramsRepo)
+  }
+
+makeLenses ''DevEnv
+
+instance HasConnection DevEnv where
+  connection = dev_env_conn
+
+instance HasRepoVar DevEnv where
+  repoVar = dev_env_repo_var
+
+newDevEnvWith :: FilePath -> IO DevEnv
+newDevEnvWith file = do
+  param <- databaseParameters file
+  conn <- connect param
+  repo_var <- newMVar initMockRepo
+  pure $ DevEnv
+    { _dev_env_conn     = conn
+    , _dev_env_repo_var = repo_var
+    }
+
+newDevEnv :: IO DevEnv
+newDevEnv = newDevEnvWith "gargantext.ini"

src/Gargantext/Database/Cooc.hs

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

src/Gargantext/Database/Utils.hs

@@ -49,13 +49,19 @@ class HasConnection env where
 instance HasConnection Connection where
   connection = identity
 
-type CmdM env err m =
+type CmdM' env err m =
   ( MonadReader env m
-  , HasConnection env
   , MonadError err m
   , MonadIO m
   )
 
+type CmdM env err m =
+  ( CmdM' env err m
+  , HasConnection env
+  )
+
+type Cmd' env err a = forall m. CmdM' env err m => m a
+
 type Cmd err a = forall m env. CmdM env err m => m a
 
 -- TODO: ideally there should be very few calls to this functions.
@@ -64,22 +70,24 @@ mkCmd k = do
   conn <- view connection
   liftIO $ k conn
 
-runCmd :: Connection -> Cmd err a -> IO (Either err a)
-runCmd conn m = runExceptT $ runReaderT m conn
+runCmd :: HasConnection env => env
+       -> Cmd' env err a
+       -> IO (Either err a)
+runCmd env m = runExceptT $ runReaderT m env
 
 -- Use only for dev
-runCmdDevWith :: Show err => FilePath -> Cmd err a -> IO a
-runCmdDevWith fp f = do
-  conn <- connectGargandb fp
-  either (fail . show) pure =<< runCmd conn f
+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
-runCmdDev :: Cmd ServantErr a -> IO a
-runCmdDev = runCmdDevWith "gargantext.ini"
+runCmdDevNoErr :: HasConnection env => env -> Cmd' env () a -> IO a
+runCmdDevNoErr = runCmdDev
 
 -- Use only for dev
-runCmdDevNoErr :: Cmd () a -> IO a
-runCmdDevNoErr = runCmdDevWith "gargantext.ini"
+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