User.purs 12.6 KB
Newer Older
Alexandre Delanoë's avatar
Alexandre Delanoë committed
1 2 3 4 5 6
module Gargantext.Components.Nodes.Annuaire.User
  ( module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
  , userLayout
  )
  where

7

8 9
import Gargantext.Prelude

10 11
import Data.Either (Either(..))
import Data.Lens as L
Alexandre Delanoë's avatar
Alexandre Delanoë committed
12 13
import Data.Maybe (Maybe(..), fromMaybe)
import Effect (Effect)
14
import Effect.Aff (launchAff_)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
15
import Effect.Class (liftEffect)
arturo's avatar
arturo committed
16
import Gargantext.Components.App.Store (Boxes)
17 18
import Gargantext.Components.GraphQL (getClient)
import Gargantext.Components.GraphQL.Endpoints (getUserInfo)
Karen Konou's avatar
Karen Konou committed
19
import Gargantext.Components.GraphQL.User (UserInfo, _ui_cwCity, _ui_cwCountry, _ui_cwFirstName, _ui_cwLabTeamDeptsFirst, _ui_cwLastName, _ui_cwOffice, _ui_cwOrganizationFirst, _ui_cwRole, _ui_cwTouchMail, _ui_cwTouchPhone, _ui_cwDescription)
20
import Gargantext.Components.InputWithEnter (inputWithEnter)
21
import Gargantext.Components.Nodes.Annuaire.Tabs as Tabs
22
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
23
import Gargantext.Components.Nodes.Lists.Types as LT
24
import Gargantext.Config.REST (AffRESTError, logRESTError)
25
import Gargantext.Config.Utils (handleRESTError)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
26 27
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
28
import Gargantext.Sessions (Session(..), WithSession, WithSessionContext, sessionId)
29
import Gargantext.Types (FrontendError)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
30
import Gargantext.Utils.Reactix as R2
31
import Gargantext.Utils.Toestand as T2
32 33
import GraphQL.Client.Args (IgnoreArg(..), OrArg(..), onlyArgs)
import GraphQL.Client.Query (mutation)
34 35
import Reactix as R
import Reactix.DOM.HTML as H
36
import Record as Record
37
import Toestand as T
Alexandre Delanoë's avatar
Alexandre Delanoë committed
38

39 40
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Annuaire.User"
Alexandre Delanoë's avatar
Alexandre Delanoë committed
41

42
type DisplayProps = ( title :: String )
Alexandre Delanoë's avatar
Alexandre Delanoë committed
43 44 45 46

display :: R2.Component DisplayProps
display = R.createElement displayCpt
displayCpt :: R.Component DisplayProps
47
displayCpt = here.component "display" cpt
Alexandre Delanoë's avatar
Alexandre Delanoë committed
48 49 50 51 52 53 54 55 56 57 58 59 60 61
  where
    cpt { title } children = do
      pure $ H.div { className: "container-fluid" }
        [ H.div { className: "row", id: "contact-page-header" }
          [ H.div { className: "col-md-6"} [ H.h3 {} [ H.text title ] ]
          , H.div { className: "col-md-8"} []
          , H.div { className: "col-md-2"} [ H.span {} [ H.text "" ] ]
          ]
        , H.div { className: "row", id: "contact-page-info" }
          [ H.div { className: "col-md-12" }
            [ H.div { className: "row" }
              [ H.div { className: "col-md-2" } [ H.img { src: "/images/Gargantextuel-212x300.jpg"} ]
              , H.div { className: "col-md-1"} []
              , H.div { className: "col-md-8"} children
62
              ]
Alexandre Delanoë's avatar
Alexandre Delanoë committed
63 64
            ]
          ]
65
        ]
Alexandre Delanoë's avatar
Alexandre Delanoë committed
66

67
{-
Alexandre Delanoë's avatar
Alexandre Delanoë committed
68 69
listElement :: Array R.Element -> R.Element
listElement = H.li { className: "list-group-item justify-content-between" }
70
-}
Alexandre Delanoë's avatar
Alexandre Delanoë committed
71

72
type LayoutNoSessionProps =
73 74 75
  ( boxes     :: Boxes
  , frontends :: Frontends
  , nodeId    :: Int
Alexandre Delanoë's avatar
Alexandre Delanoë committed
76 77
  )

78 79 80 81
type LayoutProps = WithSession LayoutNoSessionProps

type LayoutSessionContextProps = WithSessionContext LayoutNoSessionProps

82 83
userLayout :: R2.Component LayoutProps
userLayout = R.createElement userLayoutCpt
Alexandre Delanoë's avatar
Alexandre Delanoë committed
84
userLayoutCpt :: R.Component LayoutProps
85
userLayoutCpt = here.component "userLayout" cpt
Alexandre Delanoë's avatar
Alexandre Delanoë committed
86
  where
87 88
    cpt props@{ nodeId
              , session } _ = do
Alexandre Delanoë's avatar
Alexandre Delanoë committed
89 90
      let sid = sessionId session

91
      pure $ userLayoutWithKey $ Record.merge props { key: show sid <> "-" <> show nodeId }
Alexandre Delanoë's avatar
Alexandre Delanoë committed
92

arturo's avatar
arturo committed
93
userLayoutWithKey :: R2.Leaf ( key :: String | LayoutProps )
94
userLayoutWithKey = R2.leaf userLayoutWithKeyCpt
arturo's avatar
arturo committed
95
userLayoutWithKeyCpt :: R.Component ( key :: String | LayoutProps )
96
userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt where
97
  cpt { boxes: boxes@{ sidePanelTexts }
98 99
      , frontends
      , nodeId
100
      , session } _ = do
101 102 103
    reload <- T.useBox T2.newReload
    reload' <- T.useLive T.unequal reload

104 105
    let Session {userId} = session

106 107 108
    cacheState <- T.useBox LT.CacheOn

    useLoader { errorHandler
109
              , loader: getUserInfoWithReload
110
              , path: { nodeId: userId, reload: reload', session }
111
              , render: \userInfo@{ ui_username } ->
112
                  H.ul { className: "col-md-12 list-group" } [
113 114
                    display { title: fromMaybe "no name" (Just ui_username) }
                    (contactInfos userInfo (onUpdateUserInfo boxes.errors reload))
115
                    , Tabs.tabs {
116 117
                         boxes
                       , cacheState
118
                       , defaultListId: 424242
119 120 121
                       , frontends
                       , nodeId
                       , session
122
                       , sidePanel: sidePanelTexts
123
                       }
124
                    ]
125 126
              }
    where
127
      errorHandler = logRESTError here "[userLayoutWithKey]"
128 129
      onUpdateUserInfo :: T.Box (Array FrontendError) -> T2.ReloadS -> UserInfo -> Effect Unit
      onUpdateUserInfo errors reload ui = do
130
        launchAff_ $ do
131 132
          let Session {userId} = session
          res <- saveUserInfo session userId ui
133 134 135
          handleRESTError errors res $ \_ ->
            liftEffect $ T2.reload reload

136
--saveContactHyperdata :: Session -> Int -> HyperdataUser -> AffRESTError Int
137
--saveContactHyperdata session id = put session (Routes.NodeAPI Node (Just id) "")
Alexandre Delanoë's avatar
Alexandre Delanoë committed
138 139

-- | toUrl to get data XXX
140
--getContact :: Session -> Int -> AffRESTError ContactData
141 142 143 144 145 146 147 148 149 150 151
--getContact session id = do
--  eContactNode <- get session $ Routes.NodeAPI Node (Just id) ""
--  -- TODO: we need a default list for the pairings
--  --defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
--  --case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
--  --  Just (NodePoly { id: defaultListId }) ->
--  --    pure {contactNode, defaultListId}
--  --  Nothing ->
--  --    throwError $ error "Missing default list"
--  pure $ (\contactNode -> { contactNode, defaultListId: 424242 }) <$> eContactNode
--
152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172

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

-- | TODO format data in better design (UI) shape
contactInfos :: UserInfo -> (UserInfo -> Effect Unit) -> Array R.Element
contactInfos userInfo onUpdateUserInfo = item <$> contactInfoItems where
  item { label, lens, defaultVal } =
    contactInfoItem { defaultVal, label, lens, onUpdateUserInfo, userInfo }

contactInfoItems :: Array {label:: String, defaultVal:: String, lens:: UserInfoLens}
contactInfoItems =
  [ { label: "Last Name"    , defaultVal: "Empty Last Name"    , lens: _ui_cwLastName                     }
  , { label: "First Name"   , defaultVal: "Empty First Name"   , lens: _ui_cwFirstName                    }
  , { label: "Organisation" , defaultVal: "Empty Organisation" , lens: _ui_cwOrganizationFirst            }
  , { label: "Lab/Team/Dept", defaultVal: "Empty Lab/Team/Dept", lens: _ui_cwLabTeamDeptsFirst            }
  , { label: "Office"       , defaultVal: "Empty Office"       , lens: _ui_cwOffice                       }
  , { label: "City"         , defaultVal: "Empty City"         , lens: _ui_cwCity                         }
  , { label: "Country"      , defaultVal: "Empty Country"      , lens: _ui_cwCountry                      }
  , { label: "Role"         , defaultVal: "Empty Role"         , lens: _ui_cwRole                         }
  , { label: "Phone"        , defaultVal: "Empty Phone"        , lens: _ui_cwTouchPhone                   }
  , { label: "Mail"         , defaultVal: "Empty Mail"         , lens: _ui_cwTouchMail                    }
Karen Konou's avatar
Karen Konou committed
173
  , { label: "Description"  , defaultVal: "No description"     , lens: _ui_cwDescription                  }
174 175 176 177 178 179 180 181 182 183 184 185 186
  ]

type UserInfoLens = L.ALens' UserInfo String

type ContactInfoItemProps =
  ( defaultVal       :: String
  , label            :: String
  , lens             :: UserInfoLens
  , onUpdateUserInfo :: UserInfo -> Effect Unit
  , userInfo         :: UserInfo
  )

contactInfoItem :: R2.Leaf ContactInfoItemProps
187
contactInfoItem = R2.leaf contactInfoItemCpt
188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218
contactInfoItemCpt :: R.Component ContactInfoItemProps
contactInfoItemCpt = here.component "contactInfoItem" cpt
  where
    cpt { defaultVal, label, lens, onUpdateUserInfo, userInfo } _ = do
      isEditing <- T.useBox false
      isEditing' <- T.useLive T.unequal isEditing

      let value = (L.view cLens userInfo) :: String

      valueBox <- T.useBox value
      pure $
        H.div { className: "form-group row" }
          [ H.span { className: "col-sm-2 col-form-label" } [ H.text label ]
          , if isEditing' then
              itemEditing { defaultVal, isEditing, lens, onUpdateUserInfo, userInfo, valueBox }
            else
              itemNotEditing { defaultVal, isEditing, lens, onUpdateUserInfo, userInfo, valueBox }
          ]
      where
        cLens = L.cloneLens lens

type ItemProps =
  ( defaultVal       :: String
  , isEditing        :: T.Box Boolean
  , lens             :: UserInfoLens
  , onUpdateUserInfo :: UserInfo -> Effect Unit
  , userInfo         :: UserInfo
  , valueBox         :: T.Box String
  )

itemNotEditing :: R2.Leaf ItemProps
219
itemNotEditing = R2.leaf itemNotEditingCpt
220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235
itemNotEditingCpt :: R.Component ItemProps
itemNotEditingCpt = here.component "itemEditing" cpt where
  cpt { isEditing, valueBox } _ = do
    valueBox' <- T.useLive T.unequal valueBox

    pure $ H.div { className: "input-group col-sm-6" }
             [ H.input
               { className: "form-control", type: "text"
               , defaultValue: valueBox', disabled: true }
             , H.div { className: "btn input-group-append", on: { click } }
               [ H.div { className: "input-group-text fa fa-pencil" } [] ]
             ]
      where
        click _ = T.write_ true isEditing

itemEditing :: R2.Leaf ItemProps
236
itemEditing = R2.leaf itemEditingCpt
237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287
itemEditingCpt :: R.Component ItemProps
itemEditingCpt = here.component "itemNotEditing" cpt where
  cpt { defaultVal, isEditing, lens, onUpdateUserInfo, userInfo, valueBox } _ = do
    valueBox' <- T.useLive T.unequal valueBox

    pure $ H.div { className: "input-group col-sm-6" }
             [ inputWithEnter
               { autoFocus: true
               , className: "form-control"
               , defaultValue: valueBox'
               , onBlur: \v -> T.write_ v valueBox
               , onEnter: click
               , onValueChanged: \v -> do
                   here.log2 "[itemEditingCpt] value Changed: " v
                   T.write_ v valueBox
               , placeholder: defaultVal
               , type: "text" }
             , H.div { className: "btn input-group-append", on: { click } }
               [ H.div { className: "input-group-text fa fa-floppy-o" } [] ]
             ]
      where
        cLens = L.cloneLens lens
        click _ = do
          T.write_ false isEditing
          value <- T.read valueBox
          here.log2 "[itemEditing] value" value
          let newUserInfo = (L.set cLens value userInfo) :: UserInfo
          onUpdateUserInfo newUserInfo


-- saveContactHyperdata :: Session -> Int -> HyperdataContact -> AffRESTError Int
-- saveContactHyperdata session id = put session (Routes.NodeAPI Node (Just id) "")

saveUserInfo :: Session -> Int -> UserInfo ->  AffRESTError Int
saveUserInfo session id ui = do
  let token = getToken session
  client <- liftEffect $ getClient session
  res <- mutation
    client
    "update user_info"
    { update_user_info: onlyArgs { token: token
                                 , ui_id: id
                                 , ui_cwFirstName: ga ui.ui_cwFirstName
                                 , ui_cwLastName: ga ui.ui_cwLastName
                                 , ui_cwOrganization: ui.ui_cwOrganization
                                 , ui_cwLabTeamDepts: ui.ui_cwLabTeamDepts
                                 , ui_cwOffice: ga ui.ui_cwOffice
                                 , ui_cwCity: ga ui.ui_cwCity
                                 , ui_cwCountry: ga ui.ui_cwCountry
                                 , ui_cwRole: ga ui.ui_cwRole
                                 , ui_cwTouchPhone: ga ui.ui_cwTouchPhone
Karen Konou's avatar
Karen Konou committed
288 289
                                 , ui_cwTouchMail: ga ui.ui_cwTouchMail
                                 , ui_cwDescription: ga ui.ui_cwDescription } }
290 291 292 293 294 295 296 297 298 299 300
  pure $ Right res.update_user_info
  where
    ga Nothing = ArgL IgnoreArg
    ga (Just val) = ArgR val
    getToken (Session { token }) = token

getUserInfoWithReload :: { nodeId :: Int
                         , reload :: T2.Reload
                         , session :: Session
                         } -> AffRESTError UserInfo
getUserInfoWithReload {nodeId, session} = getUserInfo session nodeId -- getContact session nodeId