Commit 29887531 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[user] user edit page works now, with lenses

parent 0c2ecf5b
......@@ -13,7 +13,7 @@ import Data.Newtype (unwrap)
import Data.String (joinWith)
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Aff (Aff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -23,7 +23,7 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session, get)
import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2
......@@ -43,112 +43,30 @@ display title elems =
, H.div { className: "col-md-8"} elems
]]]]
getFirstName :: Maybe ContactWho -> String
getFirstName obj = fromMaybe "Empty title" $ getFirstName' <$> obj
getFirstName' = fromMaybe "Empty first name" <<< _.firstName <<< unwrap
getLastName obj = fromMaybe "Empty title" $ getLastName' <$> obj
getLastName' = fromMaybe "Empty last name" <<< _.lastName <<< unwrap
-- | ContactWhere infos
-- TODO factor below
getRole :: Array ContactWhere -> String
getRole = maybe "Empty Contact-Where" getRole' <<< head
where
getRole' = fromMaybe "Empty Role" <<< _.role <<< unwrap
getOrga :: Array ContactWhere -> String
getOrga = maybe "Emtpy Contact-Where" getOrga' <<< head
where
getOrga' :: ContactWhere -> String
getOrga' obj = joinWith ", " $ (\(ContactWhere {organization: o}) ->o) obj
getDept :: Array ContactWhere -> String
getDept = maybe "Empty Department" getDept' <<< head
where
getDept' :: ContactWhere -> String
getDept' obj = joinWith ", " $ (\(ContactWhere {labTeamDepts: l}) ->l) obj
getOffice :: Array ContactWhere -> String
getOffice = fromMaybe "Empty Office"
<<< maybe Nothing (\(ContactWhere {office:x}) -> x)
<<< head
getCity :: Array ContactWhere -> String
getCity = fromMaybe "Empty City"
<<< maybe Nothing (\(ContactWhere {city:x}) -> x)
<<< head
getCountry :: Array ContactWhere -> String
getCountry = fromMaybe "Empty Country"
<<< maybe Nothing (\(ContactWhere {country:x}) -> x)
<<< head
-- | ContactWhere / Touch infos
getTouch :: Array ContactWhere -> Maybe ContactTouch
getTouch = maybe Nothing (\(ContactWhere {touch}) -> touch) <<< head
getPhone :: Array ContactWhere -> String
getPhone obj = fromMaybe "Empty touch info" $ getPhone' <$> (getTouch obj)
getPhone' :: ContactTouch -> String
getPhone' = fromMaybe "Empty phone" <<< _.phone <<< unwrap
getMail :: Array ContactWhere -> String
getMail obj = fromMaybe "Empty info" $ getMail' <$> (getTouch obj)
getMail' :: ContactTouch -> String
getMail' = fromMaybe "Empty mail" <<< _.mail <<< unwrap
-- | TODO format data in better design (UI) shape
contactInfos :: HyperdataUser -> (HyperdataUser -> Effect Unit) -> Array R.Element
contactInfos h onUpdateHyperdata = item <$> contactInfoItems
where
item (label /\ defaultVal /\ lens) =
item {label, defaultVal, lens} =
contactInfoItem { hyperdata: h
, label
, lens
, onUpdateHyperdata }
-- item (name /\ value) =
-- H.li { className: "list-group-item" }
-- (infoRender (name /\ (" " <> value)))
, onUpdateHyperdata
, placeholder: defaultVal }
contactInfoItems :: Array (Tuple3 String String HyperdataUserLens)
contactInfoItems :: Array {label:: String, defaultVal:: String, lens:: 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"
, "First Name" /\ "Empty First Name"
, "Organisation" /\ "Empty Organisation"
, "Lab/Team/Dept" /\ "Empty Lab/Team/Dept"
, "Office" /\ "Empty Office"
, "City" /\ "Empty City"
, "Country" /\ "Empty Country"
, "Role" /\ "Empty Role"
, "Phone" /\ "Empty Phone"
, "Mail" /\ "Empty Mail" ]
contactInfoItems' (Just (HyperdataContact {who:who, ou:ou})) =
[ "Last Name" /\ getLastName who
, "First Name" /\ getFirstName who
, "Organisation" /\ getOrga ou
, "Lab/Team/Dept" /\ getOrga ou
, "Office" /\ getOffice ou
, "City" /\ getCity ou
, "Country" /\ getCountry ou
, "Role" /\ getRole ou
, "Phone" /\ getPhone ou
, "Mail" /\ getMail ou ]
[ {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} ]
--type HyperdataUserLens = L.Lens' HyperdataUser String
type HyperdataUserLens = L.ALens' HyperdataUser String
type ContactInfoItemProps =
......@@ -157,16 +75,16 @@ type ContactInfoItemProps =
, label :: String
, lens :: HyperdataUserLens
, onUpdateHyperdata :: HyperdataUser -> Effect Unit
, placeholder :: String
)
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, label, lens, onUpdateHyperdata} _ = do
cpt {hyperdata, label, lens, onUpdateHyperdata, placeholder} _ = do
isEditing <- R.useState' false
let value = (L.view cLens hyperdata) :: String
valueRef <- R.useRef value
......@@ -177,9 +95,16 @@ contactInfoItemCpt = R.hooksComponent "G.C.N.A.U.C.contactInfoItem" cpt
]
where
cLens = L.cloneLens lens
usePlaceholder valueRef =
if R.readRef valueRef == "" then
Tuple true placeholder
else
Tuple false $ R.readRef valueRef
item (false /\ setIsEditing) valueRef =
H.span {} [
H.text $ R.readRef valueRef
H.span { className: if (fst $ usePlaceholder valueRef) then "text-muted" else "" } [
H.text $ snd $ usePlaceholder valueRef
]
, H.span { className: "fa fa-pencil"
, on: {click: onClick} } []
]
......@@ -189,7 +114,8 @@ contactInfoItemCpt = R.hooksComponent "G.C.N.A.U.C.contactInfoItem" cpt
H.span {} [
H.input { className: "form-control"
, defaultValue: R.readRef valueRef
, on: {change: \e -> R.setRef valueRef $ R2.unsafeEventValue e} }
, on: {change: \e -> R.setRef valueRef $ R2.unsafeEventValue e}
, placeholder }
, H.span { className: "fa fa-floppy-o"
, on: {click: onClick} } []
]
......@@ -229,6 +155,8 @@ userLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.userLayout" c
onUpdateHyperdata :: HyperdataUser -> Effect Unit
onUpdateHyperdata hd = do
log2 "[onUpdateHyperdata] hd" hd
launchAff_ $ do
saveContactHyperdata session nodeId hd
-- | toUrl to get data
getContact :: Session -> Int -> Aff ContactData
......@@ -243,6 +171,10 @@ getContact session id = do
-- throwError $ error "Missing default list"
pure {contactNode, defaultListId: 424242}
saveContactHyperdata :: Session -> Int -> HyperdataUser -> Aff Int
saveContactHyperdata session id h = do
put session (Routes.NodeAPI Node (Just id) "") h
type AnnuaireLayoutProps =
( annuaireId :: Int
......
......@@ -2,11 +2,12 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where
import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:!))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (.:!), (.:?), (:=), (~>), jsonEmptyObject)
import Data.Array as A
import Data.Lens
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Map (Map)
import Data.String as S
import Data.Tuple (Tuple(..))
import Gargantext.Utils.DecodeMaybe ((.?|))
import Data.Newtype (class Newtype)
......@@ -15,12 +16,33 @@ import Data.Newtype (class Newtype)
newtype Contact =
Contact
{ id :: Int
, typename :: Maybe Int
, userId :: Maybe Int
, parentId :: Maybe Int
, name :: Maybe String
, date :: Maybe String
, hyperdata :: HyperdataUser
, name :: Maybe String
, parentId :: Maybe Int
, typename :: Maybe Int
, userId :: Maybe Int
}
instance decodeUser :: DecodeJson Contact where
decodeJson json = do
obj <- decodeJson json
date <- obj .?| "date"
hyperdata <- obj .: "hyperdata"
id <- obj .: "id"
name <- obj .:! "name"
parentId <- obj .?| "parentId"
typename <- obj .?| "typename"
userId <- obj .:! "userId"
pure $ Contact {
id
, date
, hyperdata
, name
, parentId
, typename
, userId
}
derive instance newtypeContact :: Newtype Contact _
......@@ -39,9 +61,9 @@ instance decodeContactWho :: DecodeJson ContactWho
where
decodeJson json = do
obj <- decodeJson json
idWho <- obj .:! "id"
firstName <- obj .:! "firstName"
lastName <- obj .:! "lastName"
idWho <- obj .:? "id"
firstName <- obj .:? "firstName"
lastName <- obj .:? "lastName"
keywords <- obj .:! "keywords"
freetags <- obj .:! "freetags"
......@@ -50,6 +72,16 @@ instance decodeContactWho :: DecodeJson ContactWho
pure $ ContactWho {idWho, firstName, lastName, keywords:k, freetags:f}
instance encodeContactWho :: EncodeJson ContactWho
where
encodeJson (ContactWho cw) =
"id" := cw.idWho
~> "firstName" := cw.firstName
~> "lastName" := cw.lastName
~> "keywords" := cw.keywords
~> "freetags" := cw.freetags
~> jsonEmptyObject
defaultContactWho :: ContactWho
defaultContactWho =
ContactWho {
......@@ -84,19 +116,33 @@ instance decodeContactWhere :: DecodeJson ContactWhere
obj <- decodeJson json
organization <- obj .:! "organization"
labTeamDepts <- obj .:! "labTeamDepts"
role <- obj .:! "role"
office <- obj .:! "office"
country <- obj .:! "country"
city <- obj .:! "city"
touch <- obj .:! "touch"
entry <- obj .:! "entry"
exit <- obj .:! "exit"
role <- obj .:? "role"
office <- obj .:? "office"
country <- obj .:? "country"
city <- obj .:? "city"
touch <- obj .:? "touch"
entry <- obj .:? "entry"
exit <- obj .:? "exit"
let o = fromMaybe [] organization
let l = fromMaybe [] labTeamDepts
pure $ ContactWhere {organization:o, labTeamDepts:l, role, office, country, city, touch, entry, exit}
instance encodeContactWhere :: EncodeJson ContactWhere
where
encodeJson (ContactWhere cw) =
"city" := cw.city
~> "country" := cw.country
~> "entry" := cw.entry
~> "exit" := cw.exit
~> "labTeamDepts" := cw.labTeamDepts
~> "office" := cw.office
~> "organization" := cw.organization
~> "role" := cw.role
~> "touch" := cw.touch
~> jsonEmptyObject
defaultContactWhere :: ContactWhere
defaultContactWhere =
ContactWhere {
......@@ -123,39 +169,37 @@ instance decodeContactTouch :: DecodeJson ContactTouch
where
decodeJson json = do
obj <- decodeJson json
mail <- obj .:! "mail"
phone <- obj .:! "phone"
url <- obj .:! "url"
mail <- obj .:? "mail"
phone <- obj .:? "phone"
url <- obj .:? "url"
pure $ ContactTouch {mail, phone, url}
newtype HyperdataUser =
HyperdataUser { shared :: Maybe HyperdataContact }
derive instance newtypeHyperdataUser :: Newtype HyperdataUser _
instance decodeHyperdataUser :: DecodeJson HyperdataUser
instance encodeContactTouch :: EncodeJson ContactTouch
where
decodeJson json = do
obj <- decodeJson json
shared <- obj .:! "shared"
pure $ HyperdataUser { shared }
defaultHyperdataUser :: HyperdataUser
defaultHyperdataUser =
HyperdataUser {
shared: Just defaultHyperdataContact
encodeJson (ContactTouch ct) =
"mail" := ct.mail
~> "phone" := ct.phone
~> "url" := ct.url
~> jsonEmptyObject
defaultContactTouch :: ContactTouch
defaultContactTouch =
ContactTouch {
mail: Nothing
, phone: Nothing
, url: Nothing
}
newtype HyperdataContact =
HyperdataContact { bdd :: Maybe String
, who :: Maybe ContactWho
, lastValidation :: Maybe String
, ou :: (Array ContactWhere)
, title :: Maybe String
, source :: Maybe String
, lastValidation :: Maybe String
, title :: Maybe String
, uniqId :: Maybe String
, uniqIdBdd :: Maybe String
, who :: Maybe ContactWho
}
derive instance newtypeHyperdataContact :: Newtype HyperdataContact _
......@@ -163,19 +207,32 @@ instance decodeHyperdataContact :: DecodeJson HyperdataContact
where
decodeJson json = do
obj <- decodeJson json
bdd <- obj .:! "bdd"
who <- obj .:! "who"
bdd <- obj .:? "bdd"
lastValidation <- obj .:? "lastValidation"
ou <- obj .:! "where"
title <- obj .:! "title"
source <- obj .:! "source"
lastValidation <- obj .:! "lastValidation"
uniqId <- obj .:! "uniqId"
uniqIdBdd <- obj .:! "uniqIdBdd"
source <- obj .:? "source"
title <- obj .:? "title"
uniqId <- obj .:? "uniqId"
uniqIdBdd <- obj .:? "uniqIdBdd"
who <- obj .:? "who"
let ou' = fromMaybe [] ou
pure $ HyperdataContact {bdd, who, ou:ou', title, source, lastValidation, uniqId, uniqIdBdd}
instance encodeHyperdataContact :: EncodeJson HyperdataContact
where
encodeJson (HyperdataContact {bdd, lastValidation, ou, source, title, uniqId, uniqIdBdd, who}) =
"bdd" := bdd
~> "lastValidation" := lastValidation
~> "ou" := ou
~> "source" := source
~> "title" := title
~> "uniqId" := uniqId
~> "uniqIdBdd" := uniqIdBdd
~> "who" := who
~> jsonEmptyObject
defaultHyperdataContact :: HyperdataContact
defaultHyperdataContact =
HyperdataContact {
......@@ -190,6 +247,32 @@ defaultHyperdataContact =
}
newtype HyperdataUser =
HyperdataUser {
shared :: Maybe HyperdataContact
}
derive instance newtypeHyperdataUser :: Newtype HyperdataUser _
instance decodeHyperdataUser :: DecodeJson HyperdataUser
where
decodeJson json = do
obj <- decodeJson json
shared <- obj .:? "shared"
pure $ HyperdataUser { shared }
instance encodeHyperdataUser :: EncodeJson HyperdataUser
where
encodeJson (HyperdataUser {shared}) =
"shared" := shared
~> jsonEmptyObject
defaultHyperdataUser :: HyperdataUser
defaultHyperdataUser =
HyperdataUser {
shared: Just defaultHyperdataContact
}
-- newtype HyperData c s =
-- HyperData
-- { common :: c
......@@ -205,47 +288,82 @@ defaultHyperdataContact =
-- specific <- decodeJson json
-- pure $ HyperData {common, shared, specific}
instance decodeUser :: DecodeJson Contact where
decodeJson json = do
obj <- decodeJson json
id <- obj .: "id"
typename <- obj .?| "typename"
userId <- obj .:! "userId"
parentId <- obj .?| "parentId"
name <- obj .:! "name"
date <- obj .?| "date"
hyperdata <- obj .: "hyperdata"
pure $ Contact { id, typename, userId
, parentId, name, date
, hyperdata
}
type ContactData = {contactNode :: Contact, defaultListId :: Int}
_shared :: Lens' HyperdataUser HyperdataContact
_shared = lens getter setter
where
getter (HyperdataUser h@{shared}) = fromMaybe defaultHyperdataContact shared
setter (HyperdataUser h) c = HyperdataUser $ h { shared = Just c }
getter (HyperdataUser {shared}) = fromMaybe defaultHyperdataContact shared
setter (HyperdataUser h) val = HyperdataUser $ h { shared = Just val }
_who :: Lens' HyperdataContact ContactWho
_who = lens getter setter
where
getter (HyperdataContact hc@{who}) = fromMaybe defaultContactWho who
setter (HyperdataContact hc) w = HyperdataContact $ hc { who = Just w }
getter (HyperdataContact {who}) = fromMaybe defaultContactWho who
setter (HyperdataContact hc) val = HyperdataContact $ hc { who = Just val }
_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 }
getter (HyperdataContact {ou}) = fromMaybe defaultContactWhere $ A.head ou
setter (HyperdataContact hc@{ou}) val = HyperdataContact $ hc { ou = fromMaybe [val] $ A.updateAt 0 val ou }
_lastName :: Lens' ContactWho String
_lastName = lens getter setter
where
getter (ContactWho cw@{lastName}) = fromMaybe "" lastName
setter (ContactWho cw) ln = ContactWho $ cw { lastName = Just ln }
getter (ContactWho {lastName}) = fromMaybe "" lastName
setter (ContactWho cw) val = ContactWho $ cw { lastName = Just val }
_firstName :: Lens' ContactWho String
_firstName = lens getter setter
where
getter (ContactWho cw@{firstName}) = fromMaybe "" firstName
setter (ContactWho cw) fn = ContactWho $ cw { firstName = Just fn }
getter (ContactWho {firstName}) = fromMaybe "" firstName
setter (ContactWho cw) val = ContactWho $ cw { firstName = Just val }
_organizationJoinComma :: Lens' ContactWhere String
_organizationJoinComma = lens getter setter
where
getter (ContactWhere {organization}) = S.joinWith pattern organization
setter (ContactWhere cw) val = ContactWhere $ cw { organization = S.split (S.Pattern pattern) val }
pattern = ", "
_labTeamDeptsJoinComma :: Lens' ContactWhere String
_labTeamDeptsJoinComma = lens getter setter
where
getter (ContactWhere {labTeamDepts}) = S.joinWith pattern labTeamDepts
setter (ContactWhere cw) val = ContactWhere $ cw { labTeamDepts = S.split (S.Pattern pattern) val }
pattern = ", "
_office :: Lens' ContactWhere String
_office = lens getter setter
where
getter (ContactWhere {office}) = fromMaybe "" office
setter (ContactWhere cw) val = ContactWhere $ cw { office = Just val }
_city :: Lens' ContactWhere String
_city = lens getter setter
where
getter (ContactWhere {city}) = fromMaybe "" city
setter (ContactWhere cw) val = ContactWhere $ cw { city = Just val }
_country :: Lens' ContactWhere String
_country = lens getter setter
where
getter (ContactWhere {country}) = fromMaybe "" country
setter (ContactWhere cw) val = ContactWhere $ cw { country = Just val }
_role :: Lens' ContactWhere String
_role = lens getter setter
where
getter (ContactWhere {role}) = fromMaybe "" role
setter (ContactWhere cw) val = ContactWhere $ cw { role = Just val }
_touch :: Lens' ContactWhere ContactTouch
_touch = lens getter setter
where
getter (ContactWhere {touch}) = fromMaybe defaultContactTouch touch
setter (ContactWhere cw) val = ContactWhere $ cw { touch = Just val }
_mail :: Lens' ContactTouch String
_mail = lens getter setter
where
getter (ContactTouch {mail}) = fromMaybe "" mail
setter (ContactTouch ct) val = ContactTouch $ ct { mail = Just val }
_phone :: Lens' ContactTouch String
_phone = lens getter setter
where
getter (ContactTouch {phone}) = fromMaybe "" phone
setter (ContactTouch ct) val = ContactTouch $ ct { phone = Just val }
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