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

3 4
import Gargantext.Prelude

5
import Data.Array (head, length)
6
import Data.Either (Either(..))
7
import Data.Generic.Rep (class Generic)
8
import Data.Maybe (Maybe(..), fromMaybe, isJust)
9
import Data.Newtype (class Newtype)
10
import Data.String (Pattern(..), indexOf)
11
import Data.Tuple.Nested ((/\))
12
import Effect (Effect)
13
import Effect.Aff (Aff, launchAff_)
14
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
15
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
16 17
import Gargantext.Components.Forest.Tree.Node.Tools (formChoice, panel, submitButton)
import Gargantext.Components.InputWithEnter (inputWithEnterWithKey)
18
import Gargantext.Components.Lang (Lang(..), translate)
19
import Gargantext.Config.REST (RESTError, AffRESTError)
20
import Gargantext.Routes as GR
Alexandre Delanoë's avatar
Alexandre Delanoë committed
21
import Gargantext.Sessions (Session, post)
22 23 24
import Gargantext.Types (NodeType(..), charCodeIcon)
import Gargantext.Types as GT
import Gargantext.Utils (nbsp)
25
import Gargantext.Utils.Reactix as R2
26 27 28 29 30 31 32
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)
33

34
here :: R2.Here
35
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Add"
36

37
addNode :: Session -> GT.ID -> AddNodeValue -> AffRESTError (Array GT.ID)
38 39 40
addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) ""

addNodeAsync :: Session
41 42
             -> GT.ID
             -> AddNodeValue
43
             -> AffRESTError GT.AsyncTaskWithType
44
addNodeAsync session parentId q = do
45 46
  eTask :: Either RESTError GT.AsyncTask <- post session p q
  case eTask of
47 48
    Left err -> pure $ Left err
    Right task -> pure $ Right $ GT.AsyncTaskWithType { task, typ: GT.AddNode }
49 50
  where
    p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)
51 52

----------------------------------------------------------------------
53
-- TODO AddNodeParams
54
newtype AddNodeValue = AddNodeValue
55
  { name     :: GT.Name
56 57
  , nodeType :: GT.NodeType
  }
58 59 60 61 62
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 }
63 64

----------------------------------------------------------------------
65 66
data NodePopup = CreatePopup | NodePopup

67
type CreateNodeProps =
68
  ( id        :: GT.ID
69
  , dispatch  :: Action -> Aff Unit
70
  , name      :: GT.Name
71
  , nodeType  :: NodeType
72
  , nodeTypes :: Array NodeType
73
  )
74

75 76 77 78 79 80
addNodeView :: R2.Component CreateNodeProps
addNodeView = R.createElement addNodeViewCpt
addNodeViewCpt :: R.Component CreateNodeProps
addNodeViewCpt = here.component "addNodeView" cpt where
  cpt { dispatch
      , nodeTypes } _ = do
81 82
    let defaultNodeType = fromMaybe Folder $ head nodeTypes
    nodeName <- T.useBox $ GT.prettyNodeType defaultNodeType
83
    nodeName' <- T.useLive T.unequal nodeName
84
    nodeType <- T.useBox defaultNodeType
85 86
    nodeType' <- T.useLive T.unequal nodeType

87 88
    hasChromeAgent' <- R.unsafeHooksEffect hasChromeAgent

89 90 91 92 93 94
    let
        SettingsBox {edit} = settingsBox nodeType'
        setNodeType' nt = do
          T.write_ (GT.prettyNodeType nt) nodeName
          T.write_ nt nodeType
        (maybeChoose /\ nt') = if length nodeTypes > 1
95
                         then ([ formChoice { items: nodeTypes
96
                                            , default: nodeType'
97 98
                                            , callback: setNodeType'
                                            , print: print hasChromeAgent' } [] ] /\ nodeType')
99 100 101 102 103 104 105 106 107
                         else ([H.div {} [H.text $ "Creating a node of type "
                                                <> show defaultNt
                                                <> " with name:"
                                         ]
                                ] /\ defaultNt
                               )
                            where
                              defaultNt = (fromMaybe Error $ head nodeTypes)
        maybeEdit   = [ if edit
108
                        then inputWithEnterWithKey {
109 110 111 112 113 114 115 116
                            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"
117
                          , key: show nodeType'
118 119 120 121 122
                          }
                        else H.div {} []
                      ]

    pure $ panel (maybeChoose <> maybeEdit) (submitButton (AddNode nodeName' nt') dispatch)
123

124 125
-- END Create Node

126

127
showConfig :: NodeType -> R.Element
128 129 130 131
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"]
132
showConfig nt            = H.div {} [H.h4  {} [H.text $ "Config of " <> show nt ]]
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 158 159 160 161

-- (?) 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