Commit 86444f97 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[user] try to use lenses for contact item

parent 3b8f6267
...@@ -4,16 +4,20 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts ...@@ -4,16 +4,20 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts
, userLayout ) , userLayout )
where where
import Prelude (bind, pure, ($), (<<<), (<>), (<$>), show)
import Data.Array (head) import Data.Array (head)
import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe, maybe) import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Data.Newtype (unwrap) import Data.Newtype (unwrap)
import Data.String (joinWith) import Data.String (joinWith)
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
...@@ -21,6 +25,7 @@ import Gargantext.Routes as Routes ...@@ -21,6 +25,7 @@ import Gargantext.Routes as Routes
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2
display :: String -> Array R.Element -> R.Element display :: String -> Array R.Element -> R.Element
display title elems = display title elems =
...@@ -81,7 +86,7 @@ getCountry = fromMaybe "Empty Country" ...@@ -81,7 +86,7 @@ getCountry = fromMaybe "Empty Country"
-- | ContactWhere / Touch infos -- | ContactWhere / Touch infos
getTouch :: Array ContactWhere -> Maybe ContactTouch 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 :: Array ContactWhere -> String
getPhone obj = fromMaybe "Empty touch info" $ getPhone' <$> (getTouch obj) getPhone obj = fromMaybe "Empty touch info" $ getPhone' <$> (getTouch obj)
...@@ -94,12 +99,16 @@ getMail' :: ContactTouch -> String ...@@ -94,12 +99,16 @@ getMail' :: ContactTouch -> String
getMail' = fromMaybe "Empty mail" <<< _.mail <<< unwrap getMail' = fromMaybe "Empty mail" <<< _.mail <<< unwrap
-- | TODO format data in better design (UI) shape -- | TODO format data in better design (UI) shape
contactInfos :: HyperdataUser -> Array R.Element contactInfos :: HyperdataUser -> (HyperdataUser -> Effect Unit) -> Array R.Element
contactInfos (HyperdataUser { shared }) = item <$> contactInfoItems shared contactInfos h@(HyperdataUser { shared }) onUpdateHyperdata =
(item <$> contactInfoItems shared)
<> [ contactInfoItem {hyperdata: h, lens: _shared <<< _who <<< _lastName, onUpdateHyperdata} ]
where where
item (name /\ value) = item (name /\ value) =
H.li { className: "list-group-item" } H.li { className: "list-group-item" }
(infoRender (name /\ (" " <> value))) (infoRender (name /\ (" " <> value)))
contactInfoItems :: Maybe HyperdataContact -> Array (Tuple String String)
contactInfoItems Nothing = contactInfoItems Nothing =
[ "Last Name" /\ "Empty Last Name" [ "Last Name" /\ "Empty Last Name"
, "First Name" /\ "Empty First Name" , "First Name" /\ "Empty First Name"
...@@ -123,6 +132,53 @@ contactInfoItems (Just (HyperdataContact {who:who, ou:ou})) = ...@@ -123,6 +132,53 @@ contactInfoItems (Just (HyperdataContact {who:who, ou:ou})) =
, "Phone" /\ getPhone ou , "Phone" /\ getPhone ou
, "Mail" /\ getMail 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 :: Tuple String String -> R.Element
listInfo s = listElement $ infoRender s listInfo s = listElement $ infoRender s
...@@ -143,13 +199,17 @@ userLayoutCpt :: R.Component LayoutProps ...@@ -143,13 +199,17 @@ userLayoutCpt :: R.Component LayoutProps
userLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.userLayout" cpt userLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.userLayout" cpt
where where
cpt {frontends, nodeId, session} _ = do cpt {frontends, nodeId, session} _ = do
--loader nodeId (getContact session) $
useLoader nodeId (getContact session) $ useLoader nodeId (getContact session) $
\contactData@{contactNode: Contact {name, hyperdata}} -> \contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" } 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} ] , Tabs.tabs {frontends, nodeId, contactData, session} ]
where
onUpdateHyperdata :: HyperdataUser -> Effect Unit
onUpdateHyperdata hd = do
log2 "[onUpdateHyperdata] hd" hd
-- | toUrl to get data -- | toUrl to get data
getContact :: Session -> Int -> Aff ContactData getContact :: Session -> Int -> Aff ContactData
getContact session id = do getContact session id = do
...@@ -179,9 +239,13 @@ annuaireUserLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.annua ...@@ -179,9 +239,13 @@ annuaireUserLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.annua
useLoader nodeId (getAnnuaireContact session annuaireId) $ useLoader nodeId (getAnnuaireContact session annuaireId) $
\contactData@{contactNode: Contact {name, hyperdata}} -> \contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" } 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} ] , Tabs.tabs {frontends, nodeId, contactData, session} ]
where
onUpdateHyperdata :: HyperdataUser -> Effect Unit
onUpdateHyperdata _ = pure unit
getAnnuaireContact :: Session -> Int -> Int -> Aff ContactData getAnnuaireContact :: Session -> Int -> Int -> Aff ContactData
getAnnuaireContact session annuaireId id = do getAnnuaireContact session annuaireId id = do
contactNode <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ "contact/" <> (show id) contactNode <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ "contact/" <> (show id)
......
...@@ -3,8 +3,10 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where ...@@ -3,8 +3,10 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where
import Prelude import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:!)) 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.Map (Map)
import Data.Tuple (Tuple(..))
import Gargantext.Utils.DecodeMaybe ((.?|)) import Gargantext.Utils.DecodeMaybe ((.?|))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
...@@ -47,6 +49,16 @@ instance decodeContactWho :: DecodeJson ContactWho ...@@ -47,6 +49,16 @@ instance decodeContactWho :: DecodeJson ContactWho
pure $ ContactWho {idWho, firstName, lastName, keywords:k, freetags:f} pure $ ContactWho {idWho, firstName, lastName, keywords:k, freetags:f}
defaultContactWho :: ContactWho
defaultContactWho =
ContactWho {
idWho: Nothing
, firstName: Nothing
, lastName: Nothing
, keywords: []
, freetags: []
}
newtype ContactWhere = newtype ContactWhere =
ContactWhere ContactWhere
{ organization :: (Array String) { organization :: (Array String)
...@@ -113,6 +125,12 @@ instance decodeHyperdataUser :: DecodeJson HyperdataUser ...@@ -113,6 +125,12 @@ instance decodeHyperdataUser :: DecodeJson HyperdataUser
shared <- obj .:! "shared" shared <- obj .:! "shared"
pure $ HyperdataUser { shared } pure $ HyperdataUser { shared }
defaultHyperdataUser :: HyperdataUser
defaultHyperdataUser =
HyperdataUser {
shared: Just defaultHyperdataContact
}
newtype HyperdataContact = newtype HyperdataContact =
HyperdataContact { bdd :: Maybe String HyperdataContact { bdd :: Maybe String
...@@ -143,21 +161,34 @@ instance decodeHyperdataContact :: DecodeJson HyperdataContact ...@@ -143,21 +161,34 @@ instance decodeHyperdataContact :: DecodeJson HyperdataContact
pure $ HyperdataContact {bdd, who, ou:ou', title, source, lastValidation, uniqId, uniqIdBdd} pure $ HyperdataContact {bdd, who, ou:ou', title, source, lastValidation, uniqId, uniqIdBdd}
defaultHyperdataContact :: HyperdataContact
newtype HyperData c s = defaultHyperdataContact =
HyperData HyperdataContact {
{ common :: c bdd: Nothing
, shared :: s , who: Nothing
, specific :: Map String String , ou: []
} , title: Nothing
, source: Nothing
instance decodeUserHyperData :: (DecodeJson c, DecodeJson s) => , lastValidation: Nothing
DecodeJson (HyperData c s) where , uniqId: Nothing
decodeJson json = do , uniqIdBdd: Nothing
common <- decodeJson json }
shared <- decodeJson json
specific <- decodeJson json
pure $ HyperData {common, shared, specific} -- 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 instance decodeUser :: DecodeJson Contact where
decodeJson json = do decodeJson json = do
...@@ -175,3 +206,23 @@ instance decodeUser :: DecodeJson Contact where ...@@ -175,3 +206,23 @@ instance decodeUser :: DecodeJson Contact where
} }
type ContactData = {contactNode :: Contact, defaultListId :: Int} 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