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