Add.purs 5.81 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
import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, panel, submitButton)
17
import Gargantext.Components.InputWithEnter (inputWithEnter)
18
import Gargantext.Components.Lang (Lang(..), translate)
19
import Gargantext.Config.REST (RESTError)
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 -> Aff (Either RESTError (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
             -> Aff (Either RESTError 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 81 82 83 84 85
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

86 87
    hasChromeAgent' <- R.unsafeHooksEffect hasChromeAgent

88
    let
89

90 91 92 93 94
        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 ([ formChoiceSafe nodeTypes Error setNodeType' (print hasChromeAgent') ] /\ nodeType')
96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118
                         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)
119

120 121
-- END Create Node

122

123
showConfig :: NodeType -> R.Element
124 125 126 127
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"]
128
showConfig nt            = H.div {} [H.h4  {} [H.text $ "Config of " <> show nt ]]
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

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