Progress.purs 3.57 KB
Newer Older
arturo's avatar
arturo committed
1 2 3 4 5 6
module Gargantext.Context.Progress
  ( AsyncProps
  , asyncProgress
  , asyncContext
  ) where

7
import Data.Either (Either(..))
arturo's avatar
arturo committed
8 9 10 11 12 13
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Effect.Timer (IntervalId, clearInterval, setInterval)
14
import Gargantext.Components.App.Store as AppStore
arturo's avatar
arturo committed
15 16 17
import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (QueryProgressData, queryProgress)
import Gargantext.Config.Utils (handleErrorInAsyncProgress, handleRESTError)
import Gargantext.Hooks.FirstEffect (useFirstEffect')
18
import Gargantext.Prelude
arturo's avatar
arturo committed
19
import Gargantext.Sessions (Session)
20
import Gargantext.Types (AsyncProgress)
arturo's avatar
arturo committed
21 22 23 24 25 26
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Record.Extra as RX
import Toestand as T

27

arturo's avatar
arturo committed
28 29 30 31 32 33 34
type AsyncProps =
  ( asyncTask :: GT.AsyncTaskWithType
  , nodeId    :: GT.ID
  , onFinish  :: Unit -> Effect Unit
  , session   :: Session
  )

35 36 37
here :: R2.Here
here = R2.here "Gargantext.Context.Progress"

arturo's avatar
arturo committed
38
asyncProgress :: R2.Component AsyncProps
39 40
asyncProgress = R2.component asyncProgressCpt
asyncProgressCpt :: R.Component AsyncProps
41 42
asyncProgressCpt = R2.hereComponent here "asyncProgress" hCpt where
  hCpt hp props@{ onFinish } children = do
43 44
    { errors } <- AppStore.use
    
arturo's avatar
arturo committed
45 46 47
    -- States
    progress /\ progressBox <- R2.useBox' 0.0
    intervalIdRef <- R.useRef (Nothing :: Maybe IntervalId)
48 49
    -- exponential backoff is used when errors are reported
    interval <- T.useBox 1000
arturo's avatar
arturo committed
50 51 52 53 54 55 56 57

    -- Methods
    let
      exec :: Unit -> Effect Unit
      exec _ = launchAff_ do
        let rdata = (RX.pick props :: Record QueryProgressData)

        eAsyncProgress <- queryProgress rdata
58 59 60 61 62 63 64
        -- exponential backoff in case of errors
        liftEffect $ do
          case eAsyncProgress of
            Left _  -> T.modify_ (_ * 2) interval
            Right _ -> T.write_ 1000 interval
          interval' <- T.read interval
          resetInterval intervalIdRef (Just interval') exec
65
        handleRESTError hp errors eAsyncProgress onProgress
arturo's avatar
arturo committed
66 67 68 69 70 71 72 73 74 75 76

      onProgress :: AsyncProgress -> Aff Unit
      onProgress value = liftEffect do
        let GT.AsyncProgress { status } = value

        T.write_ (min 100.0 $ GT.progressPercent value) progressBox

        if (status == GT.IsFinished) ||
           (status == GT.IsKilled) ||
           (status == GT.IsFailure)
        then do
77 78 79 80
          resetInterval intervalIdRef Nothing exec
          -- case R.readRef intervalIdRef of
          --   Nothing  -> R.nothing
          --   Just iid -> clearInterval iid
arturo's avatar
arturo committed
81 82 83 84 85 86 87
          handleErrorInAsyncProgress errors value
          onFinish unit
        else
          R.nothing

    -- Hooks
    useFirstEffect' do
88 89 90
      resetInterval intervalIdRef (Just 1000) exec
      -- intervalId <- setInterval interval' $ exec unit
      -- R.setRef intervalIdRef $ Just intervalId
arturo's avatar
arturo committed
91 92 93 94 95 96 97

    -- Render
    pure $

      R.provideContext asyncContext (progress)
      children

98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113
resetInterval :: R.Ref (Maybe IntervalId) -> Maybe Int -> (Unit -> Effect Unit) -> Effect Unit
resetInterval ref mInt exec = do
  case R.readRef ref /\ mInt of
    Nothing /\ Nothing  ->
      pure unit
    Nothing /\ Just interval' -> do
      intervalId <- setInterval interval' $ exec unit
      R.setRef ref $ Just intervalId
    Just iid /\ Nothing -> do
      clearInterval iid
      R.setRef ref Nothing
    Just iid /\ Just interval' -> do
      clearInterval iid
      intervalId <- setInterval interval' $ exec unit
      R.setRef ref $ Just intervalId

arturo's avatar
arturo committed
114 115
asyncContext :: R.Context (Number)
asyncContext = R.createContext 0.0