morpheus-graphql-0.2.0: examples/Main.hs

{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}

module Main
  ( main
  ) where

import           Control.Monad.IO.Class         (liftIO)
import           Data.ByteString.Lazy           (ByteString)
import           Data.Functor.Identity          (Identity (..))
import           Data.Morpheus                  (Interpreter (..))
import           Data.Morpheus.Client           (Fetch (..), defineByDocumentFile, defineByIntrospectionFile, gql)
import           Data.Morpheus.Document         (toGraphQLDocument)
import           Data.Morpheus.Server           (GQLState, gqlSocketApp, initGQLState)
import           Data.Morpheus.Types            (ScalarValue (..))
import           Deprecated.API                 (Channel, Content, gqlRoot)
import           Mythology.API                  (mythologyApi)
import           TH.API                         (thApi)

import qualified Network.Wai                    as Wai
import qualified Network.Wai.Handler.Warp       as Warp
import qualified Network.Wai.Handler.WebSockets as WaiWs
import           Network.WebSockets             (defaultConnectionOptions)
import           Web.Scotty                     (body, file, get, post, raw, scottyApp)

ioRes :: ByteString -> IO ByteString
ioRes req = do
  print req
  return
    "{\"data\":{\"deity\":{ \"fullName\": \"name\" }, \"character\":{ \"__typename\":\"Human\", \"lifetime\": \"Lifetime\", \"profession\": \"Artist\" }  }}"

defineByIntrospectionFile
  "./assets/introspection.json"
  [gql|
    # Query Hero with Compile time Validation
    query GetUser ($userCoordinates: Coordinates!)
      {
        user {
           name
           email
           address (coordinates: $userCoordinates ){
            city
           }
        }
      }
  |]

defineByDocumentFile
  "./assets/simple.gql"
  [gql|
    # Query Hero with Compile time Validation
    query GetHero ($god: Realm, $charID: String!)
      {
        deity (mythology:$god) {
          power
          fullName
        }
        character(characterID: $charID ) {
          ...on Creature {
            creatureName
          }
          ...on Human {
            lifetime
            profession
          }
        }
      }
  |]

fetchHero :: IO (Either String GetHero)
fetchHero = fetch ioRes GetHeroArgs {god = Just Realm {owner = "Zeus", surface = Just 10}, charID = "Hercules"}

fetUser :: GQLState IO Channel Content -> IO (Either String GetUser)
fetUser state = fetch (interpreter gqlRoot state) userArgs
  where
    userArgs :: Args GetUser
    userArgs = GetUserArgs {userCoordinates = Coordinates {longitude = [], latitude = String "1"}}

main :: IO ()
main = do
  fetchHero >>= print
  state <- initGQLState
  httpApp <- httpServer state
  fetUser state >>= print
  Warp.runSettings settings $ WaiWs.websocketsOr defaultConnectionOptions (wsApp state) httpApp
  where
    settings = Warp.setPort 3000 Warp.defaultSettings
    wsApp = gqlSocketApp gqlRoot
    httpServer :: GQLState IO Channel Content -> IO Wai.Application
    httpServer state =
      scottyApp $ do
        post "/" $ raw =<< (liftIO . interpreter gqlRoot state =<< body)
        get "/" $ file "examples/index.html"
        get "/schema.gql" $ raw $ toGraphQLDocument $ Identity gqlRoot
        post "/mythology" $ raw =<< (liftIO . mythologyApi =<< body)
        get "/mythology" $ file "examples/index.html"
        post "/th" $ raw =<< (liftIO . thApi =<< body)
        get "/th" $ file "examples/index.html"