ToggleButton.purs 7.66 KB
Newer Older
James Laver's avatar
James Laver committed
1
module Gargantext.Components.GraphExplorer.ToggleButton
2 3 4
  ( Props
  , toggleButton
  , toggleButtonCpt
James Laver's avatar
James Laver committed
5 6
  , controlsToggleButton
  , edgesToggleButton
7 8
  , louvainToggleButton
  , multiSelectEnabledButton
9
  , sidebarToggleButton
10
  , pauseForceAtlasButton
11
  , resetForceAtlasButton
12
  , treeToggleButton
James Laver's avatar
James Laver committed
13 14
  ) where

15
import Prelude
16

17
import Effect (Effect)
18 19 20
import Gargantext.Components.Graph as Graph
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
21
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
22
import Gargantext.Types as GT
23
import Gargantext.Utils.Reactix as R2
24 25 26
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
27

28
here :: R2.Here
29
here = R2.here "Gargantext.Components.GraphExplorer.ToggleButton"
30 31

type Props = (
32
    state      :: T.Box Boolean
33
  , onMessage  :: String
34
  , offMessage :: String
35
  , style      :: String
36
  , onClick    :: forall e. e -> Effect Unit
37
  )
James Laver's avatar
James Laver committed
38

39 40
toggleButton :: R2.Component Props
toggleButton = R.createElement toggleButtonCpt
James Laver's avatar
James Laver committed
41
toggleButtonCpt :: R.Component Props
42
toggleButtonCpt = here.component "toggleButton" cpt
James Laver's avatar
James Laver committed
43
  where
44 45 46 47 48 49 50
    cpt { state
        , onMessage
        , offMessage
        , onClick
        , style } _ = do
      state' <- T.useLive T.unequal state

