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

3 4
import Gargantext.Prelude

5
import Affjax.RequestHeader as ARH
6 7 8
import Data.Argonaut.Decode (JsonDecodeError)
import Data.Bifunctor (lmap)
import Data.List.Types (NonEmptyList)
9
import Effect (Effect)
10
import Effect.Aff (Aff)
11
import Effect.Class (liftEffect)
12
import Foreign (unsafeToForeign, ForeignError)
13 14
import Gargantext.Components.GraphQL.Contact (AnnuaireContact)
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 as GQLNode
18
import Gargantext.Components.GraphQL.Tree (TreeFirstLevel)
19
import Gargantext.Components.GraphQL.User (User, UserInfo, UserInfoM)
Karen Konou's avatar
Karen Konou committed
20
import Gargantext.Components.GraphQL.Team (Team, TeamDeleteM)
Karen Konou's avatar
Karen Konou committed
21
import Gargantext.Ends (Backend(..))
22
import Gargantext.Sessions (Session(..))
23
import Gargantext.Utils.Reactix as R2
24
import GraphQL.Client.Args (type (==>))
25 26 27
import GraphQL.Client.BaseClients.Urql (UrqlClient, createClient)
import GraphQL.Client.Query (queryWithDecoder)
import GraphQL.Client.Types (class GqlQuery, Client, class QueryClient)
28
import Simple.JSON as JSON
29
import Unsafe.Coerce (unsafeCoerce)
30 31 32 33 34


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

35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52
--client :: Client AffjaxClient Schema Void Void
--client = Client $ AffjaxClient "http://localhost:8008/gql" []

-- | Run a graphQL query with a custom decoder and custom options
gqlQuery ::
  forall client schema query returns a b queryOpts mutationOpts.
  QueryClient client queryOpts mutationOpts =>
  GqlQuery schema query returns =>
  JSON.ReadForeign returns =>
  --(queryOpts -> queryOpts) ->
  (Client client schema a b) ->
  String ->
  query ->
  Aff returns
gqlQuery = queryWithDecoder  (unsafeToForeign >>> JSON.read >>> lmap toJsonError)

toJsonError :: NonEmptyList ForeignError -> JsonDecodeError
toJsonError = unsafeCoerce  -- map ForeignErrors to JsonDecodeError as you wish
53

54
getClient :: Session -> Effect (Client UrqlClient Schema Mutation Void)
Karen Konou's avatar
Karen Konou committed
55
getClient (Session { token, backend: Backend b }) = createClient { headers, url: b.baseUrl <> "/gql" }
56 57
  where
    headers = [ ARH.RequestHeader "Authorization" $ "Bearer " <> token ]
58

59 60 61
queryGql ::
  forall query returns.
  GqlQuery Schema query returns =>
62
  JSON.ReadForeign returns =>
63 64 65 66 67
     Session
  -> String
  -> query
  -> Aff returns
queryGql session name q = do
68
  --query client name q
69
  client <- liftEffect $ getClient session
70
  gqlQuery (client :: Client UrqlClient Schema Mutation Void) name q
71 72

  --query_ "http://localhost:8008/gql" (Proxy :: Proxy Schema)
73 74 75

-- Schema
type Schema
76
  = { annuaire_contacts :: { contact_id :: Int } ==> Array AnnuaireContact
77
    , contexts :: { context_id :: Int, node_id :: Int } ==> Array GQLCTX.NodeContext
78
    , contexts_for_ngrams :: { corpus_id :: Int, ngrams_terms :: Array String } ==> Array GQLCTX.Context
79
    , imt_schools :: {} ==> Array GQLIMT.School
80
    , languages :: {} ==> Array GQLNLP.Language
81 82 83
    , node_parent :: { node_id :: Int, parent_type :: String } ==> Array GQLNode.Node  -- TODO: parent_type :: NodeType
    , nodes :: { node_id :: Int } ==> Array GQLNode.Node
    , nodes_corpus :: { corpus_id :: Int } ==> Array GQLNode.Corpus
84
    , user_infos :: { user_id :: Int } ==> Array UserInfo
85
    , users :: { user_id :: Int } ==> Array User
Karen Konou's avatar
Karen Konou committed
86
    , team :: { team_node_id :: Int } ==> Team
87
    , tree :: { root_id :: Int } ==> TreeFirstLevel
88
    }
89 90

type Mutation
91
  = { update_user_info :: UserInfoM ==> Int
92 93
    , delete_team_membership :: TeamDeleteM ==> Array Int
    , update_node_context_category :: GQLCTX.NodeContextCategoryM ==> Array Int }