ManageTeam.purs 5.12 KB
Newer Older
1 2 3 4
module Gargantext.Components.Forest.Tree.Node.Action.ManageTeam where

import Gargantext.Prelude

Karen Konou's avatar
Karen Konou committed
5
import Data.Array (filter, null, (:))
Karen Konou's avatar
Karen Konou committed
6 7
import Data.Either (Either(..))
import Effect.Aff (runAff_)
8 9 10
import Effect.Class (liftEffect)
import Gargantext.Components.Forest.Tree.Node.Tools as Tools
import Gargantext.Components.GraphQL.Endpoints (deleteTeamMembership, getTeam)
Karen Konou's avatar
Karen Konou committed
11
import Gargantext.Components.GraphQL.Team (Team, TeamMember)
12 13 14
import Gargantext.Config.REST (AffRESTError, logRESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Sessions (Session)
15 16 17 18
import Gargantext.Types (ID, NodeType)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
19
import Toestand as T
20 21 22 23 24 25 26 27 28 29 30 31 32 33 34

here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.ManageTeam"

type ActionManageTeam = (
  id       :: ID
, nodeType :: NodeType
, session  :: Session
)

actionManageTeam :: R2.Component ActionManageTeam
actionManageTeam = R.createElement actionManageTeamCpt

actionManageTeamCpt :: R.Component ActionManageTeam
actionManageTeamCpt = here.component "actionManageTeam" cpt where
35 36 37 38
  cpt {id, session} _ = do
    useLoader { errorHandler
              , loader: loadTeam
              , path: { nodeId: id, session }
Karen Konou's avatar
Karen Konou committed
39 40 41 42
              , render: \team -> teamLayoutWrapper { team
                                                   , nodeId: id
                                                   , session
                                                   } []
43 44 45 46 47 48 49
              }
    where
      errorHandler = logRESTError here "teamLayout"

type TeamProps =
  ( nodeId  :: ID
  , session :: Session
Karen Konou's avatar
Karen Konou committed
50
  , team    :: Team
Karen Konou's avatar
Karen Konou committed
51 52 53 54 55 56 57
  )

teamLayoutWrapper :: R2.Component TeamProps
teamLayoutWrapper = R.createElement teamLayoutWrapperCpt

teamLayoutWrapperCpt :: R.Component TeamProps
teamLayoutWrapperCpt = here.component "teamLayoutWrapper" cpt where
58
  cpt {nodeId, session, team: {team_owner_username, team_members}} _ = do
Karen Konou's avatar
Karen Konou committed
59
    teamS <- T.useBox team_members
Karen Konou's avatar
Karen Konou committed
60 61 62 63
    team' <- T.useLive T.unequal teamS
    error <- T.useBox ""
    error' <- T.useLive T.unequal error

64
    pure $ teamLayoutRows {nodeId, session, team: teamS, team', error, error', team_owner_username}
Karen Konou's avatar
Karen Konou committed
65 66

type TeamRowProps =
Karen Konou's avatar
Karen Konou committed
67 68 69 70 71 72
  ( nodeId               :: ID
  , session              :: Session
  , team                 :: T.Box (Array TeamMember)
  , error                :: T.Box String 
  , team'                :: Array TeamMember
  , error'               :: String
73
  , team_owner_username :: String
Karen Konou's avatar
Karen Konou committed
74
  )
75

Karen Konou's avatar
Karen Konou committed
76
teamLayoutRows :: R2.Leaf TeamRowProps
77 78
teamLayoutRows = R2.leafComponent teamLayoutRowsCpt

Karen Konou's avatar
Karen Konou committed
79
teamLayoutRowsCpt :: R.Component TeamRowProps
80
teamLayoutRowsCpt = here.component "teamLayoutRows" cpt where
81
  cpt { team, nodeId, session, error, team', error', team_owner_username} _ = do
82 83 84 85

    case null team' of
         true  -> pure $ H.div { style: {margin: "10px"}}
                        [ H.h4 {} [H.text "Your team is empty, you can send some invitations."]]
86
         false -> pure $ Tools.panel (makeLeader team_owner_username : (map makeTeam team')) (H.div {} [H.text error'])
87

88
    where
Karen Konou's avatar
Karen Konou committed
89
      makeTeam :: TeamMember -> R.Element
90 91 92 93
      makeTeam { username, shared_folder_id } = H.div {className: "from-group row"} [ H.div { className: "col-8" } [ H.text username ]
                                                                                    , H.a { className: "text-danger col-2 fa fa-times"
                                                                                          , title: "Remove user from team"
                                                                                          , type: "button"
94
                                                                                          , on: {click: submit shared_folder_id }
95 96
                                                                                          } []
                                                                                    ]
Karen Konou's avatar
Karen Konou committed
97 98
      
      makeLeader username = H.div {className: "from-group row"} [ H.div { className: "col-8"} [ H.text username ] 
99
                                                                , H.p { className: "col-2"} [ H.text "owner"]
Karen Konou's avatar
Karen Konou committed
100
                                                                ]
101

102
      submit sharedFolderId _ = do
Karen Konou's avatar
Karen Konou committed
103 104 105 106 107 108 109 110 111 112 113 114 115
        runAff_ callback $ saveDeleteTeam { session, nodeId, sharedFolderId }

      callback res =
        case res of
          Left _ -> do
            _ <- liftEffect $ T.write "Only the Team owner can remove users" error
            pure unit
          Right val ->
            case val of
              Left _ -> do
                pure unit
              Right r -> do
                T.write_ (filter (\tm -> tm.shared_folder_id /= r) team') team
116 117 118 119 120 121

-------------------------------------------------------------

type LoadProps =
  (
    session :: Session,
Karen Konou's avatar
Karen Konou committed
122
    nodeId  :: Int
123 124 125
  )


Karen Konou's avatar
Karen Konou committed
126
loadTeam :: Record LoadProps -> AffRESTError Team
127 128 129 130
loadTeam { session, nodeId } = getTeam session nodeId

type DeleteProps =
  (
Karen Konou's avatar
Karen Konou committed
131 132
    session        :: Session,
    nodeId         :: Int,
133 134 135 136 137 138
    sharedFolderId :: Int
  )


saveDeleteTeam ∷ Record DeleteProps -> AffRESTError Int
saveDeleteTeam { session, nodeId, sharedFolderId } = deleteTeamMembership session sharedFolderId nodeId