Endpoints.purs 8.42 KB
Newer Older
1 2
module Gargantext.Components.GraphQL.Endpoints where

3 4
import Gargantext.Prelude

5 6 7
import Data.Array as A
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
8 9
import Data.Map as Map
import Data.Tuple (Tuple(..))
10 11
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
12
import Gargantext.Components.GraphQL (getClient, queryGql)
13 14
import Gargantext.Components.GraphQL.Contact (AnnuaireContact, annuaireContactQuery)
import Gargantext.Components.GraphQL.Context as GQLCTX
15
import Gargantext.Components.GraphQL.IMT as GQLIMT
16
import Gargantext.Components.GraphQL.NLP as GQLNLP
17
import Gargantext.Components.GraphQL.Node (Corpus, Node, nodeParentQuery, nodesQuery, nodesCorpusQuery)
Karen Konou's avatar
Karen Konou committed
18
import Gargantext.Components.GraphQL.Team (Team, teamQuery)
19
import Gargantext.Components.GraphQL.Tree (TreeFirstLevel, treeFirstLevelQuery, BreadcrumbInfo, breadcrumbQuery)
20
import Gargantext.Components.GraphQL.User (UserInfo, userInfoQuery, User, userQuery)
21
import Gargantext.Components.Lang (Lang)
22
import Gargantext.Config.REST (RESTError(..), AffRESTError, logRESTError)
23
import Gargantext.Core.NgramsTable.Types (NgramsTerm(..))
24
import Gargantext.Sessions (Session(..))
25
import Gargantext.Types (CorpusId, NodeType)
26
import Gargantext.Utils.Reactix as R2
27 28
import GraphQL.Client.Args (onlyArgs)
import GraphQL.Client.Query (mutation)
29 30 31 32 33
import GraphQL.Client.Variables (withVars)

here :: R2.Here
here = R2.here "Gargantext.Components.GraphQL.Endpoints"

34 35 36 37 38 39 40
getIMTSchools :: Session -> AffRESTError (Array GQLIMT.School)
getIMTSchools session = do
  { imt_schools } <- queryGql session "get imt schools" $
                         GQLIMT.schoolsQuery
  liftEffect $ here.log2 "[getIMTSchools] imt_schools" imt_schools
  pure $ Right imt_schools

41 42 43 44 45 46 47 48 49
getNode :: Session -> Int -> AffRESTError Node
getNode session nodeId = do
  { nodes } <- queryGql session "get nodes" $
              nodesQuery `withVars` { id: nodeId }
  liftEffect $ here.log2 "[getNode] node" nodes
  pure $ case A.head nodes of
    Nothing -> Left (CustomError $ "node with id" <> show nodeId <>" not found")
    Just node -> Right node

50 51 52 53 54 55 56 57 58
getNodeCorpus :: Session -> Int -> AffRESTError Corpus
getNodeCorpus session corpusId = do
  { nodes_corpus } <- queryGql session "get nodes corpus" $
                      nodesCorpusQuery `withVars` { id: corpusId }
  liftEffect $ here.log2 "[getNodesCorpus] nodes_corpus" nodes_corpus
  pure $ case A.head nodes_corpus of
    Nothing -> Left (CustomError $ "corpus with id" <> show corpusId <>" not found")
    Just corpus -> Right corpus

59 60 61 62 63 64
getNodeParent :: Session -> Int -> NodeType -> Aff (Array Node)
getNodeParent session nodeId parentType = do
  { node_parent } <- queryGql session "get node parent" $
                     nodeParentQuery `withVars` { id: nodeId
                                                , parent_type: show parentType }  -- TODO: remove "show"
  liftEffect $ here.log2 "[getNodeParent] node_parent" node_parent
65
  pure node_parent
66

67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
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

85
getUserInfo :: Session -> Int -> AffRESTError UserInfo
86 87 88 89 90 91 92
getUserInfo session id = do
  { user_infos } <- queryGql session "get user infos" $ userInfoQuery `withVars` { id }
  liftEffect $ here.log2 "[getUserInfo] user infos" user_infos
  pure $ case A.head user_infos of
    Nothing -> Left (CustomError $ "user with id " <> show id <> " not found")
    -- NOTE Contact is at G.C.N.A.U.C.Types
    Just ui -> Right ui
93

94 95 96 97 98 99 100 101 102
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

