Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Grégoire Locqueville
purescript-gargantext
Commits
0f22711d
Commit
0f22711d
authored
Oct 21, 2021
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[graphql] more user work
parent
4565f557
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
145 additions
and
60 deletions
+145
-60
GraphQL.purs
src/Gargantext/Components/GraphQL.purs
+30
-10
AffjaxSimpleJSONClient.purs
...Gargantext/Components/GraphQL/AffjaxSimpleJSONClient.purs
+46
-45
User.purs
src/Gargantext/Components/GraphQL/User.purs
+29
-2
User.purs
src/Gargantext/Components/Nodes/Annuaire/User.purs
+40
-3
No files found.
src/Gargantext/Components/GraphQL.purs
View file @
0f22711d
module Gargantext.Components.GraphQL where
--import Data.Argonaut.Decode (class DecodeJson)
import Data.Argonaut.Decode (JsonDecodeError)
import Data.Bifunctor (lmap)
import Data.List.Types (NonEmptyList)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import
Gargantext.Components.GraphQL.AffjaxSimpleJSONClient (AffjaxClient(..)
)
import Gargantext.Components.GraphQL.User
import
Foreign (unsafeToForeign, ForeignError
)
import Gargantext.Components.GraphQL.User
(User)
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
import GraphQL.Client.Args (type (==>))
--import GraphQL.Client.BaseClients.Urql
import GraphQL.Client.Query (query)
import GraphQL.Client.Types (class GqlQuery, Client
(..)
)
import GraphQL.Client.BaseClients.Urql (UrqlClient, createClient)
import GraphQL.Client.Query (query
WithDecoder
)
import GraphQL.Client.Types (class GqlQuery, Client
, class QueryClient
)
import Simple.JSON as JSON
import Unsafe.Coerce (unsafeCoerce)
here :: R2.Here
here = R2.here "Gargantext.Components.GraphQL"
client :: Client AffjaxClient Schema Void Void
client = Client $ AffjaxClient "http://localhost:8008/gql" []
--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
queryGql ::
forall query returns.
...
...
@@ -26,9 +45,10 @@ queryGql ::
JSON.ReadForeign returns =>
String -> query -> Aff returns
queryGql name q = do
--query client name q
client <- liftEffect $ createClient { headers: [], url: "http://localhost:8008/gql" }
gqlQuery (client :: Client UrqlClient Schema Void Void) name q
--client <- liftEffect $ createClient { headers: [], url: "http://localhost:8008/gql" }
query client name q
--query_ "http://localhost:8008/gql" (Proxy :: Proxy Schema)
-- Schema
...
...
src/Gargantext/Components/GraphQL/AffjaxSimpleJSONClient.purs
View file @
0f22711d
...
...
@@ -21,48 +21,49 @@ import Simple.JSON as JSON
data AffjaxClient
= AffjaxClient URL (Array RequestHeader)
instance queryClient :: QueryClient AffjaxClient Unit Unit where
clientQuery _ (AffjaxClient url headers) name q vars = throwLeft =<< convertJsonResponse =<< queryPostForeign "query" url headers name q vars
clientMutation _ (AffjaxClient url headers) name q vars = throwLeft =<< convertJsonResponse =<< queryPostForeign "mutation" url headers name q vars
defQueryOpts = const unit
defMutationOpts = const unit
throwLeft :: forall r body. Either Error { body :: body | r } -> Aff body
throwLeft = case _ of
Left err -> throwError $ error $ printError err
Right { body } -> pure body
queryPostForeign ::
forall d.
JSON.WriteForeign d =>
String -> URL -> Array RequestHeader -> String -> String -> d -> Aff (Either Error (Response String))
queryPostForeign opStr url headers queryName q vars = do
request
defaultRequest
{ withCredentials = true
, url = url
, method = Left Method.POST
--, responseFormat = ResponseFormat.json
, responseFormat = ResponseFormat.string
, content =
Just
-- $ RequestBody.Json
-- $ encodeJson
$ RequestBody.String
$ JSON.writeJSON
{ query: opStr <> " " <> queryName <> " " <> q
, variables: vars
, operationName: queryName
}
, headers = headers <> [ ContentType applicationJSON ]
}
convertJsonResponse :: Either Error (Response String) -> Aff (Either Error (Response Json))
convertJsonResponse (Left err) = pure $ Left err
convertJsonResponse (Right res@{ body }) = pure $ case JSON.readJSON body of
Left err -> Left $ ResponseBodyError (DLN.head err) (res { body = unsafeToForeign body })
Right body' -> Right $ res { body = toJSON body' }
foreign import toJSON :: forall d. JSON.ReadForeign d => d -> Json
--
-- instance queryClient :: QueryClient AffjaxClient Unit Unit where
-- clientQuery _ (AffjaxClient url headers) name q vars = throwLeft =<< convertJsonResponse =<< queryPostForeign "query" url headers name q vars
-- clientMutation _ (AffjaxClient url headers) name q vars = throwLeft =<< convertJsonResponse =<< queryPostForeign "mutation" url headers name q vars
-- defQueryOpts = const unit
-- defMutationOpts = const unit
--
-- throwLeft :: forall r body. Either Error { body :: body | r } -> Aff body
-- throwLeft = case _ of
-- Left err -> throwError $ error $ printError err
-- Right { body } -> pure body
--
-- queryPostForeign ::
-- forall d.
-- JSON.WriteForeign d =>
-- String -> URL -> Array RequestHeader -> String -> String -> d -> Aff (Either Error (Response String))
-- queryPostForeign opStr url headers queryName q vars = do
-- request
-- defaultRequest
-- { withCredentials = true
-- , url = url
-- , method = Left Method.POST
-- --, responseFormat = ResponseFormat.json
-- , responseFormat = ResponseFormat.string
-- , content =
-- Just
-- -- $ RequestBody.Json
-- -- $ encodeJson
-- $ RequestBody.String
-- $ JSON.writeJSON
-- { query: opStr <> " " <> queryName <> " " <> q
-- , variables: vars
-- , operationName: queryName
-- }
-- , headers = headers <> [ ContentType applicationJSON ]
-- }
--
-- convertJsonResponse :: Either Error (Response String) -> Aff (Either Error (Response Json))
-- convertJsonResponse (Left err) = pure $ Left err
-- convertJsonResponse (Right res@{ body }) = pure $ case JSON.readJSON body of
-- Left err -> Left $ ResponseBodyError (DLN.head err) (res { body = unsafeToForeign body })
-- Right body' -> Right $ res { body = toJSON body' }
--
-- foreign import toJSON :: forall d. JSON.ReadForeign d => d -> Json
--
--
src/Gargantext/Components/GraphQL/User.purs
View file @
0f22711d
module Gargantext.Components.GraphQL.User where
import Data.Maybe (Maybe(..), maybe)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (HyperdataUser)
import Gargantext.Prelude
import Type.Proxy (Proxy(..))
type User
= { u_id :: Int
, u_hyperdata :: HyperdataUser
, u_hyperdata ::
{ _hu_shared :: Maybe
{ _hc_title :: Maybe String
, _hc_source :: Maybe String
, _hc_who :: Maybe
{ _cw_firstName :: Maybe String
, _cw_lastName :: Maybe String
}
, _hc_where :: Array
{ _cw_organization :: Array String }
}
}
, u_username :: String
, u_email :: String
}
...
...
@@ -26,3 +36,20 @@ u_username :: Proxy "u_username"
u_username = Proxy
u_email :: Proxy "u_email"
u_email = Proxy
_hu_shared :: Proxy "shared"
_hu_shared = Proxy
_hc_source :: Proxy "_hc_source"
_hc_source = Proxy
_hc_title :: Proxy "_hc_title"
_hc_title = Proxy
_hc_who :: Proxy "_hc_who"
_hc_who = Proxy
_hc_where :: Proxy "_cw_where"
_hc_where = Proxy
_cw_firstName :: Proxy "_cw_firstName"
_cw_firstName = Proxy
_cw_lastName :: Proxy "_cw_lastName"
_cw_lastName = Proxy
_cw_organization :: Proxy "_cw_organization"
_cw_organization = Proxy
src/Gargantext/Components/Nodes/Annuaire/User.purs
View file @
0f22711d
...
...
@@ -4,6 +4,7 @@ module Gargantext.Components.Nodes.Annuaire.User
)
where
import Gargantext.Components.GraphQL.User
import Gargantext.Prelude
import Data.Array as A
...
...
@@ -15,7 +16,6 @@ import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.GraphQL (queryGql)
import Gargantext.Components.GraphQL.User
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Nodes.Annuaire.Tabs as Tabs
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
...
...
@@ -245,16 +245,53 @@ getUser session id = do
{ users } <- queryGql "get user"
{ users: { user_id: id } =>>
{ u_id
, u_hyperdata
, u_hyperdata:
{ _hu_shared:
{ _hc_title
, _hc_source
, _hc_who:
{ _cw_firstName
, _cw_lastName }
, _hc_where:
{ _cw_organization }
}
}
, u_username
, u_email } }
liftEffect $ here.log2 "[getUser] users" users
pure $ case A.head users of
Nothing -> Left (CustomError $ "user with id " <> show id <> " not found")
-- NOTE Contact is at G.C.N.A.U.C.Types
Just u -> Right $ { contactNode: Contact
{ id: u.u_id
, date: Nothing
, hyperdata: u.u_hyperdata
, hyperdata: HyperdataUser
{ shared: (\shared -> HyperdataContact
{ bdd: Nothing
, who: (\who -> ContactWho
{ idWho: Nothing
, firstName: who._cw_firstName
, lastName: who._cw_lastName
, keywords: []
, freetags: []
}) <$> shared._hc_who
, ou: (\ou -> ContactWhere
{ organization: ou._cw_organization
, labTeamDepts: []
, role: Nothing
, office: Nothing
, country: Nothing
, city: Nothing
, touch: Nothing
, entry: Nothing
, exit: Nothing }) <$> shared._hc_where
, source: shared._hc_source
, title: shared._hc_title
, lastValidation: Nothing
, uniqId: Nothing
, uniqIdBdd: Nothing
}) <$> u.u_hyperdata._hu_shared
}
, name: Just u.u_username
, parentId: Nothing
, typename: Nothing
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment