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
86444f97
Commit
86444f97
authored
4 years ago
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[user] try to use lenses for contact item
parent
3b8f6267
Changes
2
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
139 additions
and
24 deletions
+139
-24
Contacts.purs
src/Gargantext/Components/Nodes/Annuaire/User/Contacts.purs
+72
-8
Types.purs
...antext/Components/Nodes/Annuaire/User/Contacts/Types.purs
+67
-16
No files found.
src/Gargantext/Components/Nodes/Annuaire/User/Contacts.purs
View file @
86444f97
...
@@ -4,16 +4,20 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts
...
@@ -4,16 +4,20 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts
, userLayout )
, userLayout )
where
where
import Prelude (bind, pure, ($), (<<<), (<>), (<$>), show)
import Data.Array (head)
import Data.Array (head)
import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Tuple (Tuple(..))
import Data.Tuple (Tuple(..)
, fst, snd
)
import Data.Tuple.Nested ((/\))
import Data.Tuple.Nested ((/\))
import Data.Newtype (unwrap)
import Data.Newtype (unwrap)
import Data.String (joinWith)
import Data.String (joinWith)
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Aff (Aff)
import Reactix as R
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Loader (useLoader)
...
@@ -21,6 +25,7 @@ import Gargantext.Routes as Routes
...
@@ -21,6 +25,7 @@ import Gargantext.Routes as Routes
import Gargantext.Ends (Frontends)
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session, get)
import Gargantext.Sessions (Session, get)
import Gargantext.Types (NodeType(..))
import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2
display :: String -> Array R.Element -> R.Element
display :: String -> Array R.Element -> R.Element
display title elems =
display title elems =
...
@@ -81,7 +86,7 @@ getCountry = fromMaybe "Empty Country"
...
@@ -81,7 +86,7 @@ getCountry = fromMaybe "Empty Country"
-- | ContactWhere / Touch infos
-- | ContactWhere / Touch infos
getTouch :: Array ContactWhere -> Maybe ContactTouch
getTouch :: Array ContactWhere -> Maybe ContactTouch
getTouch = maybe Nothing (\(ContactWhere {touch
:x}) -> x
) <<< head
getTouch = maybe Nothing (\(ContactWhere {touch
}) -> touch
) <<< head
getPhone :: Array ContactWhere -> String
getPhone :: Array ContactWhere -> String
getPhone obj = fromMaybe "Empty touch info" $ getPhone' <$> (getTouch obj)
getPhone obj = fromMaybe "Empty touch info" $ getPhone' <$> (getTouch obj)
...
@@ -94,12 +99,16 @@ getMail' :: ContactTouch -> String
...
@@ -94,12 +99,16 @@ getMail' :: ContactTouch -> String
getMail' = fromMaybe "Empty mail" <<< _.mail <<< unwrap
getMail' = fromMaybe "Empty mail" <<< _.mail <<< unwrap
-- | TODO format data in better design (UI) shape
-- | TODO format data in better design (UI) shape
contactInfos :: HyperdataUser -> Array R.Element
contactInfos :: HyperdataUser -> (HyperdataUser -> Effect Unit) -> Array R.Element
contactInfos (HyperdataUser { shared }) = item <$> contactInfoItems shared
contactInfos h@(HyperdataUser { shared }) onUpdateHyperdata =
(item <$> contactInfoItems shared)
<> [ contactInfoItem {hyperdata: h, lens: _shared <<< _who <<< _lastName, onUpdateHyperdata} ]
where
where
item (name /\ value) =
item (name /\ value) =
H.li { className: "list-group-item" }
H.li { className: "list-group-item" }
(infoRender (name /\ (" " <> value)))
(infoRender (name /\ (" " <> value)))
contactInfoItems :: Maybe HyperdataContact -> Array (Tuple String String)
contactInfoItems Nothing =
contactInfoItems Nothing =
[ "Last Name" /\ "Empty Last Name"
[ "Last Name" /\ "Empty Last Name"
, "First Name" /\ "Empty First Name"
, "First Name" /\ "Empty First Name"
...
@@ -123,6 +132,53 @@ contactInfoItems (Just (HyperdataContact {who:who, ou:ou})) =
...
@@ -123,6 +132,53 @@ contactInfoItems (Just (HyperdataContact {who:who, ou:ou})) =
, "Phone" /\ getPhone ou
, "Phone" /\ getPhone ou
, "Mail" /\ getMail ou ]
, "Mail" /\ getMail ou ]
type HyperdataUserLens = L.Lens' HyperdataUser String
type ContactInfoItemProps =
(
hyperdata :: HyperdataUser
, lens :: HyperdataUserLens
, onUpdateHyperdata :: HyperdataUser -> Effect Unit
)
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, lens, onUpdateHyperdata} _ = do
isEditing <- R.useState' false
let value = (L.view lens hyperdata) :: String
valueRef <- R.useRef value
pure $ H.li { className: "list-group-item" } [
item isEditing valueRef
]
where
item (false /\ setIsEditing) valueRef =
H.span {} [
H.text $ R.readRef valueRef
, H.span { className: "fa fa-pencil"
, on: {click: onClick} } []
]
where
onClick _ = setIsEditing $ const true
item (true /\ setIsEditing) valueRef =
H.span {} [
H.input { className: "form-control"
, defaultValue: R.readRef valueRef
, on: {change: \e -> R.setRef valueRef $ R2.unsafeEventValue e} }
, H.span { className: "fa fa-floppy-o"
, on: {click: onClick} } []
]
where
onClick _ = do
setIsEditing $ const false
-- let newHyperdata = (L.over lens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataUser
-- onUpdateHyperdata newHyperdata
listInfo :: Tuple String String -> R.Element
listInfo :: Tuple String String -> R.Element
listInfo s = listElement $ infoRender s
listInfo s = listElement $ infoRender s
...
@@ -143,13 +199,17 @@ userLayoutCpt :: R.Component LayoutProps
...
@@ -143,13 +199,17 @@ userLayoutCpt :: R.Component LayoutProps
userLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.userLayout" cpt
userLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.userLayout" cpt
where
where
cpt {frontends, nodeId, session} _ = do
cpt {frontends, nodeId, session} _ = do
--loader nodeId (getContact session) $
useLoader nodeId (getContact session) $
useLoader nodeId (getContact session) $
\contactData@{contactNode: Contact {name, hyperdata}} ->
\contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" }
H.ul { className: "col-md-12 list-group" }
[ display (fromMaybe "no name" name) (contactInfos hyperdata)
[ display (fromMaybe "no name" name) (contactInfos hyperdata
onUpdateHyperdata
)
, Tabs.tabs {frontends, nodeId, contactData, session} ]
, Tabs.tabs {frontends, nodeId, contactData, session} ]
where
onUpdateHyperdata :: HyperdataUser -> Effect Unit
onUpdateHyperdata hd = do
log2 "[onUpdateHyperdata] hd" hd
-- | toUrl to get data
-- | toUrl to get data
getContact :: Session -> Int -> Aff ContactData
getContact :: Session -> Int -> Aff ContactData
getContact session id = do
getContact session id = do
...
@@ -179,9 +239,13 @@ annuaireUserLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.annua
...
@@ -179,9 +239,13 @@ annuaireUserLayoutCpt = R.hooksComponent "G.C.Nodes.Annuaire.User.Contacts.annua
useLoader nodeId (getAnnuaireContact session annuaireId) $
useLoader nodeId (getAnnuaireContact session annuaireId) $
\contactData@{contactNode: Contact {name, hyperdata}} ->
\contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" }
H.ul { className: "col-md-12 list-group" }
[ display (fromMaybe "no name" name) (contactInfos hyperdata)
[ display (fromMaybe "no name" name) (contactInfos hyperdata
onUpdateHyperdata
)
, Tabs.tabs {frontends, nodeId, contactData, session} ]
, Tabs.tabs {frontends, nodeId, contactData, session} ]
where
onUpdateHyperdata :: HyperdataUser -> Effect Unit
onUpdateHyperdata _ = pure unit
getAnnuaireContact :: Session -> Int -> Int -> Aff ContactData
getAnnuaireContact :: Session -> Int -> Int -> Aff ContactData
getAnnuaireContact session annuaireId id = do
getAnnuaireContact session annuaireId id = do
contactNode <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ "contact/" <> (show id)
contactNode <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ "contact/" <> (show id)
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Components/Nodes/Annuaire/User/Contacts/Types.purs
View file @
86444f97
...
@@ -3,8 +3,10 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where
...
@@ -3,8 +3,10 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where
import Prelude
import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:!))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:!))
import Data.Maybe (Maybe, fromMaybe)
import Data.Lens
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Map (Map)
import Data.Map (Map)
import Data.Tuple (Tuple(..))
import Gargantext.Utils.DecodeMaybe ((.?|))
import Gargantext.Utils.DecodeMaybe ((.?|))
import Data.Newtype (class Newtype)
import Data.Newtype (class Newtype)
...
@@ -47,6 +49,16 @@ instance decodeContactWho :: DecodeJson ContactWho
...
@@ -47,6 +49,16 @@ instance decodeContactWho :: DecodeJson ContactWho
pure $ ContactWho {idWho, firstName, lastName, keywords:k, freetags:f}
pure $ ContactWho {idWho, firstName, lastName, keywords:k, freetags:f}
defaultContactWho :: ContactWho
defaultContactWho =
ContactWho {
idWho: Nothing
, firstName: Nothing
, lastName: Nothing
, keywords: []
, freetags: []
}
newtype ContactWhere =
newtype ContactWhere =
ContactWhere
ContactWhere
{ organization :: (Array String)
{ organization :: (Array String)
...
@@ -113,6 +125,12 @@ instance decodeHyperdataUser :: DecodeJson HyperdataUser
...
@@ -113,6 +125,12 @@ instance decodeHyperdataUser :: DecodeJson HyperdataUser
shared <- obj .:! "shared"
shared <- obj .:! "shared"
pure $ HyperdataUser { shared }
pure $ HyperdataUser { shared }
defaultHyperdataUser :: HyperdataUser
defaultHyperdataUser =
HyperdataUser {
shared: Just defaultHyperdataContact
}
newtype HyperdataContact =
newtype HyperdataContact =
HyperdataContact { bdd :: Maybe String
HyperdataContact { bdd :: Maybe String
...
@@ -143,21 +161,34 @@ instance decodeHyperdataContact :: DecodeJson HyperdataContact
...
@@ -143,21 +161,34 @@ instance decodeHyperdataContact :: DecodeJson HyperdataContact
pure $ HyperdataContact {bdd, who, ou:ou', title, source, lastValidation, uniqId, uniqIdBdd}
pure $ HyperdataContact {bdd, who, ou:ou', title, source, lastValidation, uniqId, uniqIdBdd}
defaultHyperdataContact :: HyperdataContact
newtype HyperData c s =
defaultHyperdataContact =
HyperData
HyperdataContact {
{ common :: c
bdd: Nothing
, shared :: s
, who: Nothing
, specific :: Map String String
, ou: []
, title: Nothing
, source: Nothing
, lastValidation: Nothing
, uniqId: Nothing
, uniqIdBdd: Nothing
}
}
instance decodeUserHyperData :: (DecodeJson c, DecodeJson s) =>
DecodeJson (HyperData c s) where
-- newtype HyperData c s =
decodeJson json = do
-- HyperData
common <- decodeJson json
-- { common :: c
shared <- decodeJson json
-- , shared :: s
specific <- decodeJson json
-- , specific :: Map String String
pure $ HyperData {common, shared, specific}
-- }
-- instance decodeUserHyperData :: (DecodeJson c, DecodeJson s) =>
-- DecodeJson (HyperData c s) where
-- decodeJson json = do
-- common <- decodeJson json
-- shared <- decodeJson json
-- specific <- decodeJson json
-- pure $ HyperData {common, shared, specific}
instance decodeUser :: DecodeJson Contact where
instance decodeUser :: DecodeJson Contact where
decodeJson json = do
decodeJson json = do
...
@@ -175,3 +206,23 @@ instance decodeUser :: DecodeJson Contact where
...
@@ -175,3 +206,23 @@ instance decodeUser :: DecodeJson Contact where
}
}
type ContactData = {contactNode :: Contact, defaultListId :: Int}
type ContactData = {contactNode :: Contact, defaultListId :: Int}
_shared :: Lens' HyperdataUser HyperdataContact
_shared = lens getter setter
where
getter (HyperdataUser h@{shared: Nothing}) = defaultHyperdataContact
getter (HyperdataUser h@{shared: Just shared'}) = shared'
setter (HyperdataUser h) c = HyperdataUser $ h { shared = Just c }
_who :: Lens' HyperdataContact ContactWho
_who = lens getter setter
where
getter (HyperdataContact hc@{who: Nothing}) = defaultContactWho
getter (HyperdataContact hc@{who: Just who'}) = who'
setter (HyperdataContact hc) w = HyperdataContact $ hc { who = Just w }
_lastName :: Lens' ContactWho String
_lastName = lens getter setter
where
getter (ContactWho cw@{lastName: Nothing}) = ""
getter (ContactWho cw@{lastName: Just ln}) = ln
setter (ContactWho cw) ln = ContactWho $ cw { lastName = Just ln }
This diff is collapsed.
Click to expand it.
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