src/Gargantext/API/GraphQL/AsyncTask.hs

   1 {-# OPTIONS_GHC -fno-warn-unused-imports #-}
   2 {-# LANGUAGE DeriveAnyClass #-}
   3 {-# LANGUAGE DuplicateRecordFields #-}
   4
   5 module Gargantext.API.GraphQL.AsyncTask where
   6
   7 import Control.Concurrent.Async (poll)
   8 import Control.Concurrent.MVar (readMVar)
   9 import Control.Lens
  10 import Data.Map (Map)
  11 import qualified Data.Map as Map
  12 import Control.Monad.Base (liftBase)
  13 import Control.Monad.Reader (ask, liftIO)
  14 import Data.Either (Either(..))
  15 import qualified Data.IntMap.Strict as IntMap
  16 import Data.Maybe (Maybe(..), catMaybes)
  17 import Data.Morpheus.Types
  18   ( GQLType
  19   , Resolver
  20   , ResolverM
  21   , QUERY
  22   , lift
  23   )
  24 import Data.Text (Text)
  25 import qualified Data.Text as T
  26 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
  27 import Gargantext.API.Prelude (GargM, GargError, HasJobEnv')
  28 import Gargantext.Core.Mail.Types (HasMail)
  29 import Gargantext.Database.Admin.Types.Node (NodeId(..))
  30 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
  31 import Gargantext.Prelude
  32 import GHC.Generics (Generic)
  33 import Servant.Job.Async (HasJobEnv(job_env), jenv_jobs, job_async)
  34 import Servant.Job.Core (env_item, env_map, env_state_mvar)
  35
  36 data JobLogArgs
  37   = JobLogArgs
  38     { job_log_id :: Int
  39     } deriving (Generic, GQLType)
  40
  41 type GqlM e env = Resolver QUERY e (GargM env GargError)
  42
  43 resolveJobLogs
  44   :: (HasConnectionPool env, HasConfig env, HasJobEnv' env)
  45   => JobLogArgs -> GqlM e env (Map Int JobLog)
  46 resolveJobLogs JobLogArgs { job_log_id } = dbJobLogs job_log_id
  47
  48 dbJobLogs
  49   :: (HasConnectionPool env, HasConfig env, HasJobEnv' env)
  50   => Int -> GqlM e env (Map Int JobLog)
  51 dbJobLogs job_log_id = do
  52   --getJobLogs job_log_id
  53   lift $ do
  54     env <- ask
  55     --val <- liftBase $ readMVar $ env ^. job_env . jenv_jobs . env_state_mvar
  56     var <- liftIO $ readMVar (env ^. job_env . jenv_jobs . env_state_mvar)
  57     let envItems = var ^. env_map
  58     printDebug "[dbJobLogs] env ^. job_env ^. jenv_jobs" $ length $ IntMap.keys envItems
  59     printDebug "[dbJobLogs] job_log_id" job_log_id
  60     --pure $ IntMap.elems val
  61     liftIO $ do
  62       let jobsList = IntMap.toList $ IntMap.map (\e -> e ^. env_item . job_async) envItems
  63       results <- mapM (\(k, v) -> do
  64                           p <- poll v
  65                           let kv = case p of
  66                                 Nothing -> Nothing
  67                                 Just p' -> case p' of
  68                                   Left _ -> Nothing
  69                                   Right p'' -> Just (k, p'')
  70                           pure kv) jobsList
  71       pure $ Map.fromList $ catMaybes results