Box.purs 9.22 KB
Newer Older
1
module Gargantext.Components.Forest.Tree.Node.Box where
2

3 4
import Gargantext.Prelude

5
import Data.Array as A
Alexandre Delanoë's avatar
Alexandre Delanoë committed
6
import Data.Maybe (Maybe(..))
7
import Effect.Aff (Aff)
arturo's avatar
arturo committed
8
import Gargantext.Components.App.Store (Boxes)
9
import Gargantext.Components.Bootstrap as B
10
import Gargantext.Components.Forest.Tree.Node.Action.Add (addNodeView)
11
import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
12
import Gargantext.Components.Forest.Tree.Node.Action.Delete (actionDelete)
13
import Gargantext.Components.Forest.Tree.Node.Action.Documentation (actionDoc)
14
import Gargantext.Components.Forest.Tree.Node.Action.Download (actionDownload)
15 16 17
import Gargantext.Components.Forest.Tree.Node.Action.Link (linkNode)
import Gargantext.Components.Forest.Tree.Node.Action.Merge (mergeNode)
import Gargantext.Components.Forest.Tree.Node.Action.Move (moveNode)
18
import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameAction)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
19
import Gargantext.Components.Forest.Tree.Node.Action.Search (actionSearch)
20
import Gargantext.Components.Forest.Tree.Node.Action.Share as Share
21
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action)
22 23
import Gargantext.Components.Forest.Tree.Node.Action.Update (update)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (actionUpload)
24
import Gargantext.Components.Forest.Tree.Node.Action.WriteNodesDocuments (actionWriteNodesDocuments)
25
import Gargantext.Components.Forest.Tree.Node.Box.Types (NodePopupProps, NodePopupS)
26
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox)
27
import Gargantext.Components.Forest.Tree.Node.Status (Status(..), hasStatus)
28
import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, textInputBox)
29
import Gargantext.Sessions (Session)
30
import Gargantext.Types (ID, Name, prettyNodeType)
31
import Gargantext.Types as GT
32
import Gargantext.Utils.Glyphicon (glyphicon, glyphiconActive)
33
import Gargantext.Utils.Reactix as R2
34 35 36
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
37

James Laver's avatar
James Laver committed
38 39
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Box"
40

41
type CommonProps =
42 43 44
  ( dispatch  :: Action -> Aff Unit
  , session   :: Session
  )
45

46
nodePopupView :: R2.Leaf NodePopupProps
47
nodePopupView = R2.leafComponent nodePopupCpt
48
nodePopupCpt :: R.Component NodePopupProps
James Laver's avatar
James Laver committed
49 50
nodePopupCpt = here.component "nodePopupView" cpt where
  cpt p@{ id, name, nodeType }  _ = do
51
    renameIsOpen <- T.useBox false
James Laver's avatar
James Laver committed
52
    open <- T.useLive T.unequal renameIsOpen
53 54
    nodePopup <- T.useBox { action: Nothing, id, name, nodeType }
    action <- T.useFocused (_.action) (\a b -> b { action = a }) nodePopup
James Laver's avatar
James Laver committed
55
    nodePopup' <- T.useLive T.unequal nodePopup
56

57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
    pure $

      H.div
      { className: "node-popup-tooltip"
      , title: "Node settings"
      }
      [
        H.div
        { className: "popup-container card" }
        [
          panelHeading renameIsOpen open p
        ,
          panelBody    action p
        ,
          mPanelAction nodePopup' p
72 73
        ]
      ]
74

James Laver's avatar
James Laver committed
75
  panelHeading renameIsOpen open p@{ dispatch, id, name, nodeType } =
76
    H.div { className: "popup-container__header card-header" }
James Laver's avatar
James Laver committed
77 78 79 80 81 82 83 84 85
    [ R2.row
      [ H.div { className: "col-4" }
        [ H.span { className: GT.fldr nodeType true} [] -- TODO fix names
        , H.span { className: "h5" } [ H.text $ prettyNodeType nodeType ] ]
      , H.div { className: "col-6" }
        [ if open then
            textInputBox { boxAction: renameAction, boxName: "Rename"
                         , dispatch, id, text: name, isOpen: renameIsOpen } []
          else H.span { className: "text-primary center" } [ H.text p.name ]
86
        ]
James Laver's avatar
James Laver committed
87 88
      , H.div { className: "col-1" } [ editIcon renameIsOpen open ]
      , H.div { className: "col-1" }
89
        [ H.a { type: "button", on: { click: \_ -> p.closeCallback unit }, title: "Close"
90
              , className: glyphicon "window-close" } [] ]]]
James Laver's avatar
James Laver committed
91 92 93
  editIcon _ true = H.div {} []
  editIcon isOpen false =
    H.a { className: glyphicon "pencil", id: "rename1"
94 95
        , title    : "Rename", on: { click: \_ -> T.write_ true isOpen } } []
  panelBody :: T.Box (Maybe NodeAction) -> Record NodePopupProps -> R.Element
96
  panelBody nodePopupState { nodeType } =
97
    let (SettingsBox { doc, buttons }) = settingsBox nodeType in
98 99
    H.div {className: "popup-container__body card-body flex-space-between"}
    $ [ B.wad_ [ "m-1" ]
James Laver's avatar
James Laver committed
100 101 102 103 104 105 106 107 108 109
      , H.div { className: "flex-center" }
        [ buttonClick { action: doc, state: nodePopupState, nodeType } ]
      , H.div {className: "flex-center"}
        $ map (\t -> buttonClick { action: t, state: nodePopupState, nodeType }) buttons ]
        -- FIXME trick to increase the size of the box
        <> if A.length buttons < 2
           then [ H.div { className: "col-4" } [] ]
           else []
  mPanelAction :: Record NodePopupS -> Record NodePopupProps -> R.Element
  mPanelAction { action: Just action }
