Contacts.purs 11.7 KB
Newer Older
1 2
module Gargantext.Components.Nodes.Annuaire.User.Contacts
  ( module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
3
  , annuaireUserLayout
4 5
  , userLayout )
  where
6

7
import DOM.Simple.Console (log2)
8
import Data.Lens as L
9
import Data.Maybe (Maybe(..), fromMaybe)
10
import Data.Tuple (Tuple(..), fst, snd)
11
import Data.Tuple.Nested ((/\))
12
import Effect (Effect)
13
import Effect.Aff (Aff, launchAff_)
14
import Effect.Class (liftEffect)
15 16 17
import Reactix as R
import Reactix.DOM.HTML as H

18
import Gargantext.AsyncTasks as GAT
19
import Gargantext.Components.InputWithEnter (inputWithEnter)
20
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
21
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)
22
import Gargantext.Components.Nodes.Lists.Types as LT
23
import Gargantext.Components.Nodes.Texts.Types as TT
24
import Gargantext.Ends (Frontends)
25
import Gargantext.Hooks.Loader (useLoader)
26
import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (+), (<$>), (<<<), (<>), (==))
27
import Gargantext.Routes as Routes
28
import Gargantext.Sessions (Session, get, put, sessionId)
29
import Gargantext.Types (NodeType(..), ReloadS)
30
import Gargantext.Utils.Reactix as R2
31

32
thisModule :: String
33
thisModule = "Gargantext.Components.Nodes.Annuaire.User.Contacts"
34

35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
type DisplayProps = (
  title :: String
  )

display :: R2.Component DisplayProps
display = R.createElement displayCpt

displayCpt :: R.Component DisplayProps
displayCpt = R.hooksComponentWithModule thisModule "display" cpt
  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
              ]]]]
59 60

-- | TODO format data in better design (UI) shape
61 62
contactInfos :: HyperdataUser -> (HyperdataUser -> Effect Unit) -> Array R.Element
contactInfos h onUpdateHyperdata = item <$> contactInfoItems
63
  where
64
    item {label, defaultVal, lens} =
65 66 67
      contactInfoItem { hyperdata: h
                      , label
                      , lens
68 69
                      , onUpdateHyperdata
                      , placeholder: defaultVal }
70

71
contactInfoItems :: Array {label:: String, defaultVal:: String, lens:: HyperdataUserLens}
72
contactInfoItems =
73 74 75
  [ {label: "Last Name"    , defaultVal: "Empty Last Name"    , lens: _shared <<< _who     <<< _lastName             }
  , {label: "First Name"   , defaultVal: "Empty First Name"   , lens: _shared <<< _who     <<< _firstName            }
  , {label: "Organisation" , defaultVal: "Empty Organisation" , lens: _shared <<< _ouFirst <<< _organizationJoinComma}
76
  , {label: "Lab/Team/Dept", defaultVal: "Empty Lab/Team/Dept", lens: _shared <<< _ouFirst <<< _labTeamDeptsJoinComma}
77 78 79 80 81 82 83
  , {label: "Office"       , defaultVal: "Empty Office"       , lens: _shared <<< _ouFirst <<< _office               }
  , {label: "City"         , defaultVal: "Empty City"         , lens: _shared <<< _ouFirst <<< _city                 }
  , {label: "Country"      , defaultVal: "Empty Country"      , lens: _shared <<< _ouFirst <<< _country              }
  , {label: "Role"         , defaultVal: "Empty Role"         , lens: _shared <<< _ouFirst <<< _role                 }
  , {label: "Phone"        , defaultVal: "Empty Phone"        , lens: _shared <<< _ouFirst <<< _touch <<< _phone     }
  , {label: "Mail"         , defaultVal: "Empty Mail"         , lens: _shared <<< _ouFirst <<< _touch <<< _mail      }
  ]
84

85
type HyperdataUserLens = L.ALens' HyperdataUser String
86 87

