Add.purs 4.14 KB
Newer Older
1
module Gargantext.Components.Forest.Tree.Node.Action.Add where
2

Alexandre Delanoë's avatar
Alexandre Delanoë committed
3
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
4
import Data.Array (head, length)
5
import Data.Maybe (Maybe(..), fromMaybe)
6
import Data.Tuple.Nested ((/\))
7 8 9 10 11 12
import Effect.Aff (Aff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H

import Gargantext.Prelude

13
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
14
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
15 16
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, formChoiceSafe, panel)
import Gargantext.Components.InputWithEnter (inputWithEnter)
17
import Gargantext.Routes as GR
Alexandre Delanoë's avatar
Alexandre Delanoë committed
18
import Gargantext.Sessions (Session, post)
19
import Gargantext.Types  as GT
20
import Gargantext.Types (NodeType(..))
21 22 23
import Gargantext.Utils.Reactix as R2

thisModule = "Gargantext.Components.Forest.Tree.Node.Action.Add"
24

25
----------------------------------------------------------------------
26
addNode :: Session -> GT.ID -> AddNodeValue -> Aff (Array GT.ID)
27 28 29
addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) ""

addNodeAsync :: Session
30 31 32
             -> GT.ID
             -> AddNodeValue
             -> Aff GT.AsyncTaskWithType
33 34 35 36 37 38 39
addNodeAsync session parentId q = do
  task <- post session p q
  pure $ GT.AsyncTaskWithType {task, typ: GT.AddNode}
  where
    p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)

----------------------------------------------------------------------
40
-- TODO AddNodeParams
41
newtype AddNodeValue = AddNodeValue
42
  { name     :: GT.Name
43 44
  , nodeType :: GT.NodeType
  }
45

46 47 48 49 50 51 52
instance encodeJsonAddNodeValue :: EncodeJson AddNodeValue where
  encodeJson (AddNodeValue {name, nodeType})
     = "pn_name"     := name
    ~> "pn_typename" := nodeType
    ~> jsonEmptyObject

----------------------------------------------------------------------
53 54
data NodePopup = CreatePopup | NodePopup

55
type CreateNodeProps =
56
  ( id        :: GT.ID
57
  , dispatch  :: Action -> Aff Unit
58
  , name      :: GT.Name
59
  , nodeType  :: NodeType
60
  , nodeTypes :: Array NodeType
61
  )
62

63
addNodeView :: Record CreateNodeProps
64
            -> R.Element
65
addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
66
  where
67
    el = R.hooksComponentWithModule thisModule "addNodeView" cpt
68
    cpt {id, name} _ = do
69
      nodeName@(name' /\ setNodeName) <- R.useState' "Name"
70
      nodeType'@(nt /\ setNodeType)   <- R.useState' $ fromMaybe Folder $ head nodeTypes
Alexandre Delanoë's avatar
Alexandre Delanoë committed
71

72 73
      let 
          SettingsBox {edit} = settingsBox nt
74 75 76 77 78 79 80 81 82 83
          (maybeChoose /\ nt') = if length nodeTypes > 1
                           then ([ formChoiceSafe nodeTypes Error setNodeType ] /\ nt)
                           else ([H.div {} [H.text $ "Creating a node of type "
                                                  <> show defaultNt
                                                  <> " with name:"
                                           ]
                                  ] /\ defaultNt 
                                 )
                              where
                                defaultNt = (fromMaybe Error $ head nodeTypes)
84
          maybeEdit   = [ if edit
85 86 87 88 89 90 91 92 93
                          then inputWithEnter {
                              onEnter: \_ -> launchAff_ $ dispatch (AddNode name' nt')
                            , onValueChanged: \val -> setNodeName $ const val
                            , autoFocus: true
                            , className: "form-control"
                            , defaultValue: name'
                            , placeholder: name'
                            , type: "text"
                            }
94 95
                          else H.div {} []
                        ]
96

97
      pure $ panel (maybeChoose <> maybeEdit) (submitButton (AddNode name' nt') dispatch)
98

99 100
-- END Create Node

101
showConfig :: NodeType -> R.Element
102 103 104 105
showConfig NodeUser      = H.div {} []
showConfig FolderPrivate = H.div {} [H.text "This folder will be private only"]
showConfig FolderShared  = H.div {} [H.text "This folder will be shared"]
showConfig FolderPublic  = H.div {} [H.text "This folder will be public"]
106
showConfig nt            = H.div {} [H.h4  {} [H.text $ "Config of " <> show nt ]]
107