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