type ContactInfoItemProps =
88
  ( hyperdata :: HyperdataUser
89
  , label :: String
90 91
  , lens :: HyperdataUserLens
  , onUpdateHyperdata :: HyperdataUser -> Effect Unit
92
  , placeholder :: String
93 94 95 96 97 98
  )

contactInfoItem :: Record ContactInfoItemProps -> R.Element
contactInfoItem props = R.createElement contactInfoItemCpt props []

contactInfoItemCpt :: R.Component ContactInfoItemProps
99
contactInfoItemCpt = R.hooksComponentWithModule thisModule "contactInfoItem" cpt
100
  where
101
    cpt {hyperdata, label, lens, onUpdateHyperdata, placeholder} _ = do
102
      isEditing <- R.useState' false
103
      let value = (L.view cLens hyperdata) :: String
104 105 106
      valueRef <- R.useRef value

      pure $ H.li { className: "list-group-item" } [
107 108
          H.span { className: "badge badge-default badge-pill"} [ H.text label ]
        , item isEditing valueRef
109 110
      ]
      where
111
        cLens = L.cloneLens lens
112 113 114 115 116
        usePlaceholder valueRef =
          if R.readRef valueRef == "" then
            Tuple true placeholder
          else
            Tuple false $ R.readRef valueRef
117 118
        item (false /\ setIsEditing) valueRef =
          H.span {} [
119 120 121
              H.span { className: if (fst $ usePlaceholder valueRef) then "text-muted" else "" } [
                H.text $ snd $ usePlaceholder valueRef
              ]
122 123 124 125 126 127 128
            , H.span { className: "fa fa-pencil"
                     , on: {click: onClick} } []
          ]
          where
            onClick _ = setIsEditing $ const true
        item (true /\ setIsEditing) valueRef =
          H.span {} [
129 130 131 132 133 134 135 136 137
              inputWithEnter {
                  onEnter: onClick
                , onValueChanged: R.setRef valueRef
                , autoFocus: true
                , className: "form-control"
                , defaultValue: R.readRef valueRef
                , placeholder
                , type: "text"
                }
138 139 140 141 142 143
            , H.span { className: "fa fa-floppy-o"
                     , on: {click: onClick} } []
          ]
          where
            onClick _ = do
              setIsEditing $ const false