103 104 105 106 107
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
108

Karen Konou's avatar
Karen Konou committed
109
getTeam :: Session -> Int -> AffRESTError Team
110 111 112
getTeam session id = do
  { team } <- queryGql session "get team" $ teamQuery `withVars` { id }
  liftEffect $ here.log2 "[getTree] data" team
Karen Konou's avatar
Karen Konou committed
113
  pure $ Right team
114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129

type SharedFolderId = Int
type TeamNodeId = Int

deleteTeamMembership :: Session -> SharedFolderId -> TeamNodeId -> AffRESTError Int
deleteTeamMembership session sharedFolderId teamNodeId = do
  let token = getToken session
  client <- liftEffect $ getClient session
  { delete_team_membership } <- mutation
    client
    "delete_team_membership"
    { delete_team_membership: onlyArgs { token: token
                                       , shared_folder_id: sharedFolderId
                                       , team_node_id: teamNodeId } }
  pure $ case A.head delete_team_membership of
    Nothing -> Left (CustomError $ "Failed  to delete team membership. team node id=" <> show teamNodeId <> " shared folder id=" <> show sharedFolderId)
Karen Konou's avatar
Karen Konou committed
130
    Just _ -> Right sharedFolderId
131 132
  where
    getToken (Session { token }) = token
133 134 135

getNodeContext :: Session -> Int -> Int -> AffRESTError GQLCTX.NodeContext
getNodeContext session context_id node_id = do
136 137
  let query = GQLCTX.nodeContextQuery `withVars` { context_id, node_id }
  { contexts } <- queryGql session "get node context" query
138
  --liftEffect $ here.log2 "[getNodeContext] node context" contexts
139 140 141
  case A.head contexts of
    Nothing -> pure $ Left $ CustomError "no node context found"
    Just context -> pure $ Right context -- TODO: error handling
142

143
type ContextsForNgramsGQL = { contexts_for_ngrams :: Array GQLCTX.Context }
144
getContextsForNgrams :: Session -> CorpusId -> Array String -> AffRESTError (Array GQLCTX.Context)
145 146 147 148 149 150 151
getContextsForNgrams session corpus_id ngrams_terms = do
  let query = GQLCTX.contextsForNgramsQuery `withVars` { corpus_id
                                                       , ngrams_terms: GQLCTX.NgramsTerms ngrams_terms }
  { contexts_for_ngrams } <- queryGql session "get contexts for ngrams" query

  pure $ Right contexts_for_ngrams
  --pure $ Right contexts_for_ngrams
152

153 154 155 156 157 158 159 160 161 162 163 164
updateNodeContextCategory :: Session -> Int -> Int -> Int -> AffRESTError Int
updateNodeContextCategory session context_id node_id category = do
  client <- liftEffect $ getClient session
  { update_node_context_category } <- mutation
    client
    "update_node_context_category"
    { update_node_context_category: onlyArgs { context_id
                                             , node_id
                                             , category } }
  pure $ case A.head update_node_context_category of
    Nothing -> Left (CustomError $ "Failed to update node category")
    Just _ -> Right context_id
165 166 167 168 169 170 171 172 173

getLanguages :: Session -> AffRESTError (Map.Map Lang GQLNLP.LanguageProperties)
getLanguages session = do
  let query = GQLNLP.nlpQuery
  { languages } <- queryGql session "get languages" query

  liftEffect $ here.log2 "[getLanguages] languages" languages

  pure $ Right $ Map.fromFoldable $ (\{ key, value } -> Tuple key value) <$> languages
174 175 176 177 178 179 180

getContextNgrams :: Session -> Int -> Int -> AffRESTError (Array NgramsTerm)
getContextNgrams session context_id list_id = do
  client <- liftEffect $ getClient session
  let query = GQLCTX.contextNgramsQuery `withVars` { context_id, list_id }
  { context_ngrams } <- queryGql session "get context ngrams" query
  pure $ Right $ NormNgramsTerm <$> context_ngrams
181 182 183 184 185 186

getBreadcrumb :: Session -> Int -> AffRESTError BreadcrumbInfo
getBreadcrumb session id = do
  { tree_branch } <- queryGql session "get breadcrumb branch" $ breadcrumbQuery `withVars` { id }
  liftEffect $ here.log2 "[getBreadcrumb] breadcrumb" tree_branch
  pure $ Right tree_branch