Commit d0f938b1 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[graphql] restructure file and add comments

parent 30f15662
......@@ -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 '[JSON] GQLRequest :> Post '[JSON] GQLResponse
type Schema = "schema" :> Get '[PlainText] Text
-- type Schema = "schema" :> Get '[PlainText] Text
-- | Servant route for the playground.
type Playground = Get '[HTML] 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
......
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