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

3 4
import Gargantext.Prelude

5
import Data.Int (floor)
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
import Reactix as R
import Reactix.DOM.HTML as H
arturo's avatar
arturo committed
20
import Record.Extra as RX
21
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
arturo's avatar
arturo committed
55 56
            let rdata = (RX.pick props :: Record QueryProgressData)
            eAsyncProgress <- queryProgress rdata
57 58 59 60 61 62 63
            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
64
                handleErrorInAsyncProgress errors asyncProgress
65 66 67
                onFinish unit
              else
                pure unit
68 69 70

        R.setRef intervalIdRef $ Just intervalId

71 72 73
        pure unit


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

arturo's avatar
arturo committed
76 77 78
--------------------------------------------------------------


79
type ProgressIndicatorProps =
80 81
  ( barType  :: BarType
  , label    :: String
82
  , progress :: T.Box Number
83 84 85 86 87
  )

progressIndicator :: Record ProgressIndicatorProps -> R.Element
progressIndicator p = R.createElement progressIndicatorCpt p []
progressIndicatorCpt :: R.Component ProgressIndicatorProps
88
progressIndicatorCpt = here.component "progressIndicator" cpt
89
  where
90 91
    cpt { barType, label, progress } _ = do
      progress' <- T.useLive T.unequal progress
92
      let progressInt = floor progress'
93 94 95 96 97 98 99

      case barType of
        Bar -> pure $
                H.div { className: "progress" }
                  [ H.div { className: "progress-bar"
                        , role: "progressbar"
                        , style: { width: (show $ progressInt) <> "%" }
100
                        } [ ]
101 102 103 104 105 106 107 108 109
                  ]
        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 } } [
                    ]
                  ]

arturo's avatar
arturo committed
110 111 112 113 114 115 116 117 118 119

--------------------------------------------------------------

type QueryProgressData =
  ( asyncTask :: GT.AsyncTaskWithType
  , nodeId    :: GT.ID
  , session   :: Session
  )

queryProgress :: Record QueryProgressData -> AffRESTError GT.AsyncProgress
120 121 122
queryProgress { asyncTask: GT.AsyncTaskWithType { task: GT.AsyncTask {id}
                                                , typ
                                                }
123
              , nodeId
124 125
              , session
              } = get session (p typ)
126
  where
127
    -- TODO refactor path
128
    p GT.ListCSVUpload      = NodeAPI GT.NodeList (Just nodeId) $ GT.asyncTaskTypePath GT.ListCSVUpload <> id <> "/poll?limit=1"
129
    p GT.UpdateNgramsCharts = NodeAPI GT.Node   (Just nodeId) $ path <> id <> "/poll?limit=1"
130
    p GT.UpdateNode         = NodeAPI GT.Node   (Just nodeId) $ path <> id <> "/poll?limit=1"
131
    p _                     = NodeAPI GT.Corpus (Just nodeId) $ path <> id <> "/poll?limit=1"
132
    path = GT.asyncTaskTypePath typ
133 134

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