Contacts.purs 10.2 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 18
import Reactix as R
import Reactix.DOM.HTML as H

import Gargantext.Components.InputWithEnter (inputWithEnter)
19
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
20 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)
import Gargantext.Ends (Frontends)
22
import Gargantext.Hooks.Loader (useLoader)
23
import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (+), (<$>), (<<<), (<>), (==))
24
import Gargantext.Routes as Routes
25
import Gargantext.Sessions (Session, get, put, sessionId)
26
import Gargantext.Types (NodeType(..))
27
import Gargantext.Utils.Reactix as R2
28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45

display :: String -> Array R.Element -> R.Element
display title elems =
  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"} elems
        ]]]]

-- | TODO format data in better design (UI) shape
46 47
contactInfos :: HyperdataUser -> (HyperdataUser -> Effect Unit) -> Array R.Element
contactInfos h onUpdateHyperdata = item <$> contactInfoItems
48
  where
49
    item {label, defaultVal, lens} =
50 51 52
      contactInfoItem { hyperdata: h
                      , label
                      , lens
53 54
                      , onUpdateHyperdata
                      , placeholder: defaultVal }
55

56
contactInfoItems :: Array {label:: String, defaultVal:: String, lens:: HyperdataUserLens}
57
contactInfoItems =
58 59 60
  [ {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}
61
  , {label: "Lab/Team/Dept", defaultVal: "Empty Lab/Team/Dept", lens: _shared <<< _ouFirst <<< _labTeamDeptsJoinComma}
62 63 64 65 66 67 68
  , {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      }
  ]
69

70
type HyperdataUserLens = L.ALens' HyperdataUser String
71 72

type ContactInfoItemProps =
73
  ( hyperdata :: HyperdataUser
74
  , label :: String
75 76
  , lens :: HyperdataUserLens
  , onUpdateHyperdata :: HyperdataUser -> Effect Unit
77
  , placeholder :: String
78 79 80 81 82 83 84 85
  )

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

contactInfoItemCpt :: R.Component ContactInfoItemProps
contactInfoItemCpt = R.hooksComponent "G.C.N.A.U.C.contactInfoItem" cpt
  where
86
    cpt {hyperdata, label, lens, onUpdateHyperdata, placeholder} _ = do
87
      isEditing <- R.useState' false
88
      let value = (L.view cLens hyperdata) :: String
89 90 91
      valueRef <- R.useRef value

      pure $ H.li { className: "list-group-item" } [
92 93
          H.span { className: "badge badge-default badge-pill"} [ H.text label ]
        , item isEditing valueRef
94 95
      ]
      where
96
        cLens = L.cloneLens lens
97 98 99 100 101
        usePlaceholder valueRef =
          if R.readRef valueRef == "" then
            Tuple true placeholder
          else
            Tuple false $ R.readRef valueRef
102 103
        item (false /\ setIsEditing) valueRef =
          H.span {} [
104 105 106
              H.span { className: if (fst $ usePlaceholder valueRef) then "text-muted" else "" } [
                H.text $ snd $ usePlaceholder valueRef
              ]
107 108 109 110 111 112 113
            , H.span { className: "fa fa-pencil"
                     , on: {click: onClick} } []
          ]
          where
            onClick _ = setIsEditing $ const true
        item (true /\ setIsEditing) valueRef =
          H.span {} [
114 115 116 117 118 119 120 121 122
              inputWithEnter {
                  onEnter: onClick
                , onValueChanged: R.setRef valueRef
                , autoFocus: true
                , className: "form-control"
                , defaultValue: R.readRef valueRef
                , placeholder
                , type: "text"
                }
123 124 125 126 127 128
            , H.span { className: "fa fa-floppy-o"
                     , on: {click: onClick} } []
          ]
          where
            onClick _ = do
              setIsEditing $ const false
129 130
              let newHyperdata = (L.over cLens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataUser
              onUpdateHyperdata newHyperdata
131

132 133 134 135 136 137 138 139 140 141 142
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] ]

143 144 145 146 147
type LayoutProps = (
    frontends :: Frontends
  , nodeId :: Int
  , session :: Session
  )
148

149 150 151 152
type KeyLayoutProps = (
    key :: String
  | LayoutProps
  )
153 154 155 156 157

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

userLayoutCpt :: R.Component LayoutProps
158 159 160 161 162 163 164 165 166 167 168 169
userLayoutCpt = R.hooksComponent "G.C.N.A.U.C.userLayout" cpt
  where
    cpt { frontends, nodeId, session } _ = do
      let sid = sessionId session

      pure $ userLayoutWithKey { frontends, key: show sid <> "-" <> show nodeId, nodeId, session }

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

userLayoutWithKeyCpt :: R.Component KeyLayoutProps
userLayoutWithKeyCpt = R.hooksComponent "G.C.N.A.U.C.userLayoutWithKey" cpt
170
  where
171
    cpt { frontends, nodeId, session } _ = do
172 173 174
      reload <- R.useState' 0

      useLoader {nodeId, reload: fst reload, session} getContactWithReload $
175 176
        \contactData@{contactNode: Contact {name, hyperdata}} ->
          H.ul { className: "col-md-12 list-group" }
177
          [ display (fromMaybe "no name" name) (contactInfos hyperdata (onUpdateHyperdata reload))
James Laver's avatar
James Laver committed
178
          , Tabs.tabs {frontends, nodeId, contactData, session} ]
179

180
      where
181 182
        onUpdateHyperdata :: R.State Int -> HyperdataUser -> Effect Unit
        onUpdateHyperdata (_ /\ setReload) hd = do
183
          log2 "[onUpdateHyperdata] hd" hd
184
          launchAff_ $ do
185 186
            _ <- saveContactHyperdata session nodeId hd
            liftEffect $ setReload $ (+) 1
187

188
-- | toUrl to get data
189 190
getContact :: Session -> Int -> Aff ContactData
getContact session id = do
191
  contactNode <- get session $ Routes.NodeAPI Node (Just id) ""
192 193 194 195 196 197 198 199 200
  -- 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}

201 202 203
getContactWithReload :: {nodeId :: Int, reload :: Int, session :: Session} -> Aff ContactData
getContactWithReload {nodeId, session} = getContact session nodeId

204 205 206 207
saveContactHyperdata :: Session -> Int -> HyperdataUser -> Aff Int
saveContactHyperdata session id h = do
  put session (Routes.NodeAPI Node (Just id) "") h

208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223

type AnnuaireLayoutProps =
  ( annuaireId :: Int
  | LayoutProps )


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

annuaireUserLayoutCpt :: R.Component AnnuaireLayoutProps
annuaireUserLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.annuaireUserLayout" cpt
  where
    cpt {annuaireId, frontends, nodeId, session} _ = do
      useLoader nodeId (getAnnuaireContact session annuaireId) $
        \contactData@{contactNode: Contact {name, hyperdata}} ->
          H.ul { className: "col-md-12 list-group" }
224
          [ display (fromMaybe "no name" name) (contactInfos hyperdata onUpdateHyperdata)
225 226
          , Tabs.tabs {frontends, nodeId, contactData, session} ]

227 228 229 230
      where
        onUpdateHyperdata :: HyperdataUser -> Effect Unit
        onUpdateHyperdata _ = pure unit

231 232
getAnnuaireContact :: Session -> Int -> Int -> Aff ContactData
getAnnuaireContact session annuaireId id = do
233
  contactNode <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ "contact/" <> (show id)
234 235 236 237 238 239 240 241
  -- 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}