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 Control.Monad.Except (runExceptT)
  19 import Gargantext.API.Admin.EnvTypes
  20 import Gargantext.API.Admin.Settings
  21 import Gargantext.API.Ngrams (saveNodeStoryImmediate)
  22 import Gargantext.API.Prelude
  23 import Gargantext.Core.NLP (nlpServerMap)
  24 import Gargantext.Core.NodeStory
  25 import Gargantext.Database.Prelude
  26 import Gargantext.Prelude
  27 import Gargantext.Prelude.Config (readConfig)
  28 import qualified Gargantext.Prelude.Mail as Mail
  29 import qualified Gargantext.Prelude.NLP as NLP
  30 import Servant
  31 import System.IO (FilePath)
  32
  33 type IniPath  = FilePath
  34 -------------------------------------------------------------------
  35 withDevEnv :: IniPath -> (DevEnv -> IO a) -> IO a
  36 withDevEnv iniPath k = do
  37   env <- newDevEnv
  38   k env -- `finally` cleanEnv env
  39
  40   where
  41     newDevEnv = do
  42       cfg     <- readConfig         iniPath
  43       dbParam <- databaseParameters iniPath
  44       --nodeStory_env <- readNodeStoryEnv (_gc_repofilepath cfg)
  45       pool    <- newPool            dbParam
  46       nodeStory_env <- readNodeStoryEnv pool
  47       setts   <- devSettings devJwkFile
  48       mail    <- Mail.readConfig iniPath
  49       nlp_config <- NLP.readConfig iniPath
  50       pure $ DevEnv
  51         { _dev_env_pool     = pool
  52         , _dev_env_nodeStory  = nodeStory_env
  53         , _dev_env_settings = setts
  54         , _dev_env_config   = cfg
  55         , _dev_env_mail     = mail
  56         , _dev_env_nlp      = nlpServerMap nlp_config
  57         }
  58
  59 -- | Run Cmd Sugar for the Repl (GHCI)
  60 runCmdRepl :: Show err => Cmd'' DevEnv err a -> IO a
  61 runCmdRepl f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f
  62
  63 runCmdReplServantErr :: Cmd'' DevEnv ServerError a -> IO a
  64 runCmdReplServantErr = runCmdRepl
  65
  66 -- In particular this writes the repo file after running
  67 -- the command.
  68 -- This function is constrained to the DevEnv rather than
  69 -- using HasConnectionPool and HasRepoVar.
  70 runCmdDev :: Show err => DevEnv -> Cmd'' DevEnv err a -> IO a
  71 runCmdDev env f =
  72   (either (fail . show) pure =<< runCmd env f)
  73
  74 runCmdGargDev :: DevEnv -> GargM DevEnv GargError a -> IO a
  75 runCmdGargDev env cmd =
  76   (either (fail . show) pure =<< runExceptT (runReaderT cmd env))
  77     `finally`
  78   runReaderT saveNodeStoryImmediate env
  79
  80 runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
  81 runCmdDevNoErr = runCmdDev
  82
  83 runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServerError a -> IO a
  84 runCmdDevServantErr = runCmdDev
  85
  86 runCmdReplEasy :: Cmd'' DevEnv GargError a -> IO a
  87 runCmdReplEasy f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f