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

import Data.Int (fromNumber)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
4
import Data.Maybe (Maybe(..))
5
import Data.Tuple.Nested ((/\))
6
import Effect (Effect)
7
import Effect.Aff (Aff, launchAff_)
8
import Effect.Class (liftEffect)
9
import Effect.Timer (clearInterval, setInterval)
10 11 12
import Reactix as R
import Reactix.DOM.HTML as H

Alexandre Delanoë's avatar
Alexandre Delanoë committed
13
import Gargantext.Prelude
14 15
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
16
import Gargantext.Types as GT
17 18 19
import Gargantext.Utils.Reactix as R2

thisModule = "Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar"
20 21


22 23
data BarType = Bar | Pie

24
type Props =
25
  ( asyncTask :: GT.AsyncTaskWithType
26
  , barType   :: BarType
27
  , corpusId  :: GT.ID
28
  , onFinish  :: Unit -> Effect Unit
29
  , session   :: Session
30 31 32 33 34 35 36
  )


asyncProgressBar :: Record Props -> R.Element
asyncProgressBar p = R.createElement asyncProgressBarCpt p []

asyncProgressBarCpt :: R.Component Props
37
asyncProgressBarCpt = R.hooksComponentWithModule thisModule "asyncProgressBar" cpt
38
  where
39 40 41 42 43
    cpt props@{ asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}})
              , barType
              , corpusId
              , onFinish
              } _ = do
44
      (progress /\ setProgress) <- R.useState' 0.0
45
      intervalIdRef <- R.useRef Nothing
46

47 48
      R.useEffectOnce' $ do
        intervalId <- setInterval 1000 $ do
49
          launchAff_ $ do
50
            asyncProgress@(GT.AsyncProgress {status}) <- queryProgress props
51
            liftEffect do
52 53
              setProgress \p -> min 100.0 $ GT.progressPercent asyncProgress
              if (status == GT.Finished) || (status == GT.Killed) || (status == GT.Failed) then do
54 55 56 57 58 59 60 61 62
                _ <- case R.readRef intervalIdRef of
                  Nothing -> pure unit
                  Just iid -> clearInterval iid
                onFinish unit
              else
                pure unit

        R.setRef intervalIdRef $ Just intervalId

63 64 65
        pure unit


66 67 68
      pure $ progressIndicator { barType, label: id, progress: toInt progress }

    toInt :: Number -> Int
69 70 71
    toInt n = case fromNumber n of
        Nothing -> 0
        Just x  -> x
72 73

type ProgressIndicatorProps =
74 75
  ( barType  :: BarType
  , label    :: String
76 77 78 79 80 81 82
  , progress :: Int
  )

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

progressIndicatorCpt :: R.Component ProgressIndicatorProps
83
progressIndicatorCpt = R.hooksComponentWithModule thisModule "progressIndicator" cpt
84 85
  where
    cpt { barType: Bar, label, progress } _ = do
86 87 88 89
      pure $
        H.div { className: "progress" } [
          H.div { className: "progress-bar"
                , role: "progressbar"
90 91
                , style: { width: (show $ progress) <> "%" }
                } [ H.text label ]
92 93
        ]

94 95 96 97 98 99 100 101
    cpt { barType: Pie, label, progress } _ = do
      pure $
        H.div { className: "progress-pie" } [
          H.div { className: "progress-pie-segment"
                , style: { "--over50": if progress < 50 then "0" else "1"
                         , "--value": show $ progress } } [
          ]
        ]
102

103
queryProgress :: Record Props -> Aff GT.AsyncProgress
104 105 106 107 108 109
queryProgress { asyncTask: GT.AsyncTaskWithType { task: GT.AsyncTask {id}
                                                , typ
                                                }
              , corpusId
              , session
              } = get session (p typ)
110
  where
111 112 113
    -- TODO refactor path
    p GT.UpdateNode = NodeAPI GT.Node   (Just corpusId) $ path <> id <> "/poll?limit=1"
    p _             = NodeAPI GT.Corpus (Just corpusId) $ path <> id <> "/poll?limit=1"
114
    path = GT.asyncTaskTypePath typ
115 116

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