ToggleButton.purs 6.45 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
  , treeToggleButton
James Laver's avatar
James Laver committed
12 13
  ) where

14
import Prelude
15

16
import Effect (Effect)
17 18 19 20
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T

21
import Gargantext.Components.GraphExplorer.Types as GET
22
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
23 24
import Gargantext.Utils.Reactix as R2

25
here :: R2.Here
26
here = R2.here "Gargantext.Components.GraphExplorer.ToggleButton"
27 28

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

36 37
toggleButton :: R2.Component Props
toggleButton = R.createElement toggleButtonCpt
38

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

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

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

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

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"
73
        , onClick: \_ -> T.modify_ not state
74 75
        , style: "light"
        } []
James Laver's avatar
James Laver committed
76

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

81 82
edgesToggleButton :: R2.Component EdgesButtonProps
edgesToggleButton = R.createElement edgesToggleButtonCpt
83 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 116
)

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"
117
        , onClick: \_ -> T.modify_ not state
118 119 120 121
        , style: "primary"
        } []

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

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"
136
        , onClick: \_ -> T.modify_ not state
137 138
        , style : "primary"
        } []
139

140
type ForceAtlasProps = (
141
  state :: T.Box SigmaxTypes.ForceAtlasState
142 143
)

144 145
pauseForceAtlasButton :: R2.Component ForceAtlasProps
pauseForceAtlasButton = R.createElement pauseForceAtlasButtonCpt
146 147

pauseForceAtlasButtonCpt :: R.Component ForceAtlasProps
148
pauseForceAtlasButtonCpt = here.component "forceAtlasToggleButton" cpt
149
  where
150 151 152 153 154 155
    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') ] ]
156 157 158 159 160

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

161
    text SigmaxTypes.InitialRunning = "Pause Force Atlas"
162
    text SigmaxTypes.InitialStopped = "Start Force Atlas"
163 164 165
    text SigmaxTypes.Running = "Pause Force Atlas"
    text SigmaxTypes.Paused = "Start Force Atlas"

166
    onClick state _ = T.modify_ SigmaxTypes.toggleForceAtlasState state
James Laver's avatar
James Laver committed
167

168
type TreeToggleButtonProps = (
169
  state :: T.Box Boolean
170 171 172 173
)

treeToggleButton :: R2.Component TreeToggleButtonProps
treeToggleButton = R.createElement treeToggleButtonCpt
174

175 176
treeToggleButtonCpt :: R.Component TreeToggleButtonProps
treeToggleButtonCpt = here.component "treeToggleButton" cpt
177
  where
178 179 180 181 182
    cpt { state } _ = do
      pure $ toggleButton {
          state: state
        , onMessage: "Hide Tree"
        , offMessage: "Show Tree"
183
        , onClick: \_ -> T.modify_ not state
184 185 186 187
        , style: "light"
        } []

type SidebarToggleButtonProps = (
188
  state :: T.Box GET.SidePanelState
189 190 191 192 193 194 195 196 197 198 199 200 201 202
)

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

      pure $ H.button { className: "btn btn-outline-light " <> cls state'
                      , on: { click: onClick state }
                      } [ R2.small {} [ H.text (text onMessage offMessage state') ] ]
203 204 205 206

    cls (GET.Opened _) = "active"
    cls _ = ""

207 208
    onMessage = "Hide Sidebar"
    offMessage = "Show Sidebar"
209
    text on _off (GET.Opened _)    = on
210
    text _on off GET.InitialClosed = off
211
    text _on off GET.Closed        = off
212

213
    onClick state = \_ ->
214
      T.modify_ (\s -> case s of
215 216
        GET.InitialClosed -> GET.Opened GET.SideTabLegend
        GET.Closed        -> GET.Opened GET.SideTabLegend
217
        (GET.Opened _)    -> GET.Closed) state