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

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

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
45 46
contactInfos :: HyperdataUser -> (HyperdataUser -> Effect Unit) -> Array R.Element
contactInfos h onUpdateHyperdata = item <$> contactInfoItems
47
  where
48
    item {label, defaultVal, lens} =
49 50 51
      contactInfoItem { hyperdata: h
                      , label
                      , lens
52 53
                      , onUpdateHyperdata
                      , placeholder: defaultVal }
54

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

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

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

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
85
    cpt {hyperdata, label, lens, onUpdateHyperdata, placeholder} _ = do
86
      isEditing <- R.useState' false
87
      let value = (L.view cLens hyperdata) :: String
88 89 90
      valueRef <- R.useRef value

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

127 128 129 130 131 132 133 134 135 136 137
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] ]

James Laver's avatar
James Laver committed
138
type LayoutProps = ( frontends :: Frontends, nodeId :: Int, session :: Session )
139 140 141 142 143

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

userLayoutCpt :: R.Component LayoutProps
144
userLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.userLayout" cpt
145
  where
146
    cpt {frontends, nodeId, session} _ = do
147 148 149
      reload <- R.useState' 0

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

155
      where
156 157
        onUpdateHyperdata :: R.State Int -> HyperdataUser -> Effect Unit
        onUpdateHyperdata (_ /\ setReload) hd = do
158
          log2 "[onUpdateHyperdata] hd" hd
159
          launchAff_ $ do
160 161
            _ <- saveContactHyperdata session nodeId hd
            liftEffect $ setReload $ (+) 1
162

163
-- | toUrl to get data
164 165
getContact :: Session -> Int -> Aff ContactData
getContact session id = do
166
  contactNode <- get session $ Routes.NodeAPI Node (Just id) ""
167 168 169 170 171 172 173 174 175
  -- 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}

176 177 178
getContactWithReload :: {nodeId :: Int, reload :: Int, session :: Session} -> Aff ContactData
getContactWithReload {nodeId, session} = getContact session nodeId

179 180 181 182
saveContactHyperdata :: Session -> Int -> HyperdataUser -> Aff Int
saveContactHyperdata session id h = do
  put session (Routes.NodeAPI Node (Just id) "") h

183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198

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" }
199
          [ display (fromMaybe "no name" name) (contactInfos hyperdata onUpdateHyperdata)
200 201
          , Tabs.tabs {frontends, nodeId, contactData, session} ]

202 203 204 205
      where
        onUpdateHyperdata :: HyperdataUser -> Effect Unit
        onUpdateHyperdata _ = pure unit

206 207
getAnnuaireContact :: Session -> Int -> Int -> Aff ContactData
getAnnuaireContact session annuaireId id = do
208
  contactNode <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ "contact/" <> (show id)
209 210 211 212 213 214 215 216
  -- 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}