110
               { boxes, dispatch, id, name, nodeType, session } =
111
    panelAction { action
112
                , boxes
113 114 115 116
                , dispatch
                , id
                , name
                , nodeType
117 118
                , session
                }
James Laver's avatar
James Laver committed
119
  mPanelAction { action: Nothing } _ =
120
    H.div { className: "popup-container__footer card-footer" }
James Laver's avatar
James Laver committed
121 122 123
    [ H.div {className:"center fa-hand-pointer-o"}
      [ H.h5 {} [ H.text " Select available actions of this node" ]
      , H.ul { className: "panel-actions" }
124
        [ H.div { className: "fa-thumbs-o-up panel-actions__ok-to-use" }
James Laver's avatar
James Laver committed
125
          [ H.text " Black: usable" ]
126
        , H.div { className: "fa-exclamation-triangle panel-actions__almost-useable" }
James Laver's avatar
James Laver committed
127
          [ H.text " Orange: almost useable" ]
128
        , H.div { className: "fa-rocket panel-actions__development-in-progress" }
James Laver's avatar
James Laver committed
129
          [ H.text " Red: development in progress" ]]]]
130

131
type ActionState =
132 133 134
  ( action   :: Maybe NodeAction
  , id       :: ID
  , name     :: Name
135 136 137 138
  , nodeType :: GT.NodeType
  )

type ButtonClickProps =
James Laver's avatar
James Laver committed
139
  ( action   :: NodeAction
140
  , state    :: T.Box (Maybe NodeAction)
141
  , nodeType :: GT.NodeType
142 143 144 145 146 147
  )

buttonClick :: Record ButtonClickProps -> R.Element
buttonClick p = R.createElement buttonClickCpt p []

buttonClickCpt :: R.Component ButtonClickProps
James Laver's avatar
James Laver committed
148 149 150 151 152
buttonClickCpt = here.component "buttonClick" cpt where
  cpt {action: todo, state, nodeType} _ = do
    action <- T.useLive T.unequal state
    let className = glyphiconActive (glyphiconNodeAction todo) (action == (Just todo))
    let style = iconAStyle nodeType todo
153
    let click _ = T.write_ (if action == Just todo then Nothing else Just todo) state
James Laver's avatar
James Laver committed
154 155
    pure $ H.div { className: "col-1" }
      [ H.a { style, className, id: show todo, title: show todo, on: { click } } [] ]
156
        -- | Open the help indications if selected already
James Laver's avatar
James Laver committed
157 158 159
  iconAStyle n a =
    { color: hasColor (hasStatus n a)
    , paddingTop: "6px", paddingBottom: "6px" }
160

James Laver's avatar
James Laver committed
161 162 163 164
hasColor :: Status -> String
hasColor Stable = "black"
hasColor Test   = "orange"
hasColor Dev    = "red"
165

166 167 168
type NodeProps =
  ( id       :: ID
  , name     :: Name
169
  , nodeType :: GT.NodeType
170 171 172
  )


173
type PanelActionProps =
174 175 176
  ( action    :: NodeAction
  , boxes     :: Boxes
  , id        :: ID
177 178 179 180
  , dispatch  :: Action -> Aff Unit
  , name      :: Name
  , nodeType  :: GT.NodeType
  , session   :: Session
181 182
  )

183
panelAction :: R2.Leaf PanelActionProps
184
panelAction = R2.leafComponent panelActionCpt
185
panelActionCpt :: R.Component PanelActionProps
James Laver's avatar
James Laver committed
186
panelActionCpt = here.component "panelAction" cpt
187
  where
188 189 190 191 192
    cpt { action: Documentation nodeType}                  _ = pure $ actionDoc { nodeType } []
    cpt { action: Download, id, nodeType, session}         _ = pure $ actionDownload { id, nodeType, session } []
    cpt { action: Upload, dispatch, id, nodeType, session} _ = pure $ actionUpload { dispatch, id, nodeType, session } []
    cpt { action: Delete, nodeType, dispatch}              _ = pure $ actionDelete { dispatch, nodeType } []
    cpt { action: Add xs, dispatch, id, name, nodeType} _ =
193
      pure $ addNodeView {dispatch, id, name, nodeType, nodeTypes: xs} []
194 195
    cpt { action: Refresh , dispatch, nodeType } _ = pure $ update { dispatch, nodeType } []
    cpt { action: Config, nodeType } _ =
196
      pure $ fragmentPT $ "Config " <> show nodeType
197
    -- Functions using SubTree
198 199
    cpt { action: Merge {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
      pure $ mergeNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
200
    cpt { action: Move {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
201
      pure $ moveNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
202
    cpt { action: Link {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
203
      pure $ linkNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
204 205 206
    cpt { action : Share, dispatch, id } _ = pure $ Share.shareNode { dispatch, id } []
    cpt { action : AddingContact, dispatch, id } _ = pure $ Contact.actionAddContact { dispatch, id } []
    cpt { action : Publish {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
207
      pure $ Share.publishNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
208
    cpt { action: SearchBox, boxes, dispatch, id, session } _ =
209
      pure $ actionSearch { boxes, dispatch, id: Just id, session } []
210 211
    cpt { action: WriteNodesDocuments, boxes, dispatch, id, session } _ =
      pure $ actionWriteNodesDocuments { boxes, dispatch, id, session } []
James Laver's avatar
James Laver committed
212
    cpt _ _ = pure $ H.div {} []