src/Gargantext/API/Dev.hs

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