ProgressBar.purs 4.43 KB
Newer Older
1
module Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar where
2

3 4
import Gargantext.Prelude

5
import Data.Either (Either)
6
import Data.Int (fromNumber)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
7
import Data.Maybe (Maybe(..))
8
import Effect (Effect)
9
import Effect.Aff (Aff, launchAff_)
10
import Effect.Class (liftEffect)
11
import Effect.Timer (clearInterval, setInterval)
12
import Gargantext.Config.REST (RESTError)
13
import Gargantext.Config.Utils (handleErrorInAsyncProgress, handleRESTError)
14 15
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
16
import Gargantext.Types (FrontendError)
17
import Gargantext.Types as GT
18
import Gargantext.Utils.Reactix as R2
19 20 21
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
22

23 24
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar"
25 26


27 28
data BarType = Bar | Pie

29 30
type Props = (
    asyncTask :: GT.AsyncTaskWithType
31
  , barType   :: BarType
32
  , errors    :: T.Box (Array FrontendError)
33
  , nodeId    :: GT.ID
34
  , onFinish  :: Unit -> Effect Unit
35
  , session   :: Session
36 37 38
  )


39 40
asyncProgressBar :: R2.Component Props
asyncProgressBar = R.createElement asyncProgressBarCpt
41
asyncProgressBarCpt :: R.Component Props
42
asyncProgressBarCpt = here.component "asyncProgressBar" cpt
43
  where
44 45
    cpt props@{ asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}})
              , barType
46
              , errors
47 48
              , onFinish
              } _ = do
49
      progress <- T.useBox 0.0
50
      intervalIdRef <- R.useRef Nothing
51

52 53
      R.useEffectOnce' $ do
        intervalId <- setInterval 1000 $ do
54
          launchAff_ $ do
55
            eAsyncProgress <- queryProgress props
56 57 58 59 60 61 62
            handleRESTError errors eAsyncProgress $ \asyncProgress -> liftEffect $ do
              let GT.AsyncProgress { status } = asyncProgress
              T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress
              if (status == GT.IsFinished) || (status == GT.IsKilled) || (status == GT.IsFailure) then do
                _ <- case R.readRef intervalIdRef of
                  Nothing -> pure unit
                  Just iid -> clearInterval iid
63
                handleErrorInAsyncProgress errors asyncProgress
64 65 66
                onFinish unit
              else
                pure unit
67 68 69

        R.setRef intervalIdRef $ Just intervalId

70 71 72
        pure unit


73
      pure $ progressIndicator { barType, label: id, progress }
74 75

type ProgressIndicatorProps =
76 77
  ( barType  :: BarType
  , label    :: String
78
  , progress :: T.Box Number
79 80 81 82 83 84
  )

progressIndicator :: Record ProgressIndicatorProps -> R.Element
progressIndicator p = R.createElement progressIndicatorCpt p []

progressIndicatorCpt :: R.Component ProgressIndicatorProps
85
progressIndicatorCpt = here.component "progressIndicator" cpt
86
  where
87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110
    cpt { barType, label, progress } _ = do
      progress' <- T.useLive T.unequal progress
      let progressInt = toInt progress'

      case barType of
        Bar -> pure $
                H.div { className: "progress" }
                  [ H.div { className: "progress-bar"
                        , role: "progressbar"
                        , style: { width: (show $ progressInt) <> "%" }
                        } [ H.text label ]
                  ]
        Pie -> pure $
                H.div { className: "progress-pie" }
                  [ H.div { className: "progress-pie-segment"
                          , style: { "--over50": if progressInt < 50 then "0" else "1"
                                   , "--value": show $ progressInt } } [
                    ]
                  ]

    toInt :: Number -> Int
    toInt n = case fromNumber n of
        Nothing -> 0
        Just x  -> x
111

112
queryProgress :: Record Props -> Aff (Either RESTError GT.AsyncProgress)
113 114 115
queryProgress { asyncTask: GT.AsyncTaskWithType { task: GT.AsyncTask {id}
                                                , typ
                                                }
116
              , nodeId
117 118
              , session
              } = get session (p typ)
119
  where
120
    -- TODO refactor path
121
    p GT.ListCSVUpload      = NodeAPI GT.NodeList (Just nodeId) $ GT.asyncTaskTypePath GT.ListCSVUpload <> id <> "/poll?limit=1"
122
    p GT.UpdateNgramsCharts = NodeAPI GT.Node   (Just nodeId) $ path <> id <> "/poll?limit=1"
123
    p GT.UpdateNode         = NodeAPI GT.Node   (Just nodeId) $ path <> id <> "/poll?limit=1"
124
    p _                     = NodeAPI GT.Corpus (Just nodeId) $ path <> id <> "/poll?limit=1"
125
    path = GT.asyncTaskTypePath typ
126 127

    -- TODO wait route: take the result if failure then message