src/Gargantext/API/Dev.hs

   1 {-|
   2 Module      : Gargantext.API.Dev
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 -- Use only for dev/repl
  13 module Gargantext.API.Dev where
  14
  15 import Control.Exception (finally)
  16 import Control.Monad (fail)
  17 import Control.Monad.Reader (runReaderT)
  18 import Gargantext.API.Admin.EnvTypes
  19 import Gargantext.API.Admin.Settings
  20 import Gargantext.API.Ngrams (saveNodeStoryImmediate)
  21 import Gargantext.API.Prelude
  22 import Gargantext.Core.NLP (nlpServerMap)
  23 import Gargantext.Core.NodeStory
  24 import Gargantext.Database.Prelude
  25 import Gargantext.Prelude
  26 import Gargantext.Prelude.Config (readConfig)
  27 import qualified Gargantext.Prelude.Mail as Mail
  28 import qualified Gargantext.Prelude.NLP as NLP
  29 import Servant
  30 import System.IO (FilePath)
  31
  32 type IniPath  = FilePath
  33 -------------------------------------------------------------------
  34 withDevEnv :: IniPath -> (DevEnv -> IO a) -> IO a
  35 withDevEnv iniPath k = do
  36   env <- newDevEnv
  37   k env -- `finally` cleanEnv env
  38
  39   where
  40     newDevEnv = do
  41       cfg     <- readConfig         iniPath
  42       dbParam <- databaseParameters iniPath
  43       --nodeStory_env <- readNodeStoryEnv (_gc_repofilepath cfg)
  44       pool    <- newPool            dbParam
  45       nodeStory_env <- readNodeStoryEnv pool
  46       setts   <- devSettings devJwkFile
  47       mail    <- Mail.readConfig iniPath
  48       nlp_config <- NLP.readConfig iniPath
  49       pure $ DevEnv
  50         { _dev_env_pool     = pool
  51         , _dev_env_nodeStory  = nodeStory_env
  52         , _dev_env_settings = setts
  53         , _dev_env_config   = cfg
  54         , _dev_env_mail     = mail
  55         , _dev_env_nlp      = nlpServerMap nlp_config
  56         }
  57
  58 -- | Run Cmd Sugar for the Repl (GHCI)
  59 runCmdRepl :: Show err => Cmd'' DevEnv err a -> IO a
  60 runCmdRepl f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f
  61
  62 runCmdReplServantErr :: Cmd'' DevEnv ServerError a -> IO a
  63 runCmdReplServantErr = runCmdRepl
  64
  65 -- In particular this writes the repo file after running
  66 -- the command.
  67 -- This function is constrained to the DevEnv rather than
  68 -- using HasConnectionPool and HasRepoVar.
  69 runCmdDev :: Show err => DevEnv -> Cmd'' DevEnv err a -> IO a
  70 runCmdDev env f =
  71   (either (fail . show) pure =<< runCmd env f)
  72     `finally`
  73   runReaderT saveNodeStoryImmediate env
  74
  75 runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
  76 runCmdDevNoErr = runCmdDev
  77
  78 runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServerError a -> IO a
  79 runCmdDevServantErr = runCmdDev
  80
  81 runCmdReplEasy :: Cmd'' DevEnv GargError a -> IO a
  82 runCmdReplEasy f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f