Commit c6e4a553 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-user-page' into dev

parents 37aa3098 86444f97
......@@ -4,16 +4,20 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts
, userLayout )
where
import Prelude (bind, pure, ($), (<<<), (<>), (<$>), show)
import Data.Array (head)
import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Tuple (Tuple(..))
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import Data.Newtype (unwrap)
import Data.String (joinWith)
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Hooks.Loader (useLoader)
......@@ -21,6 +25,7 @@ import Gargantext.Routes as Routes
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session, get)
import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2
display :: String -> Array R.Element -> R.Element
display title elems =
......@@ -81,7 +86,7 @@ getCountry = fromMaybe "Empty Country"
-- | ContactWhere / Touch infos
getTouch :: Array ContactWhere -> Maybe ContactTouch
getTouch = maybe Nothing (\(ContactWhere {touch:x}) -> x) <<< head
getTouch = maybe Nothing (\(ContactWhere {touch}) -> touch) <<< head
getPhone :: Array ContactWhere -> String
getPhone obj = fromMaybe "Empty touch info" $ getPhone' <$> (getTouch obj)
......@@ -94,12 +99,16 @@ getMail' :: ContactTouch -> String
getMail' = fromMaybe "Empty mail" <<< _.mail <<< unwrap
-- | TODO format data in better design (UI) shape
contactInfos :: HyperdataUser -> Array R.Element
contactInfos (HyperdataUser { shared }) = item <$> contactInfoItems shared
contactInfos :: HyperdataUser -> (HyperdataUser -> Effect Unit) -> Array R.Element
contactInfos h@(HyperdataUser { shared }) onUpdateHyperdata =
(item <$> contactInfoItems shared)
<> [ contactInfoItem {hyperdata: h, lens: _shared <<< _who <<< _lastName, onUpdateHyperdata} ]
where
item (name /\ value) =
H.li { className: "list-group-item" }
(infoRender (name /\ (" " <> value)))
contactInfoItems :: Maybe HyperdataContact -> Array (Tuple String String)
contactInfoItems Nothing =
[ "Last Name" /\ "Empty Last Name"
, "First Name" /\ "Empty First Name"
......@@ -123,6 +132,53 @@ contactInfoItems (Just (HyperdataContact {who:who, ou:ou})) =
, "Phone" /\ getPhone ou
, "Mail" /\ getMail ou ]
type HyperdataUserLens = L.Lens' HyperdataUser String
type ContactInfoItemProps =
(
hyperdata :: HyperdataUser
, lens :: HyperdataUserLens
, onUpdateHyperdata :: HyperdataUser -> Effect Unit
)
contactInfoItem :: Record ContactInfoItemProps -> R.Element
contactInfoItem props = R.createElement contactInfoItemCpt props []
contactInfoItemCpt :: R.Component ContactInfoItemProps
--contactInfoItemCpt :: forall r. R.Component ( lens :: L.Lens' HyperdataUser String | r )
contactInfoItemCpt = R.hooksComponent "G.C.N.A.U.C.contactInfoItem" cpt
where
cpt {hyperdata, lens, onUpdateHyperdata} _ = do
isEditing <- R.useState' false
let value = (L.view lens hyperdata) :: String
valueRef <- R.useRef value
pure $ H.li { className: "list-group-item" } [
item isEditing valueRef
]
where
item (false /\ setIsEditing) valueRef =
H.span {} [
H.text $ R.readRef valueRef
, H.span { className: "fa fa-pencil"
, on: {click: onClick} } []
]
where
onClick _ = setIsEditing $ const true
item (true /\ setIsEditing) valueRef =
H.span {} [
H.input { className: "form-control"
, defaultValue: R.readRef valueRef
, on: {change: \e -> R.setRef valueRef $ R2.unsafeEventValue e} }
, H.span { className: "fa fa-floppy-o"
, on: {click: onClick} } []
]
where
onClick _ = do
setIsEditing $ const false
-- let newHyperdata = (L.over lens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataUser
-- onUpdateHyperdata newHyperdata
listInfo :: Tuple String String -> R.Element
listInfo s = listElement $ infoRender s
......@@ -143,13 +199,17 @@ userLayoutCpt :: R.Component LayoutProps
userLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.userLayout" cpt
where
cpt {frontends, nodeId, session} _ = do
--loader nodeId (getContact session) $
useLoader nodeId (getContact session) $
\contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" }
[ display (fromMaybe "no name" name) (contactInfos hyperdata)
[ display (fromMaybe "no name" name) (contactInfos hyperdata onUpdateHyperdata)
, Tabs.tabs {frontends, nodeId, contactData, session} ]
where
onUpdateHyperdata :: HyperdataUser -> Effect Unit
onUpdateHyperdata hd = do
log2 "[onUpdateHyperdata] hd" hd
-- | toUrl to get data
getContact :: Session -> Int -> Aff ContactData
getContact session id = do
......@@ -179,9 +239,13 @@ annuaireUserLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.annua
useLoader nodeId (getAnnuaireContact session annuaireId) $
\contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" }
[ display (fromMaybe "no name" name) (contactInfos hyperdata)
[ display (fromMaybe "no name" name) (contactInfos hyperdata onUpdateHyperdata)
, Tabs.tabs {frontends, nodeId, contactData, session} ]
where
onUpdateHyperdata :: HyperdataUser -> Effect Unit
onUpdateHyperdata _ = pure unit
getAnnuaireContact :: Session -> Int -> Int -> Aff ContactData
getAnnuaireContact session annuaireId id = do
contactNode <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ "contact/" <> (show id)
......
......@@ -3,8 +3,10 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where
import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:!))
import Data.Maybe (Maybe, fromMaybe)
import Data.Lens
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Map (Map)
import Data.Tuple (Tuple(..))
import Gargantext.Utils.DecodeMaybe ((.?|))
import Data.Newtype (class Newtype)
......@@ -47,6 +49,16 @@ instance decodeContactWho :: DecodeJson ContactWho
pure $ ContactWho {idWho, firstName, lastName, keywords:k, freetags:f}
defaultContactWho :: ContactWho
defaultContactWho =
ContactWho {
idWho: Nothing
, firstName: Nothing
, lastName: Nothing
, keywords: []
, freetags: []
}
newtype ContactWhere =
ContactWhere
{ organization :: (Array String)
......@@ -113,6 +125,12 @@ instance decodeHyperdataUser :: DecodeJson HyperdataUser
shared <- obj .:! "shared"
pure $ HyperdataUser { shared }
defaultHyperdataUser :: HyperdataUser
defaultHyperdataUser =
HyperdataUser {
shared: Just defaultHyperdataContact
}
newtype HyperdataContact =
HyperdataContact { bdd :: Maybe String
......@@ -143,21 +161,34 @@ instance decodeHyperdataContact :: DecodeJson HyperdataContact
pure $ HyperdataContact {bdd, who, ou:ou', title, source, lastValidation, uniqId, uniqIdBdd}
newtype HyperData c s =
HyperData
{ common :: c
, shared :: s
, specific :: Map String String
}
instance decodeUserHyperData :: (DecodeJson c, DecodeJson s) =>
DecodeJson (HyperData c s) where
decodeJson json = do
common <- decodeJson json
shared <- decodeJson json
specific <- decodeJson json
pure $ HyperData {common, shared, specific}
defaultHyperdataContact :: HyperdataContact
defaultHyperdataContact =
HyperdataContact {
bdd: Nothing
, who: Nothing
, ou: []
, title: Nothing
, source: Nothing
, lastValidation: Nothing
, uniqId: Nothing
, uniqIdBdd: Nothing
}
-- newtype HyperData c s =
-- HyperData
-- { common :: c
-- , shared :: s
-- , specific :: Map String String
-- }
-- instance decodeUserHyperData :: (DecodeJson c, DecodeJson s) =>
-- DecodeJson (HyperData c s) where
-- decodeJson json = do
-- common <- decodeJson json
-- shared <- decodeJson json
-- specific <- decodeJson json
-- pure $ HyperData {common, shared, specific}
instance decodeUser :: DecodeJson Contact where
decodeJson json = do
......@@ -175,3 +206,23 @@ instance decodeUser :: DecodeJson Contact where
}
type ContactData = {contactNode :: Contact, defaultListId :: Int}
_shared :: Lens' HyperdataUser HyperdataContact
_shared = lens getter setter
where
getter (HyperdataUser h@{shared: Nothing}) = defaultHyperdataContact
getter (HyperdataUser h@{shared: Just shared'}) = shared'
setter (HyperdataUser h) c = HyperdataUser $ h { shared = Just c }
_who :: Lens' HyperdataContact ContactWho
_who = lens getter setter
where
getter (HyperdataContact hc@{who: Nothing}) = defaultContactWho
getter (HyperdataContact hc@{who: Just who'}) = who'
setter (HyperdataContact hc) w = HyperdataContact $ hc { who = Just w }
_lastName :: Lens' ContactWho String
_lastName = lens getter setter
where
getter (ContactWho cw@{lastName: Nothing}) = ""
getter (ContactWho cw@{lastName: Just ln}) = ln
setter (ContactWho cw) ln = ContactWho $ cw { lastName = Just ln }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment