Commit fd465d32 authored by arturo's avatar arturo

[annuaire] New GQL route for annuaire contact

* #376: rc2.x
parent df831894
......@@ -17,6 +17,7 @@ import Gargantext.Components.GraphQL.User (User, UserInfo, UserInfoM)
import Gargantext.Ends (Backend(..))
import Gargantext.Sessions (Session(..))
import Gargantext.Utils.Reactix as R2
import Gargnatext.Components.GraphQL.Contact (AnnuaireContact)
import GraphQL.Client.Args (type (==>))
import GraphQL.Client.BaseClients.Urql (UrqlClient, createClient)
import GraphQL.Client.Query (queryWithDecoder)
......@@ -64,8 +65,8 @@ queryGql session name q = do
--query client name q
client <- liftEffect $ getClient session
gqlQuery (client :: Client UrqlClient Schema Mutation Void) name q
--query_ "http://localhost:8008/gql" (Proxy :: Proxy Schema)
--query_ "http://localhost:8008/gql" (Proxy :: Proxy Schema)
-- Schema
type Schema
......@@ -74,6 +75,7 @@ type Schema
, user_infos :: { user_id :: Int } ==> Array UserInfo
, users :: { user_id :: Int } ==> Array User
, tree :: { root_id :: Int } ==> TreeFirstLevel
, annuaire_contacts :: { contact_id :: Int } ==> Array AnnuaireContact
}
type Mutation
......
module Gargnatext.Components.GraphQL.Contact
( AnnuaireContact
, annuaireContactQuery
-- Lenses
, _ac_firstName
, _ac_lastName
) where
import Gargantext.Prelude
import Data.Lens (Lens', lens)
import Data.Maybe (Maybe(..), fromMaybe)
import GraphQL.Client.Args (Args, (=>>))
import GraphQL.Client.Variable (Var(..))
type AnnuaireContact
= { ac_id :: Int
, ac_firstName :: Maybe String
, ac_lastName :: Maybe String
}
type AnnuaireContactQuery
= { annuaire_contacts :: Args
{ contact_id :: Var "id" Int }
{ ac_id :: Unit
, ac_firstName :: Unit
, ac_lastName :: Unit
}
}
annuaireContactQuery :: AnnuaireContactQuery
annuaireContactQuery
= { annuaire_contacts:
{ contact_id: Var :: _ "id" Int } =>>
{ ac_id: unit
, ac_firstName: unit
, ac_lastName: unit
}
}
------------------------------------------------------------------------
_ac_firstName :: Lens' AnnuaireContact String
_ac_firstName = lens getter setter
where
getter ({ ac_firstName: val }) = fromMaybe "" val
setter rec val = rec { ac_firstName = Just val }
_ac_lastName :: Lens' AnnuaireContact String
_ac_lastName = lens getter setter
where
getter ({ ac_lastName: val }) = fromMaybe "" val
setter rec val = rec { ac_lastName = Just val }
module Gargantext.Components.GraphQL.Endpoints where
import Gargantext.Components.GraphQL.Node
import Gargantext.Components.GraphQL.User
import Gargantext.Components.GraphQL.Tree
import Gargantext.Prelude
import Gargantext.Components.GraphQL.Node (Node, nodeParentQuery)
import Gargantext.Components.GraphQL.Tree (TreeFirstLevel, treeFirstLevelQuery)
import Gargantext.Components.GraphQL.User (UserInfo, userInfoQuery)
import Data.Array as A
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.Unit (unit)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.Components.GraphQL (getClient, queryGql)
import Gargantext.Components.GraphQL (queryGql)
import Gargantext.Components.GraphQL.IMT as GQLIMT
import Gargantext.Components.GraphQL.Task as GQLT
import Gargantext.Config.REST (AffRESTError, RESTError(..))
import Gargantext.Config.REST (RESTError(..), AffRESTError)
import Gargantext.Sessions (Session)
import Gargantext.Types (AsyncTaskWithType(..), AsyncTask(..), AsyncTaskType(..), NodeType)
import Gargantext.Types (NodeType)
import Gargantext.Utils.Reactix as R2
import GraphQL.Client.Args (onlyArgs, (=>>))
import GraphQL.Client.Query (mutation)
import Gargnatext.Components.GraphQL.Contact (AnnuaireContact, annuaireContactQuery)
import GraphQL.Client.Variables (withVars)
import Simple.JSON as JSON
here :: R2.Here
here = R2.here "Gargantext.Components.GraphQL.Endpoints"
......@@ -50,9 +47,17 @@ getUserInfo session id = do
-- NOTE Contact is at G.C.N.A.U.C.Types
Just ui -> Right ui
getAnnuaireContact :: Session -> Int -> AffRESTError AnnuaireContact
getAnnuaireContact session id = do
{ annuaire_contacts } <- queryGql session "get annuaire contact" $
annuaireContactQuery `withVars` { id }
liftEffect $ here.log2 "[getAnnuaireContact] data" annuaire_contacts
pure $ case A.head annuaire_contacts of
Nothing -> Left (CustomError $ "contact id=" <> show id <> " not found")
Just r -> Right r
getTreeFirstLevel :: Session -> Int -> AffRESTError TreeFirstLevel
getTreeFirstLevel session id = do
{ tree } <- queryGql session "get tree first level" $ treeFirstLevelQuery `withVars` { id }
liftEffect $ here.log2 "[getTreeFirstLevel] tree first level" tree
pure $ Right tree -- TODO: error handling
......@@ -143,4 +143,3 @@ showUser { u_id
, u_username
, u_email } = "[" <> show u_id <> "] " <> u_username <> " :: " <> u_email
showMUser u = maybe "" showUser u
......@@ -7,17 +7,21 @@ module Gargantext.Components.Nodes.Annuaire.User
import Gargantext.Prelude
import Data.Either (Either(..))
import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe)
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.App.Store (Boxes)
import Gargantext.Components.GraphQL.User (UserInfo)
import Gargantext.Components.GraphQL (getClient)
import Gargantext.Components.GraphQL.Endpoints (getUserInfo)
import Gargantext.Components.GraphQL.User (UserInfo, _ui_cwCity, _ui_cwCountry, _ui_cwFirstName, _ui_cwLabTeamDeptsFirst, _ui_cwLastName, _ui_cwOffice, _ui_cwOrganizationFirst, _ui_cwRole, _ui_cwTouchMail, _ui_cwTouchPhone)
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Nodes.Annuaire.Tabs as Tabs
import Gargantext.Components.Nodes.Annuaire.User.Contact (getUserInfoWithReload, saveUserInfo, contactInfos)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
import Gargantext.Components.Nodes.Lists.Types as LT
import Gargantext.Config.REST (logRESTError)
import Gargantext.Config.REST (AffRESTError, logRESTError)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
......@@ -25,6 +29,8 @@ import Gargantext.Sessions (Session(..), WithSession, WithSessionContext, sessio
import Gargantext.Types (FrontendError)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import GraphQL.Client.Args (IgnoreArg(..), OrArg(..), onlyArgs)
import GraphQL.Client.Query (mutation)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
......@@ -143,3 +149,150 @@ userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt where
-- -- throwError $ error "Missing default list"
-- pure $ (\contactNode -> { contactNode, defaultListId: 424242 }) <$> eContactNode
--
------------------------------------------------------------
-- | TODO format data in better design (UI) shape
contactInfos :: UserInfo -> (UserInfo -> Effect Unit) -> Array R.Element
contactInfos userInfo onUpdateUserInfo = item <$> contactInfoItems where
item { label, lens, defaultVal } =
contactInfoItem { defaultVal, label, lens, onUpdateUserInfo, userInfo }
contactInfoItems :: Array {label:: String, defaultVal:: String, lens:: UserInfoLens}
contactInfoItems =
[ { label: "Last Name" , defaultVal: "Empty Last Name" , lens: _ui_cwLastName }
, { label: "First Name" , defaultVal: "Empty First Name" , lens: _ui_cwFirstName }
, { label: "Organisation" , defaultVal: "Empty Organisation" , lens: _ui_cwOrganizationFirst }
, { label: "Lab/Team/Dept", defaultVal: "Empty Lab/Team/Dept", lens: _ui_cwLabTeamDeptsFirst }
, { label: "Office" , defaultVal: "Empty Office" , lens: _ui_cwOffice }
, { label: "City" , defaultVal: "Empty City" , lens: _ui_cwCity }
, { label: "Country" , defaultVal: "Empty Country" , lens: _ui_cwCountry }
, { label: "Role" , defaultVal: "Empty Role" , lens: _ui_cwRole }
, { label: "Phone" , defaultVal: "Empty Phone" , lens: _ui_cwTouchPhone }
, { label: "Mail" , defaultVal: "Empty Mail" , lens: _ui_cwTouchMail }
]
type UserInfoLens = L.ALens' UserInfo String
type ContactInfoItemProps =
( defaultVal :: String
, label :: String
, lens :: UserInfoLens
, onUpdateUserInfo :: UserInfo -> Effect Unit
, userInfo :: UserInfo
)
contactInfoItem :: R2.Leaf ContactInfoItemProps
contactInfoItem = R2.leafComponent contactInfoItemCpt
contactInfoItemCpt :: R.Component ContactInfoItemProps
contactInfoItemCpt = here.component "contactInfoItem" cpt
where
cpt { defaultVal, label, lens, onUpdateUserInfo, userInfo } _ = do
isEditing <- T.useBox false
isEditing' <- T.useLive T.unequal isEditing
let value = (L.view cLens userInfo) :: String
valueBox <- T.useBox value
pure $
H.div { className: "form-group row" }
[ H.span { className: "col-sm-2 col-form-label" } [ H.text label ]
, if isEditing' then
itemEditing { defaultVal, isEditing, lens, onUpdateUserInfo, userInfo, valueBox }
else
itemNotEditing { defaultVal, isEditing, lens, onUpdateUserInfo, userInfo, valueBox }
]
where
cLens = L.cloneLens lens
type ItemProps =
( defaultVal :: String
, isEditing :: T.Box Boolean
, lens :: UserInfoLens
, onUpdateUserInfo :: UserInfo -> Effect Unit
, userInfo :: UserInfo
, valueBox :: T.Box String
)
itemNotEditing :: R2.Leaf ItemProps
itemNotEditing = R2.leafComponent itemNotEditingCpt
itemNotEditingCpt :: R.Component ItemProps
itemNotEditingCpt = here.component "itemEditing" cpt where
cpt { isEditing, valueBox } _ = do
valueBox' <- T.useLive T.unequal valueBox
pure $ H.div { className: "input-group col-sm-6" }
[ H.input
{ className: "form-control", type: "text"
, defaultValue: valueBox', disabled: true }
, H.div { className: "btn input-group-append", on: { click } }
[ H.div { className: "input-group-text fa fa-pencil" } [] ]
]
where
click _ = T.write_ true isEditing
itemEditing :: R2.Leaf ItemProps
itemEditing = R2.leafComponent itemEditingCpt
itemEditingCpt :: R.Component ItemProps
itemEditingCpt = here.component "itemNotEditing" cpt where
cpt { defaultVal, isEditing, lens, onUpdateUserInfo, userInfo, valueBox } _ = do
valueBox' <- T.useLive T.unequal valueBox
pure $ H.div { className: "input-group col-sm-6" }
[ inputWithEnter
{ autoFocus: true
, className: "form-control"
, defaultValue: valueBox'
, onBlur: \v -> T.write_ v valueBox
, onEnter: click
, onValueChanged: \v -> do
here.log2 "[itemEditingCpt] value Changed: " v
T.write_ v valueBox
, placeholder: defaultVal
, type: "text" }
, H.div { className: "btn input-group-append", on: { click } }
[ H.div { className: "input-group-text fa fa-floppy-o" } [] ]
]
where
cLens = L.cloneLens lens
click _ = do
T.write_ false isEditing
value <- T.read valueBox
here.log2 "[itemEditing] value" value
let newUserInfo = (L.set cLens value userInfo) :: UserInfo
onUpdateUserInfo newUserInfo
-- saveContactHyperdata :: Session -> Int -> HyperdataContact -> AffRESTError Int
-- saveContactHyperdata session id = put session (Routes.NodeAPI Node (Just id) "")
saveUserInfo :: Session -> Int -> UserInfo -> AffRESTError Int
saveUserInfo session id ui = do
let token = getToken session
client <- liftEffect $ getClient session
res <- mutation
client
"update user_info"
{ update_user_info: onlyArgs { token: token
, ui_id: id
, ui_cwFirstName: ga ui.ui_cwFirstName
, ui_cwLastName: ga ui.ui_cwLastName
, ui_cwOrganization: ui.ui_cwOrganization
, ui_cwLabTeamDepts: ui.ui_cwLabTeamDepts
, ui_cwOffice: ga ui.ui_cwOffice
, ui_cwCity: ga ui.ui_cwCity
, ui_cwCountry: ga ui.ui_cwCountry
, ui_cwRole: ga ui.ui_cwRole
, ui_cwTouchPhone: ga ui.ui_cwTouchPhone
, ui_cwTouchMail: ga ui.ui_cwTouchMail } }
pure $ Right res.update_user_info
where
ga Nothing = ArgL IgnoreArg
ga (Just val) = ArgR val
getToken (Session { token }) = token
getUserInfoWithReload :: { nodeId :: Int
, reload :: T2.Reload
, session :: Session
} -> AffRESTError UserInfo
getUserInfoWithReload {nodeId, session} = getUserInfo session nodeId -- getContact session nodeId
......@@ -620,13 +620,18 @@ contact = R.createElement contactCpt
contactCpt :: R.Component ContactProps
contactCpt = here.component "contact" cpt where
cpt props@{ annuaireId
, boxes
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
-- let forestedProps = RE.pick props :: Record Props
pure $ authed (Record.merge { content: \session ->
contactLayout { annuaireId
, boxes
, frontends: defaultFrontends
, nodeId
, session } [] } sessionProps) []
, nodeId
} _ = do
let
sessionProps = (RE.pick props :: Record SessionProps)
authedProps =
{ content:
\_ -> contactLayout
{ nodeId
, annuaireId
, key: "annuaireId-" <> show annuaireId
}
} `Record.merge` sessionProps
pure $ authed authedProps []
......@@ -34,7 +34,7 @@ instance Show RESTError where
show (SendResponseError e) = "SendResponseError " <> showError e
where
showError (RequestContentError e') = "(RequestContentError " <> show e' <> ")"
showError (ResponseBodyError fe rf) = "(ResponseBodyError " <> show fe <> " (rf)" -- <> show rf <> ")"
showError (ResponseBodyError fe _) = "(ResponseBodyError " <> show fe <> " (rf)" -- <> show rf <> ")"
showError (TimeoutError) = "(TimeoutError)"
showError (RequestFailedError) = "(RequestFailedError)"
showError (XHROtherError e') = "(XHROtherError " <> show e' <> ")"
......
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