Commit 4565f557 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[graphql] custom affjax Simple.JSON client

WIP, code does not compile
parent 260a2fd1
Pipeline #1991 failed with stage
module Gargantext.Components.GraphQL where module Gargantext.Components.GraphQL where
import Data.Argonaut.Decode (class DecodeJson) --import Data.Argonaut.Decode (class DecodeJson)
import Data.Array as A import Effect.Aff (Aff)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.Components.GraphQL.AffjaxSimpleJSONClient (AffjaxClient(..))
import Gargantext.Components.GraphQL.User import Gargantext.Components.GraphQL.User
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import GraphQL.Client.Args (type (==>), (=>>)) import GraphQL.Client.Args (type (==>))
import GraphQL.Client.BaseClients.Urql --import GraphQL.Client.BaseClients.Urql
import GraphQL.Client.Query (query, query_) import GraphQL.Client.Query (query)
import GraphQL.Client.Types (class GqlQuery, Client) import GraphQL.Client.Types (class GqlQuery, Client(..))
import Reactix as R import Simple.JSON as JSON
import Reactix.DOM.HTML as H
import Toestand as T
import Type.Proxy (Proxy(..))
type Props = ()
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.GraphQL" here = R2.here "Gargantext.Components.GraphQL"
graphQLTest :: R2.Component Props client :: Client AffjaxClient Schema Void Void
graphQLTest = R.createElement graphQLTestCpt client = Client $ AffjaxClient "http://localhost:8008/gql" []
graphQLTestCpt :: R.Component Props
graphQLTestCpt = here.component "graphQLTest" cpt where
cpt {} _ = do
userBox <- T.useBox Nothing
user' <- T.useLive T.unequal userBox
R.useEffect' do
launchAff_ $ do
{ users } <-
queryGql "get user"
{ users: { user_id: 1 } =>> { userLight_id
, userLight_username
, userLight_password
, userLight_email } }
liftEffect $ do
here.log2 "[graphQLTest] users" users
case A.head users of
Nothing -> here.log2 "[graphQLTest] user not found with id" 1
Just u -> T.write_ (Just u) userBox
pure $ R2.row
--[ H.div { className: "col-12 d-flex justify-content-center" }
[ R2.col 12
[ R2.row
[ R2.col 12
[ H.h1 {} [ H.text "graph ql test" ]
]
]
, R2.row
[ R2.col 12
[ H.p {} [ H.text $ showMUser user' ]
]
]
]
]
queryGql :: queryGql ::
forall query returns. forall query returns.
GqlQuery Schema query returns => GqlQuery Schema query returns =>
DecodeJson returns => JSON.ReadForeign returns =>
String -> query -> Aff returns String -> query -> Aff returns
queryGql name q = do queryGql name q = do
client <- liftEffect $ createClient { headers: [], url: "http://localhost:8008/gql" }
query (client :: Client UrqlClient Schema _ _) name q --client <- liftEffect $ createClient { headers: [], url: "http://localhost:8008/gql" }
query client name q
--query_ "http://localhost:8008/gql" (Proxy :: Proxy Schema) --query_ "http://localhost:8008/gql" (Proxy :: Proxy Schema)
-- Schema -- Schema
......
module Gargantext.Components.GraphQL.AffjaxSimpleJSONClient
(AffjaxClient(..))
where
import Prelude
import Affjax (Error(..), Response, URL, defaultRequest, printError, request)
import Affjax.RequestBody as RequestBody
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut.Core (Json)
import Data.Either (Either(..))
import Data.HTTP.Method as Method
import Data.List.NonEmpty as DLN
import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationJSON)
import Effect.Aff (Aff, error, throwError)
import Foreign (unsafeToForeign)
import GraphQL.Client.Types (class QueryClient)
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
module Gargantext.Components.GraphQL.User where module Gargantext.Components.GraphQL.User where
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (HyperdataUser)
import Gargantext.Prelude import Gargantext.Prelude
import Type.Proxy (Proxy(..)) import Type.Proxy (Proxy(..))
type User type User
= { userLight_id :: Int = { u_id :: Int
, userLight_username :: String , u_hyperdata :: HyperdataUser
, userLight_password :: String , u_username :: String
, userLight_email :: String , u_email :: String
} }
showUser { userLight_id showUser { u_id
, userLight_username , u_username
, userLight_password , u_email } = "[" <> show u_id <> "] " <> u_username <> " :: " <> u_email
, userLight_email } = "[" <> show userLight_id <> "] " <> userLight_username <> " :: " <> userLight_email
showMUser u = maybe "" showUser u showMUser u = maybe "" showUser u
-- Symbols -- Symbols
userLight_id :: Proxy "userLight_id" u_id :: Proxy "u_id"
userLight_id = Proxy u_id = Proxy
userLight_username :: Proxy "userLight_username" u_hyperdata :: Proxy "u_hyperdata"
userLight_username = Proxy u_hyperdata = Proxy
userLight_password :: Proxy "userLight_password" u_username :: Proxy "u_username"
userLight_password = Proxy u_username = Proxy
userLight_email :: Proxy "userLight_email" u_email :: Proxy "u_email"
userLight_email = Proxy u_email = Proxy
...@@ -243,21 +243,22 @@ getUserWithReload {nodeId, session} = getUser session nodeId -- getContact sessi ...@@ -243,21 +243,22 @@ getUserWithReload {nodeId, session} = getUser session nodeId -- getContact sessi
getUser :: Session -> Int -> Aff (Either RESTError ContactData) getUser :: Session -> Int -> Aff (Either RESTError ContactData)
getUser session id = do getUser session id = do
{ users } <- queryGql "get user" { users } <- queryGql "get user"
{ users: { user_id: id } =>> { userLight_id { users: { user_id: id } =>>
, userLight_username { u_id
, userLight_password , u_hyperdata
, userLight_email } } , u_username
, u_email } }
liftEffect $ here.log2 "[getUser] users" users liftEffect $ here.log2 "[getUser] users" users
pure $ case A.head users of pure $ case A.head users of
Nothing -> Left (CustomError $ "user with id " <> show id <> " not found") Nothing -> Left (CustomError $ "user with id " <> show id <> " not found")
Just u -> Right $ { contactNode: Contact Just u -> Right $ { contactNode: Contact
{ id: u.userLight_id { id: u.u_id
, date: Nothing , date: Nothing
, hyperdata: HyperdataUser { shared: Nothing } , hyperdata: u.u_hyperdata
, name: Just u.userLight_username , name: Just u.u_username
, parentId: Nothing , parentId: Nothing
, typename: Nothing , typename: Nothing
, userId: Just u.userLight_id } , userId: Just u.u_id }
, defaultListId: 424242 } , defaultListId: 424242 }
saveContactHyperdata :: Session -> Int -> HyperdataUser -> Aff (Either RESTError Int) saveContactHyperdata :: Session -> Int -> HyperdataUser -> Aff (Either RESTError Int)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment