From a444cb3000bbc36c1328d7d7788257a557d0abc8 Mon Sep 17 00:00:00 2001 From: Alfredo Di Napoli <alfredo@well-typed.com> Date: Fri, 16 Jun 2023 15:57:13 +0200 Subject: [PATCH] Revert "Merge remote-tracking branch 'origin/201-dev-user-pubmed-api-key' into dev" This reverts commit d04cf03b00ed6c8ba8bd685044b897e4df701eee, reversing changes made to e213a4bfe8a4be983f4a9be2f6a62308e6b27d6f. --- src/Gargantext/API/GraphQL.hs | 2 - src/Gargantext/API/GraphQL/Node.hs | 64 +++---------------- src/Gargantext/API/Node/Corpus/New.hs | 2 +- src/Gargantext/API/Node/Corpus/Types.hs | 45 +++++++------ src/Gargantext/API/Table.hs | 10 +-- src/Gargantext/Core/Viz/Phylo/API/Tools.hs | 2 +- .../Database/Admin/Types/Hyperdata/Corpus.hs | 22 +++---- src/Gargantext/Database/Query/Table/Node.hs | 26 -------- 8 files changed, 50 insertions(+), 123 deletions(-) diff --git a/src/Gargantext/API/GraphQL.hs b/src/Gargantext/API/GraphQL.hs index 840c83a8..fc03e340 100644 --- a/src/Gargantext/API/GraphQL.hs +++ b/src/Gargantext/API/GraphQL.hs @@ -76,7 +76,6 @@ data Query m , job_logs :: GQLAT.JobLogArgs -> m (Map Int JobLog) , languages :: GQLNLP.LanguagesArgs -> m GQLNLP.LanguagesMap , nodes :: GQLNode.NodeArgs -> m [GQLNode.Node] - , nodes_corpus :: GQLNode.CorpusArgs -> m [GQLNode.Corpus] , node_parent :: GQLNode.NodeParentArgs -> m [GQLNode.Node] , user_infos :: GQLUserInfo.UserInfoArgs -> m [GQLUserInfo.UserInfo] , users :: GQLUser.UserArgs -> m [GQLUser.User m] @@ -121,7 +120,6 @@ rootResolver = , job_logs = GQLAT.resolveJobLogs , languages = GQLNLP.resolveLanguages , nodes = GQLNode.resolveNodes - , nodes_corpus = GQLNode.resolveNodesCorpus , node_parent = GQLNode.resolveNodeParent , user_infos = GQLUserInfo.resolveUserInfos , users = GQLUser.resolveUsers diff --git a/src/Gargantext/API/GraphQL/Node.hs b/src/Gargantext/API/GraphQL/Node.hs index c84c3fb2..71c509bb 100644 --- a/src/Gargantext/API/GraphQL/Node.hs +++ b/src/Gargantext/API/GraphQL/Node.hs @@ -3,9 +3,7 @@ module Gargantext.API.GraphQL.Node where -import Data.Aeson import Data.Either (Either(..)) -import qualified Data.HashMap.Strict as HashMap import Data.Morpheus.Types ( GQLType , Resolver @@ -18,37 +16,23 @@ import Gargantext.API.Prelude (GargM, GargError) import Gargantext.Database.Admin.Types.Node (NodeId(..), NodeType) import qualified Gargantext.Database.Admin.Types.Node as NN import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, getNode) -import Gargantext.Database.Prelude (CmdCommon) -- , JSONB) +import Gargantext.Database.Prelude (CmdCommon) import qualified Gargantext.Database.Schema.Node as N import Gargantext.Prelude import GHC.Generics (Generic) import qualified Prelude -import qualified PUBMED.Types as PUBMED import Text.Read (readEither) -data Corpus = Corpus - { id :: Int - , name :: Text - , parent_id :: Maybe Int - , pubmedAPIKey :: Maybe PUBMED.APIKey - , type_id :: Int - } deriving (Show, Generic, GQLType) - data Node = Node - { id :: Int - , name :: Text - , parent_id :: Maybe Int - , type_id :: Int + { id :: Int + , name :: Text + , parent_id :: Maybe Int + , type_id :: Int } deriving (Show, Generic, GQLType) -data CorpusArgs - = CorpusArgs - { corpus_id :: Int - } deriving (Generic, GQLType) - data NodeArgs = NodeArgs - { node_id :: Int + { node_id :: Int } deriving (Generic, GQLType) type GqlM e env = Resolver QUERY e (GargM env GargError) @@ -59,11 +43,6 @@ resolveNodes => NodeArgs -> GqlM e env [Node] resolveNodes NodeArgs { node_id } = dbNodes node_id -resolveNodesCorpus - :: (CmdCommon env) - => CorpusArgs -> GqlM e env [Corpus] -resolveNodesCorpus CorpusArgs { corpus_id } = dbNodesCorpus corpus_id - dbNodes :: (CmdCommon env) => Int -> GqlM e env [Node] @@ -71,13 +50,6 @@ dbNodes node_id = do node <- lift $ getNode $ NodeId node_id pure [toNode node] -dbNodesCorpus - :: (CmdCommon env) - => Int -> GqlM e env [Corpus] -dbNodesCorpus corpus_id = do - corpus <- lift $ getNode $ NodeId corpus_id - pure [toCorpus corpus] - data NodeParentArgs = NodeParentArgs { node_id :: Int @@ -107,23 +79,7 @@ dbParentNodes node_id parent_type = do pure [toNode node] toNode :: NN.Node json -> Node -toNode N.Node { .. } = Node { id = NN.unNodeId _node_id - , name = _node_name - , parent_id = NN.unNodeId <$> _node_parent_id - , type_id = _node_typename } - -toCorpus :: NN.Node Value -> Corpus -toCorpus N.Node { .. } = Corpus { id = NN.unNodeId _node_id - , name = _node_name - , parent_id = NN.unNodeId <$> _node_parent_id - , pubmedAPIKey = pubmedAPIKeyFromValue _node_hyperdata - , type_id = _node_typename } - -pubmedAPIKeyFromValue :: Value -> Maybe PUBMED.APIKey -pubmedAPIKeyFromValue (Object kv) = - case HashMap.lookup "pubmed_api_key" kv of - Nothing -> Nothing - Just v -> case fromJSON v of - Error _ -> Nothing - Success v' -> Just v' -pubmedAPIKeyFromValue _ = Nothing +toNode (N.Node { .. }) = Node { id = NN.unNodeId _node_id + , name = _node_name + , parent_id = NN.unNodeId <$> _node_parent_id + , type_id = _node_typename } diff --git a/src/Gargantext/API/Node/Corpus/New.hs b/src/Gargantext/API/Node/Corpus/New.hs index 78c7cd18..98c43fc7 100644 --- a/src/Gargantext/API/Node/Corpus/New.hs +++ b/src/Gargantext/API/Node/Corpus/New.hs @@ -56,7 +56,7 @@ import Gargantext.Database.Action.User (getUserId) import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..)) import Gargantext.Database.Prelude (hasConfig) -import Gargantext.Database.Query.Table.Node (getNodeWith, updateCorpusPubmedAPIKey) +import Gargantext.Database.Query.Table.Node (getNodeWith) import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata) import Gargantext.Database.Schema.Node (node_hyperdata) import Gargantext.Prelude diff --git a/src/Gargantext/API/Node/Corpus/Types.hs b/src/Gargantext/API/Node/Corpus/Types.hs index 5f1d4a90..b6191d47 100644 --- a/src/Gargantext/API/Node/Corpus/Types.hs +++ b/src/Gargantext/API/Node/Corpus/Types.hs @@ -3,12 +3,18 @@ module Gargantext.API.Node.Corpus.Types where import Control.Lens hiding (elements, Empty) +import Control.Monad.Fail (fail) +import Control.Monad.Reader (MonadReader) import Data.Aeson import Data.Aeson.TH (deriveJSON) import Data.Monoid (mempty) import Data.Swagger +import Data.Text (Text) +import qualified Data.Text as T import GHC.Generics (Generic) +import Text.Regex.TDFA ((=~)) +import Protolude ((++)) import Gargantext.Prelude import qualified Gargantext.API.Admin.Orchestrator.Types as Types @@ -24,8 +30,7 @@ data Database = Empty deriving (Eq, Show, Generic, Enum, Bounded) deriveJSON (unPrefix "") ''Database -instance ToSchema Database where - declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions +instance ToSchema Database database2origin :: Database -> DataOrigin database2origin Empty = InternalOrigin Types.IsTex @@ -37,29 +42,27 @@ database2origin Isidore = ExternalOrigin Types.Isidore ------------------------------------------------------------------------ data Datafield = Gargantext - | External Database + | External (Maybe Database) | Web | Files deriving (Eq, Show, Generic) -instance FromJSON Datafield -instance ToJSON Datafield --- instance FromJSON Datafield where --- parseJSON = withText "Datafield" $ \text -> --- case text of --- "Gargantext" -> pure Gargantext --- "Web" -> pure Web --- "Files" -> pure Files --- v -> --- let (preExternal, _, postExternal) = v =~ ("External " :: Text) :: (Text, Text, Text) --- in --- if preExternal == "" then do --- db <- parseJSON $ String postExternal --- pure $ External db --- else fail $ "Cannot match patterh 'External <db>' for string " ++ (T.unpack v) --- instance ToJSON Datafield where --- toJSON (External db) = toJSON $ "External " ++ (show db) --- toJSON s = toJSON $ show s +instance FromJSON Datafield where + parseJSON = withText "Datafield" $ \text -> + case text of + "Gargantext" -> pure Gargantext + "Web" -> pure Web + "Files" -> pure Files + v -> + let (preExternal, _, postExternal) = v =~ ("External " :: Text) :: (Text, Text, Text) + in + if preExternal == "" then do + db <- parseJSON $ String postExternal + pure $ External db + else fail $ "Cannot match patterh 'External <db>' for string " ++ (T.unpack v) +instance ToJSON Datafield where + toJSON (External db) = toJSON $ "External " ++ (show db) + toJSON s = toJSON $ show s instance ToSchema Datafield where declareNamedSchema _ = do return $ NamedSchema (Just "Datafield") $ mempty diff --git a/src/Gargantext/API/Table.hs b/src/Gargantext/API/Table.hs index f5455135..562a0c2d 100644 --- a/src/Gargantext/API/Table.hs +++ b/src/Gargantext/API/Table.hs @@ -73,11 +73,11 @@ type TableApi = Summary "Table API" :> Get '[JSON] Text data TableQuery = TableQuery - { tq_offset :: Offset - , tq_limit :: Limit - , tq_orderBy :: OrderBy - , tq_view :: TabType - , tq_query :: Text + { tq_offset :: Offset + , tq_limit :: Limit + , tq_orderBy :: OrderBy + , tq_view :: TabType + , tq_query :: Text } deriving (Generic) type FacetTableResult = TableResult FacetDoc diff --git a/src/Gargantext/Core/Viz/Phylo/API/Tools.hs b/src/Gargantext/Core/Viz/Phylo/API/Tools.hs index 5c0c9991..74290b42 100644 --- a/src/Gargantext/Core/Viz/Phylo/API/Tools.hs +++ b/src/Gargantext/Core/Viz/Phylo/API/Tools.hs @@ -12,10 +12,10 @@ Portability : POSIX module Gargantext.Core.Viz.Phylo.API.Tools where +import Data.Proxy import Data.Aeson (Value, decodeFileStrict, eitherDecode, encode) import Data.Map.Strict (Map) import Data.Maybe (catMaybes) -import Data.Proxy import Data.Set (Set) import Data.Text (Text, pack) import Data.Time.Calendar (fromGregorian, diffGregorianDurationClip, cdMonths, diffDays, showGregorian) diff --git a/src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs b/src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs index 97f5d155..aa169a3a 100644 --- a/src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs +++ b/src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs @@ -24,26 +24,22 @@ module Gargantext.Database.Admin.Types.Hyperdata.Corpus import Gargantext.Prelude import Gargantext.Database.Admin.Types.Hyperdata.CorpusField import Gargantext.Database.Admin.Types.Hyperdata.Prelude -import PUBMED.Types (APIKey) ------------------------------------------------------------------------ data HyperdataCorpus = - HyperdataCorpus { _hc_fields :: ![HyperdataField CorpusField] - , _hc_pubmed_api_key :: Maybe APIKey } + HyperdataCorpus { _hc_fields :: ![HyperdataField CorpusField] } deriving (Generic) defaultHyperdataCorpus :: HyperdataCorpus defaultHyperdataCorpus = - HyperdataCorpus - { _hc_fields = [ HyperdataField Markdown - "Corpus analysis" - (MarkdownField "# title\n## subtitle") - - , HyperdataField JSON - "Metadata (Experts only)" - (JsonField "Title" "Descr" "Bool query" "Authors") - ] - , _hc_pubmed_api_key = Nothing } + HyperdataCorpus [ HyperdataField Markdown + "Corpus analysis" + (MarkdownField "# title\n## subtitle") + + , HyperdataField JSON + "Metadata (Experts only)" + (JsonField "Title" "Descr" "Bool query" "Authors") + ] ------------------------------------------------------------------------ ------------------------------------------------------------------------ diff --git a/src/Gargantext/Database/Query/Table/Node.hs b/src/Gargantext/Database/Query/Table/Node.hs index 8759c647..eae15a2b 100644 --- a/src/Gargantext/Database/Query/Table/Node.hs +++ b/src/Gargantext/Database/Query/Table/Node.hs @@ -29,7 +29,6 @@ import Data.Text (Text) import Database.PostgreSQL.Simple.SqlQQ (sql) import Opaleye hiding (FromField) import Prelude hiding (null, id, map, sum) -import qualified PUBMED.Types as PUBMED import Gargantext.Core import Gargantext.Core.Types @@ -328,31 +327,6 @@ insertNodesWithParent pid ns = insertNodes (set node_parent_id (pgNodeId <$> pid insertNodesWithParentR :: Maybe ParentId -> [NodeWrite] -> Cmd err [NodeId] insertNodesWithParentR pid ns = insertNodesR (set node_parent_id (pgNodeId <$> pid) <$> ns) - -getCorpusPubmedAPIKey :: NodeId -> Cmd err (Maybe PUBMED.APIKey) -getCorpusPubmedAPIKey cId = do - res <- runPGSQuery query params - pure $ (\(PGS.Only apiKey) -> apiKey) <$> head res - where - query :: PGS.Query - query = [sql| - SELECT hyperdata -> 'pubmed_api_key' - FROM nodes - WHERE id = ? - |] - params = PGS.Only cId - -updateCorpusPubmedAPIKey :: NodeId -> PUBMED.APIKey -> Cmd err Int64 -updateCorpusPubmedAPIKey cId apiKey = - execPGSQuery query params - where - query :: PGS.Query - query = [sql| - UPDATE nodes - SET hyperdata = hyperdata || ? - WHERE id = ? - |] - params = (encode $ object [ "pubmed_api_key" .= apiKey ], cId) ------------------------------------------------------------------------ -- TODO -- currently this function removes the child relation -- 2.21.0