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 Servant
  19
  20 import Gargantext.API.Prelude
  21 import Gargantext.API.Admin.Settings
  22 import Gargantext.API.Admin.EnvTypes
  23 import Gargantext.API.Ngrams (saveRepo)
  24 import Gargantext.Database.Prelude
  25 import Gargantext.Prelude
  26 import Gargantext.Prelude.Config (GargConfig(..), readConfig)
  27
  28 -------------------------------------------------------------------
  29 withDevEnv :: IniPath -> (DevEnv -> IO a) -> IO a
  30 withDevEnv iniPath k = do
  31   env <- newDevEnv
  32   k env `finally` cleanEnv env
  33
  34   where
  35     newDevEnv = do
  36       cfg     <- readConfig         iniPath
  37       dbParam <- databaseParameters iniPath
  38       pool    <- newPool            dbParam
  39       repo    <- readRepoEnv        (_gc_repofilepath cfg)
  40       setts   <- devSettings devJwkFile
  41       pure $ DevEnv
  42         { _dev_env_pool = pool
  43         , _dev_env_repo = repo
  44         , _dev_env_settings = setts
  45         , _dev_env_config   = cfg
  46         }
  47
  48 -- | Run Cmd Sugar for the Repl (GHCI)
  49 runCmdRepl :: Show err => Cmd'' DevEnv err a -> IO a
  50 runCmdRepl f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f
  51
  52 runCmdReplServantErr :: Cmd'' DevEnv ServerError a -> IO a
  53 runCmdReplServantErr = runCmdRepl
  54
  55 -- In particular this writes the repo file after running
  56 -- the command.
  57 -- This function is constrained to the DevEnv rather than
  58 -- using HasConnectionPool and HasRepoVar.
  59 runCmdDev :: Show err => DevEnv -> Cmd'' DevEnv err a -> IO a
  60 runCmdDev env f =
  61   (either (fail . show) pure =<< runCmd env f)
  62     `finally`
  63   runReaderT saveRepo env
  64
  65 runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
  66 runCmdDevNoErr = runCmdDev
  67
  68 runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServerError a -> IO a
  69 runCmdDevServantErr = runCmdDev
  70
  71 runCmdReplEasy :: Cmd'' DevEnv GargError a -> IO a
  72 runCmdReplEasy f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f