Revert "Merge remote-tracking branch 'origin/201-dev-user-pubmed-api-key' into dev"

This reverts commit d04cf03b, reversing
changes made to e213a4bf.

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

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 }

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

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

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

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)

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")
+                  ]
 
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------

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