Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
1
Merge Requests
1
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Przemyslaw Kaminski
purescript-gargantext
Commits
a016093f
Commit
a016093f
authored
Mar 02, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'dev-user-page' into dev
parents
c6e4a553
29887531
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
259 additions
and
166 deletions
+259
-166
Contacts.purs
src/Gargantext/Components/Nodes/Annuaire/User/Contacts.purs
+51
-99
Types.purs
...antext/Components/Nodes/Annuaire/User/Contacts/Types.purs
+208
-67
No files found.
src/Gargantext/Components/Nodes/Annuaire/User/Contacts.purs
View file @
a016093f
...
@@ -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, l
ens, onUpdateHyperdata
} _ = do
cpt {hyperdata, l
abel, lens, onUpdateHyperdata, placeholder
} _ = do
isEditing <- R.useState' false
isEditing <- R.useState' false
let value = (L.view
l
ens hyperdata) :: String
let value = (L.view
cL
ens 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 l
ens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataUser
let newHyperdata = (L.over cL
ens (\_ -> 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
...
...
src/Gargantext/Components/Nodes/Annuaire/User/Contacts/Types.purs
View file @
a016093f
...
@@ -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 .:! "titl
e"
source <- obj .:? "sourc
e"
source <- obj .:! "sourc
e"
title <- obj .:? "titl
e"
lastValidation <- obj .:! "lastValidation
"
uniqId <- obj .:? "uniqId
"
uniqId
<- obj .:! "uniqI
d"
uniqId
Bdd <- obj .:? "uniqIdBd
d"
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 }
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment