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

Merge branch 'dev-user-page' into dev

parents c6e4a553 29887531
...@@ -8,12 +8,12 @@ import Data.Array (head) ...@@ -8,12 +8,12 @@ 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)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff, launchAff_)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
...@@ -23,7 +23,7 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs ...@@ -23,7 +23,7 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -43,123 +43,68 @@ display title elems = ...@@ -43,123 +43,68 @@ display title elems =
, H.div { className: "col-md-8"} 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 -- | 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 = , placeholder: defaultVal }
[ "Last Name" /\ "Empty Last Name"
, "First Name" /\ "Empty First Name" contactInfoItems :: Array {label:: String, defaultVal:: String, lens:: HyperdataUserLens}
, "Organisation" /\ "Empty Organisation" contactInfoItems =
, "Lab/Team/Dept" /\ "Empty Lab/Team/Dept" [ {label: "Last Name", defaultVal: "Empty Last Name", lens: _shared <<< _who <<< _lastName}
, "Office" /\ "Empty Office" , {label: "First Name", defaultVal: "Empty First Name", lens: _shared <<< _who <<< _firstName}
, "City" /\ "Empty City" , {label: "Organisation", defaultVal: "Empty Organisation", lens: _shared <<< _ouFirst <<< _organizationJoinComma}
, "Country" /\ "Empty Country" , {label: "Lab/Team/Dept", defaultVal: "Empty Lab/Team/Dept", lens: _shared <<< _ouFirst <<< _labTeamDeptsJoinComma}
, "Role" /\ "Empty Role" , {label: "Office", defaultVal: "Empty Office", lens: _shared <<< _ouFirst <<< _office}
, "Phone" /\ "Empty Phone" , {label: "City", defaultVal: "Empty City", lens: _shared <<< _ouFirst <<< _city}
, "Mail" /\ "Empty Mail" ] , {label: "Country", defaultVal: "Empty Country", lens: _shared <<< _ouFirst <<< _country}
contactInfoItems (Just (HyperdataContact {who:who, ou:ou})) = , {label: "Role", defaultVal: "Empty Role", lens: _shared <<< _ouFirst <<< _role}
[ "Last Name" /\ getLastName who , {label: "Phone", defaultVal: "Empty Phone", lens: _shared <<< _ouFirst <<< _touch <<< _phone}
, "First Name" /\ getFirstName who , {label: "Mail", defaultVal: "Empty Mail", lens: _shared <<< _ouFirst <<< _touch <<< _mail} ]
, "Organisation" /\ getOrga ou
, "Lab/Team/Dept" /\ getOrga ou type HyperdataUserLens = L.ALens' HyperdataUser String
, "Office" /\ getOffice ou
, "City" /\ getCity ou
, "Country" /\ getCountry ou
, "Role" /\ getRole ou
, "Phone" /\ getPhone ou
, "Mail" /\ getMail ou ]
type HyperdataUserLens = L.Lens' HyperdataUser String
type ContactInfoItemProps = type ContactInfoItemProps =
( (
hyperdata :: HyperdataUser hyperdata :: HyperdataUser
, label :: String
, lens :: HyperdataUserLens , lens :: HyperdataUserLens
, onUpdateHyperdata :: HyperdataUser -> Effect Unit , onUpdateHyperdata :: HyperdataUser -> Effect Unit
, placeholder :: String
) )
contactInfoItem :: Record ContactInfoItemProps -> R.Element contactInfoItem :: Record ContactInfoItemProps -> R.Element
contactInfoItem props = R.createElement contactInfoItemCpt props [] contactInfoItem props = R.createElement contactInfoItemCpt props []
contactInfoItemCpt :: R.Component ContactInfoItemProps 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 contactInfoItemCpt = R.hooksComponent "G.C.N.A.U.C.contactInfoItem" cpt
where where
cpt {hyperdata, lens, onUpdateHyperdata} _ = do cpt {hyperdata, label, lens, onUpdateHyperdata, placeholder} _ = 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
usePlaceholder valueRef =
if R.readRef valueRef == "" then
Tuple true placeholder
else
Tuple false $ R.readRef valueRef
item (false /\ setIsEditing) valueRef = item (false /\ setIsEditing) valueRef =
H.span {} [ 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" , H.span { className: "fa fa-pencil"
, on: {click: onClick} } [] , on: {click: onClick} } []
] ]
...@@ -169,15 +114,16 @@ contactInfoItemCpt = R.hooksComponent "G.C.N.A.U.C.contactInfoItem" cpt ...@@ -169,15 +114,16 @@ contactInfoItemCpt = R.hooksComponent "G.C.N.A.U.C.contactInfoItem" cpt
H.span {} [ H.span {} [
H.input { className: "form-control" H.input { className: "form-control"
, defaultValue: R.readRef valueRef , 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" , H.span { className: "fa fa-floppy-o"
, on: {click: onClick} } [] , on: {click: onClick} } []
] ]
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
...@@ -209,6 +155,8 @@ userLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.userLayout" c ...@@ -209,6 +155,8 @@ userLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.userLayout" c
onUpdateHyperdata :: HyperdataUser -> Effect Unit onUpdateHyperdata :: HyperdataUser -> Effect Unit
onUpdateHyperdata hd = do onUpdateHyperdata hd = do
log2 "[onUpdateHyperdata] hd" hd log2 "[onUpdateHyperdata] hd" hd
launchAff_ $ do
saveContactHyperdata session nodeId hd
-- | toUrl to get data -- | toUrl to get data
getContact :: Session -> Int -> Aff ContactData getContact :: Session -> Int -> Aff ContactData
...@@ -223,6 +171,10 @@ getContact session id = do ...@@ -223,6 +171,10 @@ getContact session id = do
-- throwError $ error "Missing default list" -- throwError $ error "Missing default list"
pure {contactNode, defaultListId: 424242} 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 = type AnnuaireLayoutProps =
( annuaireId :: Int ( annuaireId :: Int
......
...@@ -2,10 +2,12 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where ...@@ -2,10 +2,12 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where
import Prelude 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.Lens
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Map (Map) import Data.Map (Map)
import Data.String as S
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Gargantext.Utils.DecodeMaybe ((.?|)) import Gargantext.Utils.DecodeMaybe ((.?|))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
...@@ -14,14 +16,35 @@ import Data.Newtype (class Newtype) ...@@ -14,14 +16,35 @@ import Data.Newtype (class Newtype)
newtype Contact = newtype Contact =
Contact Contact
{ id :: Int { id :: Int
, typename :: Maybe Int
, userId :: Maybe Int
, parentId :: Maybe Int
, name :: Maybe String
, date :: Maybe String , date :: Maybe String
, hyperdata :: HyperdataUser , 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 _ derive instance newtypeContact :: Newtype Contact _
newtype ContactWho = newtype ContactWho =
...@@ -38,9 +61,9 @@ instance decodeContactWho :: DecodeJson ContactWho ...@@ -38,9 +61,9 @@ instance decodeContactWho :: DecodeJson ContactWho
where where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
idWho <- obj .:! "id" idWho <- obj .:? "id"
firstName <- obj .:! "firstName" firstName <- obj .:? "firstName"
lastName <- obj .:! "lastName" lastName <- obj .:? "lastName"
keywords <- obj .:! "keywords" keywords <- obj .:! "keywords"
freetags <- obj .:! "freetags" freetags <- obj .:! "freetags"
...@@ -49,6 +72,16 @@ instance decodeContactWho :: DecodeJson ContactWho ...@@ -49,6 +72,16 @@ instance decodeContactWho :: DecodeJson ContactWho
pure $ ContactWho {idWho, firstName, lastName, keywords:k, freetags:f} 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
defaultContactWho = defaultContactWho =
ContactWho { ContactWho {
...@@ -83,19 +116,47 @@ instance decodeContactWhere :: DecodeJson ContactWhere ...@@ -83,19 +116,47 @@ instance decodeContactWhere :: DecodeJson ContactWhere
obj <- decodeJson json obj <- decodeJson json
organization <- obj .:! "organization" organization <- obj .:! "organization"
labTeamDepts <- obj .:! "labTeamDepts" labTeamDepts <- obj .:! "labTeamDepts"
role <- obj .:! "role" role <- obj .:? "role"
office <- obj .:! "office" office <- obj .:? "office"
country <- obj .:! "country" country <- obj .:? "country"
city <- obj .:! "city" city <- obj .:? "city"
touch <- obj .:! "touch" touch <- obj .:? "touch"
entry <- obj .:! "entry" entry <- obj .:? "entry"
exit <- obj .:! "exit" exit <- obj .:? "exit"
let o = fromMaybe [] organization let o = fromMaybe [] organization
let l = fromMaybe [] labTeamDepts let l = fromMaybe [] labTeamDepts
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}
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 {
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
...@@ -108,39 +169,37 @@ instance decodeContactTouch :: DecodeJson ContactTouch ...@@ -108,39 +169,37 @@ instance decodeContactTouch :: DecodeJson ContactTouch
where where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
mail <- obj .:! "mail" mail <- obj .:? "mail"
phone <- obj .:! "phone" phone <- obj .:? "phone"
url <- obj .:! "url" url <- obj .:? "url"
pure $ ContactTouch {mail, phone, url} pure $ ContactTouch {mail, phone, url}
instance encodeContactTouch :: EncodeJson ContactTouch
newtype HyperdataUser =
HyperdataUser { shared :: Maybe HyperdataContact }
derive instance newtypeHyperdataUser :: Newtype HyperdataUser _
instance decodeHyperdataUser :: DecodeJson HyperdataUser
where where
decodeJson json = do encodeJson (ContactTouch ct) =
obj <- decodeJson json "mail" := ct.mail
shared <- obj .:! "shared" ~> "phone" := ct.phone
pure $ HyperdataUser { shared } ~> "url" := ct.url
~> jsonEmptyObject
defaultHyperdataUser :: HyperdataUser
defaultHyperdataUser = defaultContactTouch :: ContactTouch
HyperdataUser { defaultContactTouch =
shared: Just defaultHyperdataContact ContactTouch {
mail: Nothing
, phone: Nothing
, url: Nothing
} }
newtype HyperdataContact = newtype HyperdataContact =
HyperdataContact { bdd :: Maybe String HyperdataContact { bdd :: Maybe String
, who :: Maybe ContactWho , lastValidation :: Maybe String
, ou :: (Array ContactWhere) , ou :: (Array ContactWhere)
, title :: Maybe String
, source :: Maybe String , source :: Maybe String
, lastValidation :: Maybe String , title :: Maybe String
, uniqId :: Maybe String , uniqId :: Maybe String
, uniqIdBdd :: Maybe String , uniqIdBdd :: Maybe String
, who :: Maybe ContactWho
} }
derive instance newtypeHyperdataContact :: Newtype HyperdataContact _ derive instance newtypeHyperdataContact :: Newtype HyperdataContact _
...@@ -148,19 +207,32 @@ instance decodeHyperdataContact :: DecodeJson HyperdataContact ...@@ -148,19 +207,32 @@ instance decodeHyperdataContact :: DecodeJson HyperdataContact
where where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
bdd <- obj .:! "bdd" bdd <- obj .:? "bdd"
who <- obj .:! "who" lastValidation <- obj .:? "lastValidation"
ou <- obj .:! "where" ou <- obj .:! "where"
title <- obj .:! "title" source <- obj .:? "source"
source <- obj .:! "source" title <- obj .:? "title"
lastValidation <- obj .:! "lastValidation" uniqId <- obj .:? "uniqId"
uniqId <- obj .:! "uniqId" uniqIdBdd <- obj .:? "uniqIdBdd"
uniqIdBdd <- obj .:! "uniqIdBdd" who <- obj .:? "who"
let ou' = fromMaybe [] ou let ou' = fromMaybe [] ou
pure $ HyperdataContact {bdd, who, ou:ou', title, source, lastValidation, uniqId, uniqIdBdd} 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
defaultHyperdataContact = defaultHyperdataContact =
HyperdataContact { HyperdataContact {
...@@ -175,6 +247,32 @@ defaultHyperdataContact = ...@@ -175,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 = -- newtype HyperData c s =
-- HyperData -- HyperData
-- { common :: c -- { common :: c
...@@ -190,39 +288,82 @@ defaultHyperdataContact = ...@@ -190,39 +288,82 @@ defaultHyperdataContact =
-- specific <- decodeJson json -- specific <- decodeJson json
-- pure $ HyperData {common, shared, specific} -- 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} 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 {shared}) = fromMaybe defaultHyperdataContact shared
getter (HyperdataUser h@{shared: Just shared'}) = shared' setter (HyperdataUser h) val = HyperdataUser $ h { shared = Just val }
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 {who}) = fromMaybe defaultContactWho who
getter (HyperdataContact hc@{who: Just who'}) = who' setter (HyperdataContact hc) val = HyperdataContact $ hc { who = Just val }
setter (HyperdataContact hc) w = HyperdataContact $ hc { who = Just w } _ouFirst :: Lens' HyperdataContact ContactWhere
_ouFirst = lens getter setter
where
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' ContactWho String
_lastName = lens getter setter _lastName = lens getter setter
where where
getter (ContactWho cw@{lastName: Nothing}) = "" getter (ContactWho {lastName}) = fromMaybe "" lastName
getter (ContactWho cw@{lastName: Just ln}) = ln setter (ContactWho cw) val = ContactWho $ cw { lastName = Just val }
setter (ContactWho cw) ln = ContactWho $ cw { lastName = Just ln } _firstName :: Lens' ContactWho String
_firstName = lens getter setter
where
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