51 52 53
      pure $ H.div { className: "btn btn-outline-" <> style <> " " <> cls state' <> " mx-2"
                   , on: { click: onClick }
                   } [ R2.small {} [ H.text (text onMessage offMessage state') ] ]
54 55 56

    cls true = "active"
    cls false = ""
James Laver's avatar
James Laver committed
57 58 59
    text on _off true = on
    text _on off false = off

60
type ControlsToggleButtonProps = (
61
  state :: T.Box Boolean
62 63 64 65 66 67 68 69 70 71 72 73
  )

controlsToggleButton :: R2.Component ControlsToggleButtonProps
controlsToggleButton = R.createElement controlsToggleButtonCpt
controlsToggleButtonCpt :: R.Component ControlsToggleButtonProps
controlsToggleButtonCpt = here.component "controlsToggleButton" cpt
  where
    cpt { state } _ = do
      pure $ toggleButton {
          state: state
        , onMessage: "Hide Controls"
        , offMessage: "Show Controls"
74
        , onClick: \_ -> T.modify_ not state
75 76
        , style: "light"
        } []
James Laver's avatar
James Laver committed
77

78
type EdgesButtonProps = (
79
  state :: T.Box SigmaxTypes.ShowEdgesState
80 81
)

82 83
edgesToggleButton :: R2.Component EdgesButtonProps
edgesToggleButton = R.createElement edgesToggleButtonCpt
84
edgesToggleButtonCpt :: R.Component EdgesButtonProps
85
edgesToggleButtonCpt = here.component "edgesToggleButton" cpt
86
  where
87 88 89 90 91 92
    cpt { state } _ = do
      state' <- T.useLive T.unequal state

      pure $ H.button { className: "btn btn-outline-primary " <> cls state'
                      , on: { click: onClick state }
                      } [ R2.small {} [ H.text (text state') ] ]
93

94 95
    text s = if SigmaxTypes.edgeStateHidden s then "Show edges" else "Hide edges"

96 97
    cls SigmaxTypes.EShow = ""
    cls _ = "active"
98

99
    -- TODO: Move this to Graph.purs to the R.useEffect handler which renders nodes/edges
100
    onClick state _ = T.modify_ SigmaxTypes.toggleShowEdgesState state
101 102

type LouvainToggleButtonProps = (
103
  state :: T.Box Boolean
104 105 106 107 108 109 110 111 112 113 114 115
)

louvainToggleButton :: R2.Component LouvainToggleButtonProps
louvainToggleButton = R.createElement louvainToggleButtonCpt
louvainToggleButtonCpt :: R.Component LouvainToggleButtonProps
louvainToggleButtonCpt = here.component "louvainToggleButton" cpt
  where
    cpt { state } _ = do
      pure $ toggleButton {
          state: state
        , onMessage: "Louvain off"
        , offMessage: "Louvain on"
116
        , onClick: \_ -> T.modify_ not state
117 118 119 120
        , style: "primary"
        } []

type MultiSelectEnabledButtonProps = (
121
  state :: T.Box Boolean
122 123 124 125 126 127 128 129 130 131 132 133
)

multiSelectEnabledButton :: R2.Component MultiSelectEnabledButtonProps
multiSelectEnabledButton = R.createElement multiSelectEnabledButtonCpt
multiSelectEnabledButtonCpt :: R.Component MultiSelectEnabledButtonProps
multiSelectEnabledButtonCpt = here.component "lmultiSelectEnabledButton" cpt
  where
    cpt { state } _ = do
      pure $ toggleButton {
          state: state
        , onMessage: "Single-node"
        , offMessage: "Multi-node"
134
        , onClick: \_ -> T.modify_ not state
135 136
        , style : "primary"
        } []
137

138
type ForceAtlasProps = (
139
  state :: T.Box SigmaxTypes.ForceAtlasState
140 141
)

142 143
pauseForceAtlasButton :: R2.Component ForceAtlasProps
pauseForceAtlasButton = R.createElement pauseForceAtlasButtonCpt
144
pauseForceAtlasButtonCpt :: R.Component ForceAtlasProps
145
pauseForceAtlasButtonCpt = here.component "forceAtlasToggleButton" cpt
146
  where
147 148 149 150 151 152
    cpt { state } _ = do
      state' <- T.useLive T.unequal state

      pure $ H.button { className: "btn btn-outline-primary " <> cls state'
                      , on: { click: onClick state }
                      } [ R2.small {} [ H.text (text state') ] ]
153 154 155 156 157

    cls SigmaxTypes.InitialRunning = "active"
    cls SigmaxTypes.Running = "active"
    cls _ = ""

158
    text SigmaxTypes.InitialRunning = "Pause Force Atlas"
159
    text SigmaxTypes.InitialStopped = "Start Force Atlas"
160 161
    text SigmaxTypes.Running = "Pause Force Atlas"
    text SigmaxTypes.Paused = "Start Force Atlas"
162
    text SigmaxTypes.Killed = "Start Force Atlas"
163

164
    onClick state _ = T.modify_ SigmaxTypes.toggleForceAtlasState state
James Laver's avatar
James Laver committed
165

166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185
type ResetForceAtlasProps = (
    forceAtlasState :: T.Box SigmaxTypes.ForceAtlasState
  , sigmaRef        :: R.Ref Sigmax.Sigma
)

resetForceAtlasButton :: R2.Component ResetForceAtlasProps
resetForceAtlasButton = R.createElement resetForceAtlasButtonCpt
resetForceAtlasButtonCpt :: R.Component ResetForceAtlasProps
resetForceAtlasButtonCpt = here.component "resetForceAtlasToggleButton" cpt
  where
    cpt { forceAtlasState, sigmaRef } _ = do
      pure $ H.button { className: "btn btn-outline-primary"
                      , on: { click: onClick forceAtlasState sigmaRef }
                      } [ R2.small {} [ H.text "Reset Force Atlas" ] ]

    onClick forceAtlasState sigmaRef _ = do
      -- TODO Sigma.killForceAtlas2 sigma
      -- startForceAtlas2 sigma
      Sigmax.dependOnSigma (R.readRef sigmaRef) "[resetForceAtlasButton] no sigma" $ \sigma -> do
        Sigma.killForceAtlas2 sigma
186
        Sigma.refreshForceAtlas sigma Graph.forceAtlas2Settings
187 188
        T.write_ SigmaxTypes.Killed forceAtlasState

189
type TreeToggleButtonProps = (
190
  state :: T.Box Boolean
191 192 193 194 195 196
)

treeToggleButton :: R2.Component TreeToggleButtonProps
treeToggleButton = R.createElement treeToggleButtonCpt
treeToggleButtonCpt :: R.Component TreeToggleButtonProps
treeToggleButtonCpt = here.component "treeToggleButton" cpt
197
  where
198 199 200 201 202
    cpt { state } _ = do
      pure $ toggleButton {
          state: state
        , onMessage: "Hide Tree"
        , offMessage: "Show Tree"
203
        , onClick: \_ -> T.modify_ not state
204 205 206 207
        , style: "light"
        } []

type SidebarToggleButtonProps = (
208
  state :: T.Box GT.SidePanelState
209 210 211 212 213 214 215 216 217 218
)

sidebarToggleButton :: R2.Component SidebarToggleButtonProps
sidebarToggleButton = R.createElement sidebarToggleButtonCpt
sidebarToggleButtonCpt :: R.Component SidebarToggleButtonProps
sidebarToggleButtonCpt = here.component "sidebarToggleButton" cpt
  where
    cpt { state } _ = do
      state' <- T.useLive T.unequal state

219 220 221
      pure $ H.div { className: "btn btn-outline-light " <> cls state'
                   , on: { click: onClick state }
                   } [ R2.small {} [ H.text (text onMessage offMessage state') ] ]
222

223 224
    cls GT.Opened = "active"
    cls _         = ""
225

226 227
    onMessage = "Hide Sidebar"
    offMessage = "Show Sidebar"
228 229 230
    text on _off GT.Opened        = on
    text _on off GT.InitialClosed = off
    text _on off GT.Closed        = off
231

232
    onClick state = \_ ->
233 234 235 236 237
      T.modify_ GT.toggleSidePanelState state
                  -- case s of
        -- GET.InitialClosed -> GET.Opened GET.SideTabLegend
        -- GET.Closed        -> GET.Opened GET.SideTabLegend
        -- (GET.Opened _)    -> GET.Closed) state