Dev.hs 1.93 KB
Newer Older
1 2
-- |

3
-- Use only for dev/repl
4 5
module Gargantext.API.Dev where

6 7 8 9 10
import Control.Exception (finally)
import Control.Monad (fail)
import Control.Monad.Reader (runReaderT)
import Servant

11
import Gargantext.API.Prelude
12 13 14
import Gargantext.API.Admin.Settings
import Gargantext.API.Admin.EnvTypes
import Gargantext.API.Ngrams (saveRepo)
15 16
import Gargantext.Database.Prelude
import Gargantext.Prelude
17
import Gargantext.Prelude.Config (GargConfig(..), readConfig)
18 19

-------------------------------------------------------------------
20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63

withDevEnv :: IniPath -> (DevEnv -> IO a) -> IO a
withDevEnv iniPath k = do
  env <- newDevEnv
  k env `finally` cleanEnv env

  where
    newDevEnv = do
      cfg     <- readConfig         iniPath
      dbParam <- databaseParameters iniPath
      pool    <- newPool            dbParam
      repo    <- readRepoEnv        (_gc_repofilepath cfg)
      setts   <- devSettings devJwkFile
      pure $ DevEnv
        { _dev_env_pool = pool
        , _dev_env_repo = repo
        , _dev_env_settings = setts
        , _dev_env_config   = cfg
        }

-- | Run Cmd Sugar for the Repl (GHCI)

runCmdRepl :: Show err => Cmd'' DevEnv err a -> IO a
runCmdRepl f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f

runCmdReplServantErr :: Cmd'' DevEnv ServerError a -> IO a
runCmdReplServantErr = runCmdRepl

-- In particular this writes the repo file after running
-- the command.
-- This function is constrained to the DevEnv rather than
-- using HasConnectionPool and HasRepoVar.
runCmdDev :: Show err => DevEnv -> Cmd'' DevEnv err a -> IO a
runCmdDev env f =
  (either (fail . show) pure =<< runCmd env f)
    `finally`
  runReaderT saveRepo env

runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
runCmdDevNoErr = runCmdDev

runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServerError a -> IO a
runCmdDevServantErr = runCmdDev

64
runCmdReplEasy :: Cmd'' DevEnv GargError a -> IO a
65
runCmdReplEasy f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f