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
0
Merge Requests
0
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
Grégoire Locqueville
purescript-gargantext
Commits
29887531
Commit
29887531
authored
Mar 02, 2020
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[user] user edit page works now, with lenses
parent
0c2ecf5b
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
220 additions
and
170 deletions
+220
-170
Contacts.purs
src/Gargantext/Components/Nodes/Annuaire/User/Contacts.purs
+34
-102
Types.purs
...antext/Components/Nodes/Annuaire/User/Contacts/Types.purs
+186
-68
No files found.
src/Gargantext/Components/Nodes/Annuaire/User/Contacts.purs
View file @
29887531
...
@@ -13,7 +13,7 @@ import Data.Newtype (unwrap)
...
@@ -13,7 +13,7 @@ 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,112 +43,30 @@ display title elems =
...
@@ -43,112 +43,30 @@ 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 onUpdateHyperdata = item <$> contactInfoItems
contactInfos h onUpdateHyperdata = item <$> contactInfoItems
where
where
item
(label /\ defaultVal /\ lens)
=
item
{label, defaultVal, lens}
=
contactInfoItem { hyperdata: h
contactInfoItem { hyperdata: h
, label
, label
, lens
, lens
, onUpdateHyperdata }
, onUpdateHyperdata
, placeholder: defaultVal }
-- item (name /\ value) =
contactInfoItems :: Array {label:: String, defaultVal:: String, lens:: HyperdataUserLens}
-- H.li { className: "list-group-item" }
-- (infoRender (name /\ (" " <> value)))
contactInfoItems :: Array (Tuple3 String String HyperdataUserLens)
contactInfoItems =
contactInfoItems =
[ "Last Name" /\ "Empty Last Name" /\ (_shared <<< _who <<< _lastName)
[ {label: "Last Name", defaultVal: "Empty Last Name", lens: _shared <<< _who <<< _lastName}
, "First Name" /\ "Empty First Name" /\ (_shared <<< _who <<< _firstName)
, {label: "First Name", defaultVal: "Empty First Name", lens: _shared <<< _who <<< _firstName}
, "Organisation" /\ "Empty Organisation" /\ (_shared <<< _who <<< _lastName)
, {label: "Organisation", defaultVal: "Empty Organisation", lens: _shared <<< _ouFirst <<< _organizationJoinComma}
, "Lab/Team/Dept" /\ "Empty Lab/Team/Dept" /\ (_shared <<< _who <<< _lastName)
, {label: "Lab/Team/Dept", defaultVal: "Empty Lab/Team/Dept", lens: _shared <<< _ouFirst <<< _labTeamDeptsJoinComma}
, "Office" /\ "Empty Office" /\ (_shared <<< _who <<< _lastName)
, {label: "Office", defaultVal: "Empty Office", lens: _shared <<< _ouFirst <<< _office}
, "City" /\ "Empty City" /\ (_shared <<< _who <<< _lastName)
, {label: "City", defaultVal: "Empty City", lens: _shared <<< _ouFirst <<< _city}
, "Country" /\ "Empty Country" /\ (_shared <<< _who <<< _lastName)
, {label: "Country", defaultVal: "Empty Country", lens: _shared <<< _ouFirst <<< _country}
, "Role" /\ "Empty Role" /\ (_shared <<< _who <<< _lastName)
, {label: "Role", defaultVal: "Empty Role", lens: _shared <<< _ouFirst <<< _role}
, "Phone" /\ "Empty Phone" /\ (_shared <<< _who <<< _lastName)
, {label: "Phone", defaultVal: "Empty Phone", lens: _shared <<< _ouFirst <<< _touch <<< _phone}
, "Mail" /\ "Empty Mail" /\ (_shared <<< _who <<< _lastName) ]
, {label: "Mail", defaultVal: "Empty Mail", lens: _shared <<< _ouFirst <<< _touch <<< _mail} ]
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 ]
--type HyperdataUserLens = L.Lens' HyperdataUser String
type HyperdataUserLens = L.ALens' HyperdataUser String
type HyperdataUserLens = L.ALens' HyperdataUser String
type ContactInfoItemProps =
type ContactInfoItemProps =
...
@@ -157,16 +75,16 @@ type ContactInfoItemProps =
...
@@ -157,16 +75,16 @@ type ContactInfoItemProps =
, label :: String
, 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, label, lens, onUpdateHyperdata} _ = do
cpt {hyperdata, label, lens, onUpdateHyperdata
, placeholder
} _ = do
isEditing <- R.useState' false
isEditing <- R.useState' false
let value = (L.view cLens hyperdata) :: String
let value = (L.view cLens hyperdata) :: String
valueRef <- R.useRef value
valueRef <- R.useRef value
...
@@ -177,9 +95,16 @@ contactInfoItemCpt = R.hooksComponent "G.C.N.A.U.C.contactInfoItem" cpt
...
@@ -177,9 +95,16 @@ contactInfoItemCpt = R.hooksComponent "G.C.N.A.U.C.contactInfoItem" cpt
]
]
where
where
cLens = L.cloneLens lens
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} } []
]
]
...
@@ -189,7 +114,8 @@ contactInfoItemCpt = R.hooksComponent "G.C.N.A.U.C.contactInfoItem" cpt
...
@@ -189,7 +114,8 @@ 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} } []
]
]
...
@@ -229,6 +155,8 @@ userLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.userLayout" c
...
@@ -229,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
...
@@ -243,6 +171,10 @@ getContact session id = do
...
@@ -243,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 @
29887531
...
@@ -2,11 +2,12 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where
...
@@ -2,11 +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.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)
...
@@ -15,14 +16,35 @@ import Data.Newtype (class Newtype)
...
@@ -15,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 =
...
@@ -39,9 +61,9 @@ instance decodeContactWho :: DecodeJson ContactWho
...
@@ -39,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"
...
@@ -50,6 +72,16 @@ instance decodeContactWho :: DecodeJson ContactWho
...
@@ -50,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 {
...
@@ -84,19 +116,33 @@ instance decodeContactWhere :: DecodeJson ContactWhere
...
@@ -84,19 +116,33 @@ 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
defaultContactWhere =
defaultContactWhere =
ContactWhere {
ContactWhere {
...
@@ -123,39 +169,37 @@ instance decodeContactTouch :: DecodeJson ContactTouch
...
@@ -123,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 _
...
@@ -163,19 +207,32 @@ instance decodeHyperdataContact :: DecodeJson HyperdataContact
...
@@ -163,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 {
...
@@ -190,6 +247,32 @@ defaultHyperdataContact =
...
@@ -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 =
-- newtype HyperData c s =
-- HyperData
-- HyperData
-- { common :: c
-- { common :: c
...
@@ -205,47 +288,82 @@ defaultHyperdataContact =
...
@@ -205,47 +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}) = fromMaybe defaultHyperdataContact shared
getter (HyperdataUser {shared}) = fromMaybe defaultHyperdataContact shared
setter (HyperdataUser h)
c = HyperdataUser $ h { shared = Just c
}
setter (HyperdataUser h)
val = HyperdataUser $ h { shared = Just val
}
_who :: Lens' HyperdataContact ContactWho
_who :: Lens' HyperdataContact ContactWho
_who = lens getter setter
_who = lens getter setter
where
where
getter (HyperdataContact
hc@
{who}) = fromMaybe defaultContactWho who
getter (HyperdataContact {who}) = fromMaybe defaultContactWho who
setter (HyperdataContact hc)
w = HyperdataContact $ hc { who = Just w
}
setter (HyperdataContact hc)
val = HyperdataContact $ hc { who = Just val
}
_ouFirst :: Lens' HyperdataContact ContactWhere
_ouFirst :: Lens' HyperdataContact ContactWhere
_ouFirst = lens getter setter
_ouFirst = lens getter setter
where
where
getter (HyperdataContact
hc@
{ou}) = fromMaybe defaultContactWhere $ A.head ou
getter (HyperdataContact {ou}) = fromMaybe defaultContactWhere $ A.head ou
setter (HyperdataContact hc@{ou})
o = HyperdataContact $ hc { ou = fromMaybe [o] $ A.updateAt 0 o
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}) = fromMaybe "" lastName
getter (ContactWho {lastName}) = fromMaybe "" lastName
setter (ContactWho cw)
ln = ContactWho $ cw { lastName = Just ln
}
setter (ContactWho cw)
val = ContactWho $ cw { lastName = Just val
}
_firstName :: Lens' ContactWho String
_firstName :: Lens' ContactWho String
_firstName = lens getter setter
_firstName = lens getter setter
where
where
getter (ContactWho cw@{firstName}) = fromMaybe "" firstName
getter (ContactWho {firstName}) = fromMaybe "" firstName
setter (ContactWho cw) fn = ContactWho $ cw { firstName = Just fn }
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