Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
158
Issues
158
List
Board
Labels
Milestones
Merge Requests
11
Merge Requests
11
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
gargantext
haskell-gargantext
Commits
d0f938b1
Commit
d0f938b1
authored
Oct 07, 2021
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[graphql] restructure file and add comments
parent
30f15662
Pipeline
#1939
failed with stage
in 10 minutes and 25 seconds
Changes
1
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
55 additions
and
56 deletions
+55
-56
GraphQL.hs
src/Gargantext/API/GraphQL.hs
+55
-56
No files found.
src/Gargantext/API/GraphQL.hs
View file @
d0f938b1
...
...
@@ -7,115 +7,97 @@
module
Gargantext.API.GraphQL
where
import
Data.Morpheus
(
App
,
deriveApp
)
import
Data.Morpheus.Subscriptions
(
Event
(
..
)
,
Hashable
,
webSocketsApp
)
import
Data.Morpheus.Types
(
GQLType
-- , ResolverM
,
ResolverQ
,
RootResolver
(
..
)
,
publish
-- , subscribe
)
import
Data.Text
(
Text
)
import
GHC.Generics
(
Generic
)
import
Control.Monad.IO.Class
(
liftIO
)
import
Data.ByteString.Lazy.Char8
(
ByteString
)
import
Data.List.NonEmpty
(
NonEmpty
((
:|
)))
import
Data.Morpheus
(
App
,
deriveApp
)
import
Data.Morpheus.Server
(
httpPlayground
)
import
Data.Morpheus.Subscriptions
(
PubApp
(
Event
(
..
)
,
Hashable
,
PubApp
,
SubApp
,
httpPubApp
,
webSocketsApp
)
import
Data.Morpheus.Types
(
-- App
GQLRequest
(
GQLRequest
,
GQLResponse
,
Undefined
(
..
)
,
GQLType
,
ResolverQ
,
RootResolver
(
..
)
,
Undefined
,
liftEither
,
publish
,
render
)
-- import Data.Proxy (Proxy)
-- import Data.Text (Text)
import
Data.Text
(
Text
)
import
qualified
Data.Text.Lazy
as
LT
import
Data.Text.Lazy.Encoding
(
decodeUtf8
)
import
Data.Typeable
(
Typeable
)
import
GHC.Generics
(
Generic
)
import
GHC.TypeLits
import
Network.HTTP.Media
((
//
),
(
/:
))
-- import Network.Wai.Handler.Warp
-- ( defaultSettings,
-- runSettings,
-- setPort,
-- )
-- import Network.Wai.Handler.WebSockets
-- ( websocketsOr,
-- )
import
Network.WebSockets
(
ServerApp
,
-- defaultConnectionOptions,
)
import
Servant
(
(
:<|>
)
(
..
),
(
:>
),
Accept
(
..
),
Get
,
-- HasServer,
JSON
,
MimeRender
(
..
),
PlainText
,
Post
,
ReqBody
,
Server
,
-- serve,
)
import
Prelude
import
qualified
Data.Swagger
as
Swagger
import
Gargantext.Database.Prelude
(
Cmd
)
type
EVENT
=
Event
Channel
Contet
-- | Our simple datatype.
data
User
=
User
{
name
::
Text
,
user_id
::
Int
}
deriving
(
Generic
,
GQLType
)
-- | Represents possible GraphQL queries.
data
Query
m
=
Query
{
user
::
UserArgs
->
m
User
}
deriving
(
Generic
,
GQLType
)
-- | Arguments to the "user" query.
data
UserArgs
=
UserArgs
{
name
::
Text
}
deriving
(
Generic
,
GQLType
)
-- | Possible GraphQL Events, i.e. here we describe how we will
-- manipulate the data.
type
EVENT
=
Event
Channel
Contet
-- | Channels are possible actions to call when manipulating the data.
data
Channel
=
Update
|
New
deriving
(
Eq
,
Show
,
Generic
,
Hashable
)
-- | This type describes what data we will operate on.
data
Contet
=
UserContet
User
data
User
=
User
{
name
::
Text
,
user_id
::
Int
}
deriving
(
Generic
,
GQLType
)
data
UserArgs
=
UserArgs
{
name
::
Text
}
deriving
(
Generic
,
GQLType
)
resolveUser
::
UserArgs
->
ResolverQ
e
IO
User
resolveUser
UserArgs
{
name
}
=
liftEither
$
dbUser
name
dbUser
::
Text
->
IO
(
Either
String
User
)
dbUser
name
=
pure
$
Right
$
User
{
name
,
user_id
=
1
}
-- | The main GraphQL resolver: how queries, mutations and
-- subscriptions are handled.
rootResolver
::
RootResolver
IO
EVENT
Query
Undefined
Undefined
rootResolver
=
RootResolver
...
...
@@ -123,21 +105,37 @@ rootResolver =
,
mutationResolver
=
Undefined
,
subscriptionResolver
=
Undefined
}
-- | Function to resolve user from a query.
resolveUser
::
UserArgs
->
ResolverQ
e
IO
User
resolveUser
UserArgs
{
name
}
=
liftEither
$
dbUser
name
-- | Inner function to fetch the user from DB.
dbUser
::
Text
->
IO
(
Either
String
User
)
dbUser
name
=
pure
$
Right
$
User
{
name
,
user_id
=
1
}
-- | Main GraphQL "app".
app
::
App
EVENT
IO
app
=
deriveApp
rootResolver
----------------------------------------------
-- Now for some boilerplate to integrate the above GraphQL app with
-- servant.
-- | HTML type is needed for the GraphQL Playground.
data
HTML
deriving
(
Typeable
)
instance
Accept
HTML
where
contentTypes
_
=
"text"
//
"html"
/:
(
"charset"
,
"utf-8"
)
:|
[
"text"
//
"html"
]
instance
MimeRender
HTML
ByteString
where
mimeRender
_
=
id
-- | Servant route for the app we defined above.
type
GQAPI
=
ReqBody
'[
J
SON
]
GQLRequest
:>
Post
'[
J
SON
]
GQLResponse
type
Schema
=
"schema"
:>
Get
'[
P
lainText
]
Text
-- type Schema = "schema" :> Get '[PlainText] Text
-- | Servant route for the playground.
type
Playground
=
Get
'[
H
TML
]
ByteString
type
API'
(
name
::
Symbol
)
=
name
:>
(
GQAPI
:<|>
Schema
:<|>
Playground
)
-- type API' (name :: Symbol) = name :> (GQAPI :<|> Schema :<|> Playground)
-- | Our API consists of `GQAPI` and `Playground`.
type
API
=
"gql"
:>
(
GQAPI
:<|>
Playground
)
-- serveEndpoint ::
...
...
@@ -152,6 +150,7 @@ type API = "gql" :> (GQAPI :<|> Playground)
-- withSchema :: (Applicative f) => App e m -> f Text
-- withSchema = pure . LT.toStrict . decodeUtf8 . render
-- | Implementation of our API.
api
::
Server
API
api
=
do
--(wsApp, publish') <- liftIO $ webSocketsApp app
...
...
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