[search] implement pubmed api key in user settings

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