Utils.purs 1.89 KB
Newer Older
1 2 3 4 5 6
module Gargantext.Config.Utils where

import Gargantext.Prelude

import Data.Array as A
import Data.Either (Either(..))
7
import Data.Foldable (foldl)
8
import Data.Maybe (fromMaybe)
9
import Effect (Effect)
10 11 12
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.Config.REST (RESTError)
13
import Gargantext.Types (AsyncEvent(..), AsyncProgress(..), AsyncTaskLog(..), AsyncTaskStatus(..), FrontendError(..))
14 15 16 17 18 19
import Gargantext.Utils.Reactix as R2
import Toestand as T

here :: R2.Here
here = R2.here "Gargantext.Config.Utils"

20 21
handleRESTError :: forall a.
                   T.Box (Array FrontendError)
22 23 24 25 26
                -> Either RESTError a
                -> (a -> Aff Unit)
                -> Aff Unit
handleRESTError errors (Left error) _ = liftEffect $ do
  T.modify_ (A.cons $ FRESTError { error }) errors
arturo's avatar
arturo committed
27
  here.warn2 "[handleTaskError] RESTError" error
28
handleRESTError _ (Right task) handler = handler task
29 30 31 32

handleErrorInAsyncProgress :: T.Box (Array FrontendError)
                           -> AsyncProgress
                           -> Effect Unit
33 34
handleErrorInAsyncProgress errors ap@(AsyncProgress { status: IsFailure }) = do
  T.modify_ (A.cons $ FStringError { error: concatErrors ap }) errors
35 36 37 38 39 40 41
handleErrorInAsyncProgress errors ap@(AsyncProgress { log, status: IsFinished }) = do
  if countFailed > 0 then
    T.modify_ (A.cons $ FStringError { error: concatErrors ap }) errors
  else
    pure unit
  where
    countFailed = foldl (+) 0 $ (\(AsyncTaskLog { failed }) -> failed) <$> log
42 43 44
handleErrorInAsyncProgress _ _ = pure unit

concatErrors :: AsyncProgress -> String
45
concatErrors (AsyncProgress { error, log }) = foldl eventsErrorMessage (fromMaybe "" error) log
46 47 48 49
  where
    eventsErrorMessage acc (AsyncTaskLog { events }) = (foldl eventErrorMessage "" events) <> "\n" <> acc
    eventErrorMessage acc (AsyncEvent { level: "ERROR", message }) = message <> "\n" <> acc
    eventErrorMessage acc _ = acc