Commit 280f94f0 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

Restore importCsvFile function

We do that thanks to a new typeclass method for
the `MonadJobStatus` called `noJobHandle`.
parent be745492
Pipeline #5383 passed with stages
in 87 minutes and 4 seconds
......@@ -165,7 +165,9 @@ instance Jobs.MonadJob (GargM Env err) GargJob (Seq JobLog) JobLog where
-- | The /concrete/ 'JobHandle' in use with our 'GargM' (production) monad. Its
-- constructor it's not exported, to not leak internal details of its implementation.
data ConcreteJobHandle err = JobHandle {
data ConcreteJobHandle err =
ConcreteNullHandle
| JobHandle {
_jh_id :: !(SJ.JobID 'SJ.Safe)
, _jh_logger :: LoggerM (GargM Env err) JobLog
}
......@@ -179,6 +181,7 @@ mkJobHandle jId = JobHandle jId
-- | Updates the status of a 'JobHandle' by using the input 'updateJobStatus' function.
updateJobProgress :: ConcreteJobHandle err -> (JobLog -> JobLog) -> GargM Env err ()
updateJobProgress ConcreteNullHandle _ = pure ()
updateJobProgress hdl@(JobHandle _ logStatus) updateJobStatus =
Jobs.getLatestJobStatus hdl >>= logStatus . updateJobStatus
......@@ -189,6 +192,9 @@ instance Jobs.MonadJobStatus (GargM Env err) where
type JobOutputType (GargM Env err) = JobLog
type JobEventType (GargM Env err) = JobLog
noJobHandle Proxy = ConcreteNullHandle
getLatestJobStatus ConcreteNullHandle = pure noJobLog
getLatestJobStatus (JobHandle jId _) = do
mb_jb <- Jobs.findJob jId
case mb_jb of
......@@ -203,6 +209,7 @@ instance Jobs.MonadJobStatus (GargM Env err) where
EmptyL -> noJobLog
l :< _ -> l
withTracer _ ConcreteNullHandle f = f ConcreteNullHandle
withTracer extraLogger (JobHandle jId logger) n = n (JobHandle jId (\w -> logger w >> liftIO (extraLogger w)))
markStarted n jh = updateJobProgress jh (const $ jobLogStart (RemainingSteps n))
......@@ -276,6 +283,8 @@ instance Jobs.MonadJobStatus (GargM DevEnv err) where
type JobOutputType (GargM DevEnv err) = JobLog
type JobEventType (GargM DevEnv err) = JobLog
noJobHandle Proxy = DevJobHandle
getLatestJobStatus DevJobHandle = pure noJobLog
withTracer _ DevJobHandle n = n DevJobHandle
......
......@@ -9,10 +9,11 @@ Portability : POSIX
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
module Gargantext.API.Ngrams.List
where
......@@ -34,12 +35,11 @@ import Gargantext.API.Ngrams (setListNgrams)
import Gargantext.API.Ngrams.List.Types
import Gargantext.API.Ngrams.Prelude (getNgramsList)
import Gargantext.API.Ngrams.Types
import Gargantext.API.Prelude (GargServer, GargM, serverError)
import Gargantext.API.Prelude (GargServer, GargM, serverError, HasServerError)
import Gargantext.API.Types
import Gargantext.Core.NodeStory
import Gargantext.Core.Types.Main (ListType(..))
import Gargantext.Database.Action.Flow (reIndexWith)
import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Query.Table.Ngrams qualified as TableNgrams
import Gargantext.Database.Query.Table.Node (getNode)
......@@ -115,7 +115,7 @@ jsonPostAsync lId =
postAsyncJSON lId (_wjf_data f) jHandle
------------------------------------------------------------------------
postAsyncJSON :: (FlowCmdM env err m, MonadJobStatus m)
postAsyncJSON :: (HasNodeStory env err m, MonadJobStatus m)
=> ListId
-> NgramsList
-> JobHandle m
......@@ -213,11 +213,13 @@ csvToNgramsTableMap record = case Vec.toList record of
-- | This is for debugging the CSV parser in the REPL
--importCsvFile :: (HasNodeStory env err m)
-- => ListId -> P.FilePath -> m ()
--importCsvFile lId fp = do
-- contents <- liftBase $ P.readFile fp
-- postAsyncCSV lId (WithTextFile mempty contents mempty) noJobHandle
importCsvFile :: forall env err m. (HasNodeStory env err m, HasServerError err, MonadJobStatus m)
=> ListId -> P.FilePath -> m ()
importCsvFile lId fp = do
contents <- liftBase $ P.readFile fp
case ngramsListFromCSVData contents of
Left err -> serverError $ err500 { errReasonPhrase = err }
Right ngramsList -> postAsyncJSON lId ngramsList (noJobHandle @m Proxy)
--
-- Utils
......
......@@ -44,6 +44,7 @@ import Prelude
import qualified Servant.Job.Core as SJ
import qualified Servant.Job.Types as SJ
import Data.Proxy
data JobEnv t w a = JobEnv
{ jeSettings :: JobSettings
......@@ -188,6 +189,11 @@ class MonadJobStatus m where
type JobOutputType m :: Type
type JobEventType m :: Type
-- | A job handle that doesn't do anything. Sometimes useful in all those circumstances
-- where we need to test a function taking a 'JobHandle' as input but we are not interested
-- in the progress tracking.
noJobHandle :: Proxy m -> JobHandle m
-- | Retrevies the latest 'JobEventType' from the underlying monad. It can be
-- used to query the latest status for a particular job, given its 'JobHandle' as input.
getLatestJobStatus :: JobHandle m -> m (JobEventType m)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment