1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
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
150
151
152
153
154
155
156
157
module Gargantext.Components.Forest.Tree.Node.Action.Add where
import Gargantext.Prelude
import Data.Array (head, length)
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromMaybe, isJust)
import Data.Newtype (class Newtype)
import Data.String (Pattern(..), indexOf)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, panel, submitButton)
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Lang (Lang(..), translate)
import Gargantext.Config.REST (RESTError, AffRESTError)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types (NodeType(..), charCodeIcon)
import Gargantext.Types as GT
import Gargantext.Utils (nbsp)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Web.HTML (window)
import Web.HTML.Navigator (userAgent)
import Web.HTML.Window (navigator)
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Add"
addNode :: Session -> GT.ID -> AddNodeValue -> AffRESTError (Array GT.ID)
addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) ""
addNodeAsync :: Session
-> GT.ID
-> AddNodeValue
-> AffRESTError GT.AsyncTaskWithType
addNodeAsync session parentId q = do
eTask :: Either RESTError GT.AsyncTask <- post session p q
case eTask of
Left err -> pure $ Left err
Right task -> pure $ Right $ GT.AsyncTaskWithType { task, typ: GT.AddNode }
where
p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)
----------------------------------------------------------------------
-- TODO AddNodeParams
newtype AddNodeValue = AddNodeValue
{ name :: GT.Name
, nodeType :: GT.NodeType
}
derive instance Generic AddNodeValue _
derive instance Newtype AddNodeValue _
instance JSON.WriteForeign AddNodeValue where
writeImpl (AddNodeValue {name, nodeType}) = JSON.writeImpl { pn_name: name
, pn_typename: nodeType }
----------------------------------------------------------------------
data NodePopup = CreatePopup | NodePopup
type CreateNodeProps =
( id :: GT.ID
, dispatch :: Action -> Aff Unit
, name :: GT.Name
, nodeType :: NodeType
, nodeTypes :: Array NodeType
)
addNodeView :: R2.Component CreateNodeProps
addNodeView = R.createElement addNodeViewCpt
addNodeViewCpt :: R.Component CreateNodeProps
addNodeViewCpt = here.component "addNodeView" cpt where
cpt { dispatch
, nodeTypes } _ = do
nodeName <- T.useBox "Name"
nodeName' <- T.useLive T.unequal nodeName
nodeType <- T.useBox $ fromMaybe Folder $ head nodeTypes
nodeType' <- T.useLive T.unequal nodeType
hasChromeAgent' <- R.unsafeHooksEffect hasChromeAgent
let
SettingsBox {edit} = settingsBox nodeType'
setNodeType' nt = do
T.write_ (GT.prettyNodeType nt) nodeName
T.write_ nt nodeType
(maybeChoose /\ nt') = if length nodeTypes > 1
then ([ formChoiceSafe nodeTypes Error setNodeType' (print hasChromeAgent') ] /\ nodeType')
else ([H.div {} [H.text $ "Creating a node of type "
<> show defaultNt
<> " with name:"
]
] /\ defaultNt
)
where
defaultNt = (fromMaybe Error $ head nodeTypes)
maybeEdit = [ if edit
then inputWithEnter {
onBlur: \val -> T.write_ val nodeName
, onEnter: \_ -> launchAff_ $ dispatch (AddNode nodeName' nt')
, onValueChanged: \val -> T.write_ val nodeName
, autoFocus: true
, className: "form-control"
, defaultValue: nodeName' -- (prettyNodeType nt')
, placeholder: nodeName' -- (prettyNodeType nt')
, type: "text"
}
else H.div {} []
]
pure $ panel (maybeChoose <> maybeEdit) (submitButton (AddNode nodeName' nt') dispatch)
-- END Create Node
showConfig :: NodeType -> R.Element
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"]
showConfig nt = H.div {} [H.h4 {} [H.text $ "Config of " <> show nt ]]
-- (?) Regarding `print` and `hasChromeAgent`
--
-- As described in #309:
-- * while sticking to solution a) for icon display, it only works on
-- Chrome engine
-- * for now, we just patch surgery the like of display according to the
-- user browser (ie. has Chrome -> has icons)
print :: Boolean -> NodeType -> String
print withIconFlag nt =
let txt = translate EN -- @TODO "EN" assumption
in if withIconFlag
then
charCodeIcon nt true
--- as we are printing within an HTML text node,
-- margins will directly rely on content text spacing
<> nbsp 4
<> txt nt
else
txt nt
hasChromeAgent :: Effect Boolean
hasChromeAgent = window >>= navigator >>= userAgent >>= \ua -> pure $ check ua
where
check = indexOf (Pattern "Chrome") >>> isJust