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 Servant
  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       nodeStory_env <- readNodeStoryEnv (_gc_repofilepath cfg)
  41       pool    <- newPool            dbParam
  42       repo    <- readRepoEnv        (_gc_repofilepath cfg)
  43       setts   <- devSettings devJwkFile
  44       pure $ DevEnv
  45         { _dev_env_pool     = pool
  46         , _dev_env_repo     = repo
  47         , _dev_env_nodeStory  = nodeStory_env
  48         , _dev_env_settings = setts
  49         , _dev_env_config   = cfg
  50         }
  51
  52 -- | Run Cmd Sugar for the Repl (GHCI)
  53 runCmdRepl :: Show err => Cmd'' DevEnv err a -> IO a
  54 runCmdRepl f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f
  55
  56 runCmdReplServantErr :: Cmd'' DevEnv ServerError a -> IO a
  57 runCmdReplServantErr = runCmdRepl
  58
  59 -- In particular this writes the repo file after running
  60 -- the command.
  61 -- This function is constrained to the DevEnv rather than
  62 -- using HasConnectionPool and HasRepoVar.
  63 runCmdDev :: (Show err) => DevEnv -> Cmd'' DevEnv err a -> IO a
  64 runCmdDev env f =
  65   (either (fail . show) pure =<< runCmd env f)
  66     `finally`
  67   runReaderT saveNodeStory env
  68
  69 runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
  70 runCmdDevNoErr = runCmdDev
  71
  72 runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServerError a -> IO a
  73 runCmdDevServantErr = runCmdDev
  74
  75 runCmdReplEasy :: Cmd'' DevEnv GargError a -> IO a
  76 runCmdReplEasy f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f