144 145
              let newHyperdata = (L.over cLens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataUser
              onUpdateHyperdata newHyperdata
146

147 148 149 150 151 152 153 154 155 156 157
listInfo :: Tuple String String -> R.Element
listInfo s = listElement $ infoRender s

listElement :: Array R.Element -> R.Element
listElement = H.li { className: "list-group-item justify-content-between" }

infoRender :: Tuple String String -> Array R.Element
infoRender (Tuple title content) =
  [ H.span { className: "badge badge-default badge-pill"} [ H.text title ]
  , H.span {} [H.text content] ]

158
type LayoutProps = (
159
    appReload     :: ReloadS
160
  , asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
161 162 163
  , frontends     :: Frontends
  , nodeId        :: Int
  , session       :: Session
164
  , treeReloadRef :: R.Ref (Maybe ReloadS)
165
  )
166

167 168 169 170
type KeyLayoutProps = (
    key :: String
  | LayoutProps
  )
171 172 173 174 175

userLayout :: Record LayoutProps -> R.Element
userLayout props = R.createElement userLayoutCpt props []

userLayoutCpt :: R.Component LayoutProps
176
userLayoutCpt = R.hooksComponentWithModule thisModule "userLayout" cpt
177
  where
178
    cpt { appReload, asyncTasksRef, frontends, nodeId, session, treeReloadRef } _ = do
179 180
      let sid = sessionId session

181 182 183 184 185 186 187
      pure $ userLayoutWithKey {
          appReload
        , asyncTasksRef
        , frontends
        , key: show sid <> "-" <> show nodeId
        , nodeId
        , session
188
        , treeReloadRef
189
        }
190 191 192 193 194

userLayoutWithKey :: Record KeyLayoutProps -> R.Element
userLayoutWithKey props = R.createElement userLayoutWithKeyCpt props []

userLayoutWithKeyCpt :: R.Component KeyLayoutProps
195
userLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "userLayoutWithKey" cpt
196
  where
197
    cpt { appReload, asyncTasksRef, frontends, nodeId, session, treeReloadRef } _ = do
198 199
      reload <- R.useState' 0

200
      cacheState <- R.useState' LT.CacheOn
201

202
      sidePanelTriggers <- LT.emptySidePanelTriggers
203

204
      useLoader {nodeId, reload: fst reload, session} getContactWithReload $
205
        \contactData@{contactNode: Contact {name, hyperdata}} ->
206
          H.ul { className: "col-md-12 list-group" } [
207
            display { title: fromMaybe "no name" name } (contactInfos hyperdata (onUpdateHyperdata reload))
208 209 210 211 212 213 214 215
          , Tabs.tabs {
                 appReload
               , asyncTasksRef
               , cacheState
               , contactData
               , frontends
               , nodeId
               , session
216
               , sidePanelTriggers
217
               , treeReloadRef
218
               }
219
          ]
220
      where
221
        onUpdateHyperdata :: ReloadS -> HyperdataUser -> Effect Unit
222
        onUpdateHyperdata (_ /\ setReload) hd = do
223
          launchAff_ $ do
224 225
            _ <- saveContactHyperdata session nodeId hd
            liftEffect $ setReload $ (+) 1
226

227
-- | toUrl to get data
228 229
getContact :: Session -> Int -> Aff ContactData
getContact session id = do
230
  contactNode <- get session $ Routes.NodeAPI Node (Just id) ""
231 232 233 234 235 236 237 238 239
  -- 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, defaultListId: 424242}

240 241 242
getContactWithReload :: {nodeId :: Int, reload :: Int, session :: Session} -> Aff ContactData
getContactWithReload {nodeId, session} = getContact session nodeId

243 244 245 246
saveContactHyperdata :: Session -> Int -> HyperdataUser -> Aff Int
saveContactHyperdata session id h = do
  put session (Routes.NodeAPI Node (Just id) "") h

247

248 249
type AnnuaireLayoutProps = (
    annuaireId :: Int
250 251 252 253 254 255 256
  | LayoutProps )


annuaireUserLayout :: Record AnnuaireLayoutProps -> R.Element
annuaireUserLayout props = R.createElement annuaireUserLayoutCpt props []

annuaireUserLayoutCpt :: R.Component AnnuaireLayoutProps
257
annuaireUserLayoutCpt = R.hooksComponentWithModule thisModule "annuaireUserLayout" cpt
258
  where
259
    cpt { annuaireId, appReload, asyncTasksRef, frontends, nodeId, session, treeReloadRef } _ = do
260
      cacheState <- R.useState' LT.CacheOn
261

262
      sidePanelTriggers <- LT.emptySidePanelTriggers
263

264 265
      useLoader nodeId (getAnnuaireContact session annuaireId) $
        \contactData@{contactNode: Contact {name, hyperdata}} ->
266
          H.ul { className: "col-md-12 list-group" } [
267
            display { title: fromMaybe "no name" name } (contactInfos hyperdata onUpdateHyperdata)
268 269 270 271 272 273 274 275
          , Tabs.tabs {
                 appReload
               , asyncTasksRef
               , cacheState
               , contactData
               , frontends
               , nodeId
               , session
276
               , sidePanelTriggers
277
               , treeReloadRef
278 279
               }
          ]
280

281 282 283 284
      where
        onUpdateHyperdata :: HyperdataUser -> Effect Unit
        onUpdateHyperdata _ = pure unit

285 286
getAnnuaireContact :: Session -> Int -> Int -> Aff ContactData
getAnnuaireContact session annuaireId id = do
287
  contactNode <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ "contact/" <> (show id)
288 289 290 291 292 293 294 295
  -- 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, defaultListId: 424242}