src/Gargantext/API/GraphQL/AsyncTask.hs

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