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

3 4
import Gargantext.Prelude

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

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


26 27
data BarType = Bar | Pie

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


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

51 52
      R.useEffectOnce' $ do
        intervalId <- setInterval 1000 $ do
53
          launchAff_ $ do
54
            eAsyncProgress <- queryProgress props
55 56 57 58 59 60 61
            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
62
                handleErrorInAsyncProgress errors asyncProgress
63 64 65
                onFinish unit
              else
                pure unit
66 67 68

        R.setRef intervalIdRef $ Just intervalId

69 70 71
        pure unit


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

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

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

progressIndicatorCpt :: R.Component ProgressIndicatorProps
84
progressIndicatorCpt = here.component "progressIndicator" cpt
85
  where
86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109
    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
110

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

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