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
import Data.Argonaut.Decode (class DecodeJson)
import Data.Array as A
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff_)
--import Data.Argonaut.Decode (class DecodeJson)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.Components.GraphQL.AffjaxSimpleJSONClient (AffjaxClient(..))
import Gargantext.Components.GraphQL.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, query_)
import GraphQL.Client.Types (class GqlQuery, Client)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Type.Proxy (Proxy(..))
type Props = ()
import GraphQL.Client.Args (type (==>))
--import GraphQL.Client.BaseClients.Urql
import GraphQL.Client.Query (query)
import GraphQL.Client.Types (class GqlQuery, Client(..))
import Simple.JSON as JSON
here :: R2.Here
here = R2.here "Gargantext.Components.GraphQL"
graphQLTest :: R2.Component Props
graphQLTest = R.createElement graphQLTestCpt
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' ]
]
]
]
]
client :: Client AffjaxClient Schema Void Void
client = Client $ AffjaxClient "http://localhost:8008/gql" []
queryGql ::
forall query returns.
GqlQuery Schema query returns =>
DecodeJson returns =>
JSON.ReadForeign returns =>
String -> query -> Aff returns
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)
-- 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
import Data.Maybe (Maybe(..), maybe)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (HyperdataUser)
import Gargantext.Prelude
import Type.Proxy (Proxy(..))
type User
= { userLight_id :: Int
, userLight_username :: String
, userLight_password :: String
, userLight_email :: String
= { u_id :: Int
, u_hyperdata :: HyperdataUser
, u_username :: String
, u_email :: String
}
showUser { userLight_id
, userLight_username
, userLight_password
, userLight_email } = "[" <> show userLight_id <> "] " <> userLight_username <> " :: " <> userLight_email
showUser { u_id
, u_username
, u_email } = "[" <> show u_id <> "] " <> u_username <> " :: " <> u_email
showMUser u = maybe "" showUser u
-- Symbols
userLight_id :: Proxy "userLight_id"
userLight_id = Proxy
userLight_username :: Proxy "userLight_username"
userLight_username = Proxy
userLight_password :: Proxy "userLight_password"
userLight_password = Proxy
userLight_email :: Proxy "userLight_email"
userLight_email = Proxy
u_id :: Proxy "u_id"
u_id = Proxy
u_hyperdata :: Proxy "u_hyperdata"
u_hyperdata = Proxy
u_username :: Proxy "u_username"
u_username = Proxy
u_email :: Proxy "u_email"
u_email = Proxy
......@@ -243,21 +243,22 @@ getUserWithReload {nodeId, session} = getUser session nodeId -- getContact sessi
getUser :: Session -> Int -> Aff (Either RESTError ContactData)
getUser session id = do
{ users } <- queryGql "get user"
{ users: { user_id: id } =>> { userLight_id
, userLight_username
, userLight_password
, userLight_email } }
{ users: { user_id: id } =>>
{ u_id
, u_hyperdata
, 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")
Just u -> Right $ { contactNode: Contact
{ id: u.userLight_id
{ id: u.u_id
, date: Nothing
, hyperdata: HyperdataUser { shared: Nothing }
, name: Just u.userLight_username
, hyperdata: u.u_hyperdata
, name: Just u.u_username
, parentId: Nothing
, typename: Nothing
, userId: Just u.userLight_id }
, userId: Just u.u_id }
, defaultListId: 424242 }
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