User.purs 12.8 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 98
  cpt { boxes: boxes@{ sidePanelLists
                     , sidePanelTexts }
99 100
      , frontends
      , nodeId
101
      , session } _ = do
102 103 104
    reload <- T.useBox T2.newReload
    reload' <- T.useLive T.unequal reload

105 106
    let Session {userId} = session

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

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

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

-- | toUrl to get data XXX
142
--getContact :: Session -> Int -> AffRESTError ContactData
143 144 145 146 147 148 149 150 151 152 153
--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
--
154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174

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

-- | 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
175
  , { label: "Description"  , defaultVal: "No description"     , lens: _ui_cwDescription                  }
176 177 178 179 180 181 182 183 184 185 186 187 188
  ]

type UserInfoLens = L.ALens' UserInfo String

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

contactInfoItem :: R2.Leaf ContactInfoItemProps
189
contactInfoItem = R2.leaf contactInfoItemCpt
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 219 220
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
221
itemNotEditing = R2.leaf itemNotEditingCpt
222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237
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
238
itemEditing = R2.leaf itemEditingCpt
239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254
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
255 256
               , type: "text" 
               , required: false }
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 288 289 290
             , 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
291 292
                                 , ui_cwTouchMail: ga ui.ui_cwTouchMail
                                 , ui_cwDescription: ga ui.ui_cwDescription } }
293 294 295 296 297 298 299 300 301 302 303
  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