[search] implement pubmed api key in user settings

parent af6069dd
......@@ -18,7 +18,7 @@ import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.Forest.Tree.Node.Action.Search.Frame (searchIframes)
import Gargantext.Components.Forest.Tree.Node.Action.Search.Types (DataField(..), Database(..), IMT_org(..), Org(..), SearchQuery(..), allOrgs, dataFields, defaultSearchQuery, doc, performSearch, datafield2database, Search, dbFromInputValue, dbToInputValue)
import Gargantext.Components.GraphQL.Endpoints (getIMTSchools, getNodeCorpus)
import Gargantext.Components.GraphQL.Endpoints (getIMTSchools)
import Gargantext.Components.GraphQL.IMT as GQLIMT
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Lang (Lang(..))
......@@ -221,7 +221,7 @@ isCNRS _ = false
isPubmed :: Maybe DataField -> Boolean
isPubmed ( Just
( External ( PubMed _ ) )
( External PubMed )
) = true
isPubmed _ = false
......@@ -359,22 +359,12 @@ databaseInputCpt = here.component "databaseInput" cpt
change e = do
let value = dbFromInputValue $ R.unsafeEventValue e
-- TODO Fetch pubmed api key
launchAff_ $ do
updatedValue <- case value of
Just (PubMed _) ->
case search'.node_id of
Just nodeId -> do
eCorpus <- getNodeCorpus session nodeId
case eCorpus of
Left _err -> pure $ PubMed { api_key: Nothing }
Right c -> pure $ PubMed { api_key: c.pubmedAPIKey }
Nothing -> pure $ PubMed { api_key: Nothing }
_ -> pure $ fromMaybe Empty value
liftEffect $ T.modify_ (_ { datafield = Just $ External updatedValue
, databases = updatedValue
}) search
let updatedValue = fromMaybe Empty value
T.modify_ (_ { datafield = Just $ External updatedValue
, databases = updatedValue
}) search
pure $
H.div { className: "form-group p-1 mb-0" }
......@@ -387,38 +377,38 @@ databaseInputCpt = here.component "databaseInput" cpt
]
type PubmedInputProps = (
search :: T.Box Search
, session :: Session
)
pubmedInput :: R2.Component PubmedInputProps
pubmedInput = R.createElement pubmedInputCpt
pubmedInputCpt :: R.Component PubmedInputProps
pubmedInputCpt = here.component "pubmedInput" cpt where
cpt { search, session } _ = do
search' <- T.useLive T.unequal search
case search'.datafield of
Just (External (PubMed p@{ api_key })) ->
-- TODO Fetch current API key
pure $
H.div { className: "form-group p-1 m-0" }
[ H.div { className: "text-primary center" } [ H.text "Pubmed API key" ]
, H.input { className: "form-control"
, defaultValue: fromMaybe "" api_key
, on: { blur: modifyPubmedAPIKey search p
, change: modifyPubmedAPIKey search p
, input: modifyPubmedAPIKey search p } } ]
_ -> pure $ H.div {} []
where
modifyPubmedAPIKey search p e = do
let val = R.unsafeEventValue e
let mVal = case val of
"" -> Nothing
s -> Just s
T.modify_ (\s ->
s { datafield = Just (External (PubMed p { api_key = mVal })) }) search
-- type PubmedInputProps = (
-- search :: T.Box Search
-- , session :: Session
-- )
-- pubmedInput :: R2.Component PubmedInputProps
-- pubmedInput = R.createElement pubmedInputCpt
-- pubmedInputCpt :: R.Component PubmedInputProps
-- pubmedInputCpt = here.component "pubmedInput" cpt where
-- cpt { search, session } _ = do
-- search' <- T.useLive T.unequal search
-- case search'.datafield of
-- Just (External (PubMed p@{ api_key })) ->
-- -- TODO Fetch current API key
-- pure $
-- H.div { className: "form-group p-1 m-0" }
-- [ H.div { className: "text-primary center" } [ H.text "Pubmed API key" ]
-- , H.input { className: "form-control"
-- , defaultValue: fromMaybe "" api_key
-- , on: { blur: modifyPubmedAPIKey search p
-- , change: modifyPubmedAPIKey search p
-- , input: modifyPubmedAPIKey search p } } ]
-- _ -> pure $ H.div {} []
-- where
-- modifyPubmedAPIKey search p e = do
-- let val = R.unsafeEventValue e
-- let mVal = case val of
-- "" -> Nothing
-- s -> Just s
-- T.modify_ (\s ->
-- s { datafield = Just (External (PubMed p { api_key = mVal })) }) search
type OrgInputProps =
......@@ -485,9 +475,9 @@ datafieldInputCpt = here.component "datafieldInput" cpt where
then databaseInput { databases, search, session } []
else H.div {} []
, if isPubmed search'.datafield
then pubmedInput { search, session } []
else H.div {} []
-- , if isPubmed search'.datafield
-- then pubmedInput { search, session } []
-- else H.div {} []
, if isHAL search'.datafield
then orgInput { orgs: allOrgs, search } []
......@@ -540,7 +530,7 @@ searchInputCpt = here.component "searchInput" cpt
, className: "form-control"
, defaultValue: R.readRef valueRef
, placeholder: "Your query here"
, type: "text"
, type: "text"
, required: true }
]
......
......@@ -2,7 +2,9 @@ module Gargantext.Components.Forest.Tree.Node.Action.Search.Types where
import Gargantext.Prelude
-- import Data.Bounded (class Bounded)
import Data.Either (Either)
-- import Data.Enum (class Enum, class BoundedEnum)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Newtype (class Newtype)
......@@ -70,9 +72,10 @@ instance Doc DataField where
doc Files = "Zip files with formats.."
derive instance Eq DataField
instance JSON.WriteForeign DataField where
writeImpl (External db) = JSON.writeImpl { tag: "External"
, contents: JSON.writeImpl db }
writeImpl f = JSON.writeImpl $ JSON.writeImpl { tag: show f }
writeImpl (External db) = JSON.writeImpl { "External": JSON.writeImpl $ show db }
writeImpl Gargantext = JSON.writeImpl "Gargantext"
writeImpl Web = JSON.writeImpl "Web"
writeImpl Files = JSON.writeImpl "Files"
----------------------------------------
data DataOriginApi = InternalOrigin { api :: Database }
......@@ -97,22 +100,9 @@ datafield2database :: DataField -> Database
datafield2database (External x) = x
datafield2database _ = Empty
allDatabases :: Array Database
allDatabases = [ Empty
, PubMed { api_key: Nothing }
-- , Arxiv
, HAL Nothing
, IsTex
-- , IsTex_Advanced
-- , Isidore
--, Web
--, News
--, SocialNetworks
]
data Database = All_Databases
| Empty
| PubMed { api_key :: Maybe String }
| PubMed
| Arxiv
| HAL (Maybe Org)
| IsTex
......@@ -121,9 +111,12 @@ data Database = All_Databases
-- | News
-- | SocialNetworks
derive instance Generic Database _
-- derive instance Enum Database
-- derive instance Bounded Database
-- derive instance BoundedEnum Database
instance Show Database where
show All_Databases = "All Databases"
show (PubMed _) = "PubMed"
show PubMed = "PubMed"
show Arxiv = "Arxiv"
show (HAL _) = "HAL"
show IsTex = "IsTex"
......@@ -135,7 +128,7 @@ instance Show Database where
instance Doc Database where
doc All_Databases = "All databases"
doc (PubMed _) = "All Medical publications"
doc PubMed = "All Medical publications"
doc Arxiv = "Arxiv"
doc (HAL _) = "All open science (archives ouvertes)"
doc IsTex = "All Elsevier enriched by CNRS/INIST"
......@@ -159,9 +152,26 @@ instance Doc Database where
-- -- read "Social Networks" = Just SocialNetworks
-- read _ = Nothing
derive instance Eq Database
instance JSON.WriteForeign Database where
writeImpl f = JSON.writeImpl $ show f
allDatabases :: Array Database
allDatabases = [ Empty
, PubMed
-- , Arxiv
, HAL Nothing
, IsTex
-- , IsTex_Advanced
-- , Isidore
--, Web
--, News
--, SocialNetworks
]
dbToInputValue :: Database -> String
dbToInputValue All_Databases = "all_databases"
dbToInputValue (PubMed _) = "pubmed"
dbToInputValue PubMed = "pubmed"
dbToInputValue Arxiv = "arxiv"
dbToInputValue (HAL _) = "hal"
dbToInputValue IsTex = "istex"
......@@ -171,7 +181,7 @@ dbToInputValue Empty = "empty"
dbFromInputValue :: String -> Maybe Database
dbFromInputValue "all_databases" = Just All_Databases
dbFromInputValue "pubmed" = Just (PubMed { api_key: Nothing})
dbFromInputValue "pubmed" = Just PubMed
dbFromInputValue "arxiv" = Just Arxiv
dbFromInputValue "hal" = Just (HAL Nothing)
dbFromInputValue "istex" = Just IsTex
......@@ -180,12 +190,6 @@ dbFromInputValue "isidore" = Just Isidore
dbFromInputValue "empty" = Just Empty
dbFromInputValue _ = Nothing
derive instance Eq Database
instance JSON.WriteForeign Database where
writeImpl (PubMed { api_key }) = JSON.writeImpl { tag: "PubMed"
, _api_key: api_key }
writeImpl f = JSON.writeImpl { tag: show f }
------------------------------------------------------------------------
-- | Organization specifications
......
......@@ -16,7 +16,7 @@ import Gargantext.Components.GraphQL.IMT as GQLIMT
import Gargantext.Components.GraphQL.NLP as GQLNLP
import Gargantext.Components.GraphQL.Node as GQLNode
import Gargantext.Components.GraphQL.Tree (TreeFirstLevel)
import Gargantext.Components.GraphQL.User (User, UserInfo, UserInfoM)
import Gargantext.Components.GraphQL.User (User, UserInfo, UserInfoM, UserPubmedAPIKeyM)
import Gargantext.Components.GraphQL.Team (Team, TeamDeleteM)
import Gargantext.Ends (Backend(..))
import Gargantext.Sessions (Session(..))
......@@ -90,5 +90,6 @@ type Schema
type Mutation
= { update_user_info :: UserInfoM ==> Int
, update_user_pubmed_api_key :: UserPubmedAPIKeyM ==> Int
, delete_team_membership :: TeamDeleteM ==> Array Int
, update_node_context_category :: GQLCTX.NodeContextCategoryM ==> Array Int }
......@@ -17,7 +17,7 @@ import Gargantext.Components.GraphQL.NLP as GQLNLP
import Gargantext.Components.GraphQL.Node (Corpus, Node, nodeParentQuery, nodesQuery, nodesCorpusQuery)
import Gargantext.Components.GraphQL.Team (Team, teamQuery)
import Gargantext.Components.GraphQL.Tree (TreeFirstLevel, treeFirstLevelQuery)
import Gargantext.Components.GraphQL.User (UserInfo, userInfoQuery)
import Gargantext.Components.GraphQL.User (UserInfo, userInfoQuery, User, userQuery)
import Gargantext.Components.Lang (Lang)
import Gargantext.Config.REST (RESTError(..), AffRESTError)
import Gargantext.Core.NgramsTable.Types (NgramsTerm(..))
......@@ -64,6 +64,24 @@ getNodeParent session nodeId parentType = do
liftEffect $ here.log2 "[getNodeParent] node_parent" node_parent
pure node_parent
getUser :: Session -> Int -> AffRESTError User
getUser session id = do
{ users } <- queryGql session "get user" $ userQuery `withVars` { id }
liftEffect $ here.log2 "[getUser] users" users
pure $ case A.head users of
Nothing -> Left (CustomError $ "user with id " <> show id <> " not found")
Just u -> Right u
updateUserPubmedAPIKey :: Session -> Int -> String -> AffRESTError Unit
updateUserPubmedAPIKey session user_id api_key = do
client <- liftEffect $ getClient session
{ update_user_pubmed_api_key } <- mutation
client
"update_user_pubmed_api_key"
{ update_user_pubmed_api_key: onlyArgs { user_id
, api_key } }
pure $ Right unit
getUserInfo :: Session -> Int -> AffRESTError UserInfo
getUserInfo session id = do
{ user_infos } <- queryGql session "get user infos" $ userInfoQuery `withVars` { id }
......
......@@ -13,7 +13,6 @@ type Corpus
= { id :: Int
, name :: String
, parent_id :: Int
, pubmedAPIKey :: Maybe String
, type_id :: Int }
type Node
......@@ -28,7 +27,6 @@ type NodesCorpusQuery =
{ id :: Unit
, name :: Unit
, parent_id :: Unit
, pubmedAPIKey :: Unit
, type_id :: Unit } }
type NodesQuery =
......
......@@ -131,6 +131,9 @@ _ui_cwDescription = lens getter setter
getter ({ui_cwDescription: val}) = fromMaybe "" val
setter ui val = ui { ui_cwDescription = Just val }
type User
= { u_id :: Int
, u_hyperdata ::
......@@ -144,11 +147,38 @@ type User
, "where" :: Array
{ organization :: Array String }
}
, pubmed_api_key :: Maybe String
}
, u_username :: String
, u_email :: String
}
showUser { u_id
, u_username
, u_email } = "[" <> show u_id <> "] " <> u_username <> " :: " <> u_email
showMUser u = maybe "" showUser u
userQuery = { users: { user_id: Var :: _ "id" Int } =>>
{ u_id: unit
, u_hyperdata:
{ shared:
{ title: unit
, source: unit
, who:
{ firstName: unit
, lastName: unit
}
, "where": { organization: unit }
}
, pubmed_api_key: unit
}
, u_username: unit
, u_email: unit
}
}
type UserPubmedAPIKeyM =
{ user_id :: Int
, api_key :: String }
......@@ -15,7 +15,7 @@ import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.App.Store (Boxes)
import Gargantext.Components.GraphQL (getClient)
import Gargantext.Components.GraphQL.Endpoints (getUserInfo)
import Gargantext.Components.GraphQL.Endpoints (getUserInfo, getUser, updateUserPubmedAPIKey)
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, _ui_cwDescription)
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Nodes.Annuaire.Tabs as Tabs
......@@ -26,7 +26,7 @@ import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Sessions (Session(..), WithSession, WithSessionContext, sessionId)
import Gargantext.Types (FrontendError)
import Gargantext.Types (CorpusId, FrontendError)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import GraphQL.Client.Args (IgnoreArg(..), OrArg(..), onlyArgs)
......@@ -72,7 +72,7 @@ listElement = H.li { className: "list-group-item justify-content-between" }
type LayoutNoSessionProps =
( boxes :: Boxes
, frontends :: Frontends
, nodeId :: Int
, nodeId :: CorpusId
)
type LayoutProps = WithSession LayoutNoSessionProps
......@@ -112,7 +112,8 @@ userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt where
, render: \userInfo@{ ui_username } ->
H.ul { className: "col-md-12 list-group" } [
display { title: fromMaybe "no name" (Just ui_username) }
(contactInfos userInfo (onUpdateUserInfo boxes.errors reload))
(contactInfos userInfo (onUpdateUserInfo boxes.errors reload))
, pubmedSettings { boxes, nodeId, session }
, Tabs.tabs {
boxes
, cacheState
......@@ -154,6 +155,68 @@ userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt where
------------------------------------------------------------
type PubmedSettingsProps =
( boxes :: Boxes
, nodeId :: CorpusId
, session :: Session )
pubmedSettings :: R2.Leaf PubmedSettingsProps
pubmedSettings = R2.leaf pubmedSettingsCpt
pubmedSettingsCpt :: R.Component PubmedSettingsProps
pubmedSettingsCpt = here.component "pubmedSettings" cpt where
cpt { boxes
, nodeId
, session } _ = do
useLoader { errorHandler
, loader: \_ -> getUser session nodeId
, path: unit
, render: \user -> pubmedSettingsLoaded { boxes
, nodeId
, mPubmedAPIKey: user.u_hyperdata.pubmed_api_key
, session } }
where
errorHandler = logRESTError here "[pubmedSettings]"
type PubmedSettingsLoadedProps =
( mPubmedAPIKey :: Maybe String
| PubmedSettingsProps )
pubmedSettingsLoaded :: R2.Leaf PubmedSettingsLoadedProps
pubmedSettingsLoaded = R2.leaf pubmedSettingsLoadedCpt
pubmedSettingsLoadedCpt :: R.Component PubmedSettingsLoadedProps
pubmedSettingsLoadedCpt = here.component "pubmedSettingsLoaded" cpt where
cpt { boxes: { errors }
, nodeId
, mPubmedAPIKey
, session } _ = do
box <- T.useBox $ fromMaybe "" mPubmedAPIKey
isEditing <- T.useBox false
pure $ R2.row
[ R2.col 12
[ R2.col 12
[ R2.row
[ H.h2 {} [ H.text "PubMed settings" ] ]
, H.div { className: "form-group row"}
[ H.span { className: "col-sm-2 col-form-label" } [ H.text "API Key" ]
, H.div { className: "input-group col-sm-6"}
[ itemEditable { defaultVal: ""
, isEditing
, onUpdate: \s -> do
here.log2 "[pubmedSettingsLoaded] new api key" s
case s of
"" -> pure unit
_ -> do
launchAff_ $ do
res <- updateUserPubmedAPIKey session nodeId s
handleRESTError here errors res $ \_result ->
liftEffect $ here.log "[pubmedSettingsLoaded] api key updated"
, valueBox: box }]
]
]
]
]
-- | TODO format data in better design (UI) shape
contactInfos :: UserInfo -> (UserInfo -> Effect Unit) -> Array R.Element
contactInfos userInfo onUpdateUserInfo = item <$> contactInfoItems where
......@@ -192,31 +255,47 @@ 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
cLens = L.cloneLens lens
valueBox <- T.useBox value
let onUpdate val = do
let newUserInfo = (L.set cLens val userInfo) :: UserInfo
onUpdateUserInfo newUserInfo
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 }
, itemEditable { defaultVal, isEditing, onUpdate, valueBox }
]
where
cLens = L.cloneLens lens
type ItemProps =
( defaultVal :: String
, isEditing :: T.Box Boolean
, lens :: UserInfoLens
, onUpdateUserInfo :: UserInfo -> Effect Unit
, userInfo :: UserInfo
, onUpdate :: String -> Effect Unit
-- , lens :: UserInfoLens
-- , onUpdateUserInfo :: UserInfo -> Effect Unit
-- , userInfo :: UserInfo
, valueBox :: T.Box String
)
itemEditable :: R2.Leaf ItemProps
itemEditable = R2.leaf itemEditableCpt
itemEditableCpt :: R.Component ItemProps
itemEditableCpt = here.component "itemEditable" cpt where
cpt props@{ isEditing } _ = do
isEditing' <- T.useLive T.unequal isEditing
pure $ R.fragment
[ if isEditing' then
itemEditing props
else
itemNotEditing props
]
itemNotEditing :: R2.Leaf ItemProps
itemNotEditing = R2.leaf itemNotEditingCpt
itemNotEditingCpt :: R.Component ItemProps
......@@ -238,7 +317,8 @@ itemEditing :: R2.Leaf ItemProps
itemEditing = R2.leaf itemEditingCpt
itemEditingCpt :: R.Component ItemProps
itemEditingCpt = here.component "itemNotEditing" cpt where
cpt { defaultVal, isEditing, lens, onUpdateUserInfo, userInfo, valueBox } _ = do
-- cpt { defaultVal, isEditing, lens, onUpdateUserInfo, userInfo, valueBox } _ = do
cpt { defaultVal, isEditing, onUpdate, valueBox } _ = do
valueBox' <- T.useLive T.unequal valueBox
pure $ H.div { className: "input-group col-sm-6" }
......@@ -252,19 +332,17 @@ itemEditingCpt = here.component "itemNotEditing" cpt where
here.log2 "[itemEditingCpt] value Changed: " v
T.write_ v valueBox
, placeholder: defaultVal
, type: "text"
, type: "text"
, required: false }
, 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
onUpdate value
-- saveContactHyperdata :: Session -> Int -> HyperdataContact -> AffRESTError Int
......
......@@ -432,12 +432,12 @@ data Replace a
| Replace { old :: a, new :: a }
derive instance Generic (Replace a) _
derive instance Eq a => Eq (Replace a)
instance Eq a => Semigroup (Replace a) where
instance (Eq a, Show a) => Semigroup (Replace a) where
append Keep p = p
append p Keep = p
append (Replace { old }) (Replace { new }) | old /= new = unsafeThrow "old != new"
append (Replace { old }) (Replace { new }) | old /= new = unsafeThrow $ "old != new: " <> show old <> " != " <> show new
append (Replace { new }) (Replace { old }) = replace old new
instance Eq a => Monoid (Replace a) where mempty = Keep
instance (Eq a, Show a) => Monoid (Replace a) where mempty = Keep
instance JSON.WriteForeign a => JSON.WriteForeign (Replace a) where
writeImpl Keep = JSON.writeImpl { tag: "Keep" }
writeImpl (Replace {old, new}) = JSON.writeImpl { old, new, tag: "Replace" }
......
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