Commit 0c2ecf5b authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[user] contacts page work with lenses

parent 86444f97
...@@ -8,7 +8,7 @@ import Data.Array (head) ...@@ -8,7 +8,7 @@ import Data.Array (head)
import Data.Lens as L import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe, maybe) import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Tuple (Tuple(..), fst, snd) import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested (Tuple3, (/\))
import Data.Newtype (unwrap) import Data.Newtype (unwrap)
import Data.String (joinWith) import Data.String (joinWith)
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
...@@ -100,16 +100,32 @@ getMail' = fromMaybe "Empty mail" <<< _.mail <<< unwrap ...@@ -100,16 +100,32 @@ getMail' = fromMaybe "Empty mail" <<< _.mail <<< unwrap
-- | TODO format data in better design (UI) shape -- | TODO format data in better design (UI) shape
contactInfos :: HyperdataUser -> (HyperdataUser -> Effect Unit) -> Array R.Element contactInfos :: HyperdataUser -> (HyperdataUser -> Effect Unit) -> Array R.Element
contactInfos h@(HyperdataUser { shared }) onUpdateHyperdata = contactInfos h onUpdateHyperdata = item <$> contactInfoItems
(item <$> contactInfoItems shared)
<> [ contactInfoItem {hyperdata: h, lens: _shared <<< _who <<< _lastName, onUpdateHyperdata} ]
where where
item (name /\ value) = item (label /\ defaultVal /\ lens) =
H.li { className: "list-group-item" } contactInfoItem { hyperdata: h
(infoRender (name /\ (" " <> value))) , label
, lens
contactInfoItems :: Maybe HyperdataContact -> Array (Tuple String String) , onUpdateHyperdata }
contactInfoItems Nothing =
-- item (name /\ value) =
-- H.li { className: "list-group-item" }
-- (infoRender (name /\ (" " <> value)))
contactInfoItems :: Array (Tuple3 String String HyperdataUserLens)
contactInfoItems =
[ "Last Name" /\ "Empty Last Name" /\ (_shared <<< _who <<< _lastName)
, "First Name" /\ "Empty First Name" /\ (_shared <<< _who <<< _firstName)
, "Organisation" /\ "Empty Organisation" /\ (_shared <<< _who <<< _lastName)
, "Lab/Team/Dept" /\ "Empty Lab/Team/Dept" /\ (_shared <<< _who <<< _lastName)
, "Office" /\ "Empty Office" /\ (_shared <<< _who <<< _lastName)
, "City" /\ "Empty City" /\ (_shared <<< _who <<< _lastName)
, "Country" /\ "Empty Country" /\ (_shared <<< _who <<< _lastName)
, "Role" /\ "Empty Role" /\ (_shared <<< _who <<< _lastName)
, "Phone" /\ "Empty Phone" /\ (_shared <<< _who <<< _lastName)
, "Mail" /\ "Empty Mail" /\ (_shared <<< _who <<< _lastName) ]
contactInfoItems' :: Maybe HyperdataContact -> Array (Tuple String String)
contactInfoItems' Nothing =
[ "Last Name" /\ "Empty Last Name" [ "Last Name" /\ "Empty Last Name"
, "First Name" /\ "Empty First Name" , "First Name" /\ "Empty First Name"
, "Organisation" /\ "Empty Organisation" , "Organisation" /\ "Empty Organisation"
...@@ -120,7 +136,7 @@ contactInfoItems Nothing = ...@@ -120,7 +136,7 @@ contactInfoItems Nothing =
, "Role" /\ "Empty Role" , "Role" /\ "Empty Role"
, "Phone" /\ "Empty Phone" , "Phone" /\ "Empty Phone"
, "Mail" /\ "Empty Mail" ] , "Mail" /\ "Empty Mail" ]
contactInfoItems (Just (HyperdataContact {who:who, ou:ou})) = contactInfoItems' (Just (HyperdataContact {who:who, ou:ou})) =
[ "Last Name" /\ getLastName who [ "Last Name" /\ getLastName who
, "First Name" /\ getFirstName who , "First Name" /\ getFirstName who
, "Organisation" /\ getOrga ou , "Organisation" /\ getOrga ou
...@@ -132,11 +148,13 @@ contactInfoItems (Just (HyperdataContact {who:who, ou:ou})) = ...@@ -132,11 +148,13 @@ 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 HyperdataUserLens = L.Lens' HyperdataUser String
type HyperdataUserLens = L.ALens' HyperdataUser String
type ContactInfoItemProps = type ContactInfoItemProps =
( (
hyperdata :: HyperdataUser hyperdata :: HyperdataUser
, label :: String
, lens :: HyperdataUserLens , lens :: HyperdataUserLens
, onUpdateHyperdata :: HyperdataUser -> Effect Unit , onUpdateHyperdata :: HyperdataUser -> Effect Unit
) )
...@@ -148,15 +166,17 @@ contactInfoItemCpt :: R.Component ContactInfoItemProps ...@@ -148,15 +166,17 @@ contactInfoItemCpt :: R.Component ContactInfoItemProps
--contactInfoItemCpt :: forall r. R.Component ( lens :: L.Lens' HyperdataUser String | r ) --contactInfoItemCpt :: forall r. R.Component ( lens :: L.Lens' HyperdataUser String | r )
contactInfoItemCpt = R.hooksComponent "G.C.N.A.U.C.contactInfoItem" cpt contactInfoItemCpt = R.hooksComponent "G.C.N.A.U.C.contactInfoItem" cpt
where where
cpt {hyperdata, lens, onUpdateHyperdata} _ = do cpt {hyperdata, label, lens, onUpdateHyperdata} _ = do
isEditing <- R.useState' false isEditing <- R.useState' false
let value = (L.view lens hyperdata) :: String let value = (L.view cLens hyperdata) :: String
valueRef <- R.useRef value valueRef <- R.useRef value
pure $ H.li { className: "list-group-item" } [ pure $ H.li { className: "list-group-item" } [
item isEditing valueRef H.span { className: "badge badge-default badge-pill"} [ H.text label ]
, item isEditing valueRef
] ]
where where
cLens = L.cloneLens lens
item (false /\ setIsEditing) valueRef = item (false /\ setIsEditing) valueRef =
H.span {} [ H.span {} [
H.text $ R.readRef valueRef H.text $ R.readRef valueRef
...@@ -176,8 +196,8 @@ contactInfoItemCpt = R.hooksComponent "G.C.N.A.U.C.contactInfoItem" cpt ...@@ -176,8 +196,8 @@ contactInfoItemCpt = R.hooksComponent "G.C.N.A.U.C.contactInfoItem" cpt
where where
onClick _ = do onClick _ = do
setIsEditing $ const false setIsEditing $ const false
-- let newHyperdata = (L.over lens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataUser let newHyperdata = (L.over cLens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataUser
-- onUpdateHyperdata newHyperdata onUpdateHyperdata newHyperdata
listInfo :: Tuple String String -> R.Element listInfo :: Tuple String String -> R.Element
listInfo s = listElement $ infoRender s listInfo s = listElement $ infoRender s
......
...@@ -3,6 +3,7 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where ...@@ -3,6 +3,7 @@ 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.Array as A
import Data.Lens import Data.Lens
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Map (Map) import Data.Map (Map)
...@@ -96,6 +97,20 @@ instance decodeContactWhere :: DecodeJson ContactWhere ...@@ -96,6 +97,20 @@ instance decodeContactWhere :: DecodeJson ContactWhere
pure $ ContactWhere {organization:o, labTeamDepts:l, role, office, country, city, touch, entry, exit} pure $ ContactWhere {organization:o, labTeamDepts:l, role, office, country, city, touch, entry, exit}
defaultContactWhere :: ContactWhere
defaultContactWhere =
ContactWhere {
organization: []
, labTeamDepts: []
, role: Nothing
, office: Nothing
, country: Nothing
, city: Nothing
, touch: Nothing
, entry: Nothing
, exit: Nothing
}
newtype ContactTouch = newtype ContactTouch =
ContactTouch ContactTouch
{ mail :: Maybe String { mail :: Maybe String
...@@ -210,19 +225,27 @@ type ContactData = {contactNode :: Contact, defaultListId :: Int} ...@@ -210,19 +225,27 @@ type ContactData = {contactNode :: Contact, defaultListId :: Int}
_shared :: Lens' HyperdataUser HyperdataContact _shared :: Lens' HyperdataUser HyperdataContact
_shared = lens getter setter _shared = lens getter setter
where where
getter (HyperdataUser h@{shared: Nothing}) = defaultHyperdataContact getter (HyperdataUser h@{shared}) = fromMaybe defaultHyperdataContact shared
getter (HyperdataUser h@{shared: Just shared'}) = shared'
setter (HyperdataUser h) c = HyperdataUser $ h { shared = Just c } setter (HyperdataUser h) c = HyperdataUser $ h { shared = Just c }
_who :: Lens' HyperdataContact ContactWho _who :: Lens' HyperdataContact ContactWho
_who = lens getter setter _who = lens getter setter
where where
getter (HyperdataContact hc@{who: Nothing}) = defaultContactWho getter (HyperdataContact hc@{who}) = fromMaybe defaultContactWho who
getter (HyperdataContact hc@{who: Just who'}) = who'
setter (HyperdataContact hc) w = HyperdataContact $ hc { who = Just w } setter (HyperdataContact hc) w = HyperdataContact $ hc { who = Just w }
_ouFirst :: Lens' HyperdataContact ContactWhere
_ouFirst = lens getter setter
where
getter (HyperdataContact hc@{ou}) = fromMaybe defaultContactWhere $ A.head ou
setter (HyperdataContact hc@{ou}) o = HyperdataContact $ hc { ou = fromMaybe [o] $ A.updateAt 0 o ou }
_lastName :: Lens' ContactWho String _lastName :: Lens' ContactWho String
_lastName = lens getter setter _lastName = lens getter setter
where where
getter (ContactWho cw@{lastName: Nothing}) = "" getter (ContactWho cw@{lastName}) = fromMaybe "" lastName
getter (ContactWho cw@{lastName: Just ln}) = ln
setter (ContactWho cw) ln = ContactWho $ cw { lastName = Just ln } setter (ContactWho cw) ln = ContactWho $ cw { lastName = Just ln }
_firstName :: Lens' ContactWho String
_firstName = lens getter setter
where
getter (ContactWho cw@{firstName}) = fromMaybe "" firstName
setter (ContactWho cw) fn = ContactWho $ cw { firstName = Just fn }
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