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

arturo's avatar
arturo committed
3 4 5
import Gargantext.Prelude

import Data.Maybe (fromMaybe)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
6 7
import Data.Set (Set)
import Data.Set as Set
8
import Data.String as S
9
import Effect (Effect)
10
import Effect.Aff (Aff, launchAff, launchAff_)
11 12
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (Elevation(..), Variant(..))
13 14
import Gargantext.Components.Forest.Tree.Node.Action (icon, text)
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action)
15
import Gargantext.Components.InputWithEnter (inputWithEnter)
16
import Gargantext.Types as GT
arturo's avatar
arturo committed
17
import Gargantext.Utils (toggleSet)
18
import Gargantext.Utils.Reactix as R2
19
import Gargantext.Utils.Show as GUS
20 21 22
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
23

James Laver's avatar
James Laver committed
24 25
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools"
26

James Laver's avatar
James Laver committed
27 28
fragmentPT :: String -> R.Element
fragmentPT text = H.div { style: { margin: "10px" }} [ H.text text ]
29 30

type Body    = Array R.Element
James Laver's avatar
James Laver committed
31

32 33 34 35
type Footer  = R.Element

panel :: Body -> Footer -> R.Element
panel bodies submit =
James Laver's avatar
James Laver committed
36 37 38 39 40 41 42 43
  R.fragment
  [ H.div { className: "card-body" }
    [ H.div { className: "row" }
        -- TODO add type for text or form here [ H.form {className: "form-horizontal"} bodies ]
      [ H.div { className: "col-12" } bodies ]]
  , H.div {className: "card-footer"}
    [ H.div { className: "row" }
      [ H.div { className: "mx-auto"} [ submit ] ]]]
44

45
type TextInputBoxProps =
46
  ( id       :: GT.ID
47 48
  , dispatch :: Action -> Aff Unit
  , text     :: String
49
  , isOpen    :: T.Box Boolean
50 51 52 53
  , boxName  :: String
  , boxAction :: String -> Action
  )

54
textInputBox :: R2.Component TextInputBoxProps
55 56
textInputBox = R.createElement textInputBoxCpt
textInputBoxCpt :: R.Component TextInputBoxProps
James Laver's avatar
James Laver committed
57
textInputBoxCpt = here.component "textInputBox" cpt where
arturo's avatar
arturo committed
58
  cpt { boxAction, boxName, dispatch, isOpen, text } _ =
James Laver's avatar
James Laver committed
59 60 61 62
    content <$> T.useLive T.unequal isOpen <*> R.useRef text
    where
      content false _ = (R.fragment [])
      content true renameNodeNameRef =
63
        H.div
64
        { className: "d-flex align-items-center justify-content-space-between" }
65 66 67 68 69 70
        [
          textInput renameNodeNameRef
        ,
          submitBtn renameNodeNameRef
        ,
          cancelBtn
71
        ]
72

73
      textInput renameNodeNameRef =
74
        H.div
75
        { className: "w-10/12" }
76 77 78 79 80 81 82 83 84 85
        [
          inputWithEnter
          { autoFocus: true
          , className: "form-control"
          , defaultValue: text
          , onBlur: R.setRef renameNodeNameRef
          , onEnter: submit renameNodeNameRef
          , onValueChanged: R.setRef renameNodeNameRef
          , placeholder: (boxName <> " Node")
          , type: "text"
86
          , required: false
87 88 89
          }
        ]

90
      submitBtn renameNodeNameRef =
91 92 93 94 95 96 97
        B.iconButton
        { callback: submit renameNodeNameRef
        , title: "Submit"
        , name: "floppy-o"
        , elevation: Level1
        }

98
      cancelBtn =
99 100 101 102 103 104 105
        B.iconButton
        { callback: const $ T.write_ false isOpen
        , variant: Danger
        , title: "Cancel"
        , name: "times"
        }

James Laver's avatar
James Laver committed
106 107
      submit ref _ = do
        launchAff_ $ dispatch (boxAction $ R.readRef ref)
108
        T.write_ false isOpen
109

110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149
type InviteInputBoxProps =
  ( id       :: GT.ID
  , dispatch :: Action -> Aff Unit
  , text     :: String
  , boxName  :: String
  , boxAction :: String -> Action
  , username :: T.Box String
  )

inviteInputBox :: R2.Component InviteInputBoxProps
inviteInputBox = R.createElement inviteInputBoxCpt
inviteInputBoxCpt :: R.Component InviteInputBoxProps
inviteInputBoxCpt = here.component "textInputBox" cpt where
  cpt { boxAction, boxName, dispatch, text, username } _ =
    content <$> R.useRef text
    where
      content renameNodeNameRef =
        H.div
        { className: "d-flex align-items-center" }
        [
          textInput renameNodeNameRef
        ,
          B.wad_ [ "d-inline-block", "w-3" ]
        ,
          submitBtn renameNodeNameRef
        ]

      textInput renameNodeNameRef =
        H.div
        {}
        [
          inputWithEnter
          { autoFocus: true
          , className: "form-control"
          , defaultValue: text
          , onBlur: R.setRef renameNodeNameRef
          , onEnter: submit renameNodeNameRef
          , onValueChanged: R.setRef renameNodeNameRef
          , placeholder: (boxName <> " Node")
          , type: "text"
150
          , required: false
151 152 153 154 155 156 157 158 159 160 161 162 163 164 165
          }
        ]

      submitBtn renameNodeNameRef =
        B.iconButton
        { callback: submit renameNodeNameRef
        , title: "Submit"
        , name: "plus"
        , elevation: Level1
        }

      submit ref _ = do
        T.write_ ("Invited " <> R.readRef ref <> " to the team") username
        launchAff_ $ dispatch (boxAction $ R.readRef ref)

166 167
type DefaultText = String

James Laver's avatar
James Laver committed
168 169
formEdit :: forall prev next
          . DefaultText -> ((prev -> String) -> Effect next) -> R.Element
170
formEdit defaultValue setter =
James Laver's avatar
James Laver committed
171 172 173 174
  H.div { className: "form-group" }
  [ H.input { defaultValue, type: "text", on: { input }
            , placeholder: defaultValue, className: "form-control" }
  ] where input = setter <<< const <<< R.unsafeEventValue
175

176 177 178 179 180 181
type FormChoiceSafeProps item m =
  ( items    :: Array item
  , default  :: item
  , callback :: item -> Effect m
  , print    :: item -> String )

Alexandre Delanoë's avatar
Alexandre Delanoë committed
182
-- | Form Choice input
183
-- if the list of options is not big enough, a button is used instead
184
formChoiceSafe :: forall item m
185
  .  Show item
186 187
  => R2.Component (FormChoiceSafeProps item m)
formChoiceSafe = R.createElement formChoiceSafeCpt
188
formChoiceSafeCpt :: forall item m. Show item => R.Component (FormChoiceSafeProps item m)
189 190 191 192 193 194 195 196 197 198 199 200
formChoiceSafeCpt = here.component "formChoiceSafe" cpt where
  cpt { items, default, callback, print } _ = do
    pure $ case items of
      []  -> H.div {} []
      [n] -> formButton { item: n, callback, print } []
      _   -> formChoice { items, default, callback, print } []

type FormChoiceProps item m =
  ( items    :: Array item
  , default  :: item
  , callback :: item -> Effect m
  , print    :: item -> String )
201

202 203
-- | List Form
formChoice :: forall item m
204
  .  Show item
205 206
  => R2.Component (FormChoiceProps item m)
formChoice = R.createElement formChoiceCpt
207
formChoiceCpt :: forall item m. Show item => R.Component (FormChoiceProps item m)
208 209 210 211 212 213
formChoiceCpt = here.component "formChoice" cpt where
  cpt { items, callback, default, print } _ = do
    pure $ H.div { className: "form-group"}
      [
        R2.select
        { className: "form-control with-icon-font"
214
        , defaultValue: show default
215 216 217 218 219
        , on: { change }
        } $ map option items
      ]

    where
220
      change e = callback $ fromMaybe default $ reader $ R.unsafeEventValue e
221 222 223

      option opt = H.option { value: show opt } [ H.text $ print opt ]

224 225
      reader = GUS.reader items

226 227 228 229
type FormButtonProps item m =
  ( item     :: item
  , callback :: item -> Effect m
  , print    :: item -> String )
230

231 232
-- | Button Form
-- FIXME: currently needs a click from the user (by default, we could avoid such click)
233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250
formButton :: forall item m. R2.Component (FormButtonProps item m)
formButton = R.createElement formButtonCpt
formButtonCpt :: forall item m. R.Component (FormButtonProps item m)
formButtonCpt = here.component "formButton" cpt where
  cpt { item, callback, print} _ = do
    pure $ H.div {}
      [ H.text $ "Confirm the selection of: " <> print item
      , cta ]

    where
      cta =
        H.button { className : "cold-md-5 btn btn-primary center"
                 , type : "button"
                 , title: "Form Button"
                 , style : { width: "100%" }
                 , on: { click: \_ -> callback item }
                 }
        [ H.text "Confirmation" ]
251

252 253 254
------------------------------------------------------------------------
------------------------------------------------------------------------

255 256 257
submitButton :: Action -> (Action -> Aff Unit) -> R.Element
submitButton action dispatch =
  H.button { className : "btn btn-primary fa fa-" <> icon action
258 259 260 261 262
           , type: "button"
           , id: S.toLower $ show action
           , title: show action
           , on: {click: \_ -> launchAff $ dispatch action}
           }
263
  [ H.span {className: "font-family-theme mx-1"} [ H.text $ " " <> text action] ]
264

265 266 267 268
type Href  = String

submitButtonHref :: Action -> Href -> R.Element
submitButtonHref action href =
269
  H.a { className, href, target: "_blank" }
270
  [ H.span {className: "font-family-theme mx-1"} [ H.text $ " " <> text action ] ]
271
  where
James Laver's avatar
James Laver committed
272
    className = "btn btn-primary fa fa-" <> icon action
273

Alexandre Delanoë's avatar
Alexandre Delanoë committed
274 275
------------------------------------------------------------------------
-- | CheckBox tools
276
-- checkboxes: Array of boolean values (basic: without pending option)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
277 278
-- checkbox  : One boolean value only

279 280 281 282
type CheckboxProps =
  ( value :: T.Box Boolean )

checkbox :: R2.Leaf CheckboxProps
283
checkbox = R2.leaf checkboxCpt
284 285 286 287 288 289 290 291 292 293 294 295
checkboxCpt :: R.Component CheckboxProps
checkboxCpt = here.component "checkbox" cpt
  where
    cpt { value } _ = do
      value' <- T.useLive T.unequal value

      pure $ H.input { className: "form-check-input"
                     , on: { click }
                     , type: "checkbox"
                     , value: value' }
      where
        click _ = T.modify_ not value
296

Alexandre Delanoë's avatar
Alexandre Delanoë committed
297 298
data CheckBoxes = Multiple | Uniq

299 300 301 302 303 304 305 306 307
type CheckboxesListGroup a =
  ( groups :: Array a
  , options :: T.Box (Set a) )

checkboxesListGroup :: forall a. Ord a => Show a => R2.Component (CheckboxesListGroup a)
checkboxesListGroup = R.createElement checkboxesListGroupCpt
checkboxesListGroupCpt :: forall a. Ord a => Show a => R.Component (CheckboxesListGroup a)
checkboxesListGroupCpt = here.component "checkboxesListGroup" cpt
  where
308
    cpt { options } _ = do
309 310 311 312 313 314 315 316 317 318 319 320 321
      options' <- T.useLive T.unequal options

      let one a =
            H.li { className: "list-group-item" }
              [ H.div { className: "form-check" }
                [ H.input { defaultChecked: Set.member a options'
                          , on: { click: \_ -> T.write_ (toggleSet a options') options
                                , type: "checkbox" }
                          , className: "form-check-input" }
                , H.label { className: "form-check-label" } [ H.text (show a) ] ]
              ]

      pure $ R.fragment $ map one $ Set.toUnfoldable options'
Alexandre Delanoë's avatar
Alexandre Delanoë committed
322

323
prettyNodeType :: GT.NodeType -> String
James Laver's avatar
James Laver committed
324 325 326 327
prettyNodeType
  =   S.replace (S.Pattern "Node")   (S.Replacement " ")
  <<< S.replace (S.Pattern "Folder") (S.Replacement " ")
  <<< show