{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module Sophisticated.API ( gqlRoot , APIEvent ) where import Data.Map (Map) import qualified Data.Map as M (fromList) import Data.Set (Set) import qualified Data.Set as S (fromList) import Data.Text (Text, pack) import Data.Typeable (Typeable) import GHC.Generics (Generic) -- MORPHEUS import Data.Morpheus.Document (importGQLDocumentWithNamespace) import Data.Morpheus.Kind (INPUT_UNION, OBJECT, SCALAR) import Data.Morpheus.Types (Event (..), GQLRootResolver (..), GQLScalar (..), GQLType (..), ID, QUERY, Resolver (..), ScalarValue (..), constRes) $(importGQLDocumentWithNamespace "examples/Sophisticated/api.gql") type AIntText = A (Int, Text) type AText = A Text type SetInt = Set Int type MapTextInt = Map Text Int data Animal = CAT Cat | DOG Dog | BIRD Bird deriving (Show, Generic) instance GQLType Animal where type KIND Animal = INPUT_UNION data Euro = Euro Int Int deriving (Show, Generic) instance GQLType Euro where type KIND Euro = SCALAR instance GQLScalar Euro where parseValue _ = pure (Euro 1 0) serialize (Euro x y) = Int (x * 100 + y) instance Typeable a => GQLType (A a) where type KIND (A a) = OBJECT newtype A a = A { wrappedA :: a } deriving (Generic) data Channel = UPDATE_USER | UPDATE_ADDRESS deriving (Show, Eq, Ord) data Content = Update { contentID :: Int , contentMessage :: Text } type APIEvent = (Event Channel Content) gqlRoot :: GQLRootResolver IO APIEvent Query Mutation Subscription gqlRoot = GQLRootResolver {queryResolver, mutationResolver, subscriptionResolver} where queryResolver = Query { queryUser = const fetchUser , queryAnimal = \QueryAnimalArgs {queryAnimalArgsAnimal} -> pure (pack $ show queryAnimalArgsAnimal) , querySet = constRes $ S.fromList [1, 2] , queryMap = constRes $ M.fromList [("robin", 1), ("carl", 2)] , queryWrapped1 = constRes $ A (0, "") , queryWrapped2 = constRes $ A "" } ------------------------------------------------------------- mutationResolver = Mutation { mutationCreateUser , mutationCreateAddress } where mutationCreateUser _ = MutResolver [Event [UPDATE_USER] (Update {contentID = 12, contentMessage = "some message for user"})] (pure User { userName = constRes "George" , userEmail = constRes "George@email.com" , userAddress = constRes mutationAddress , userOffice = constRes Nothing , userHome = constRes HH , userEntity = constRes Nothing }) ------------------------- mutationCreateAddress _ = MutResolver [Event [UPDATE_ADDRESS] (Update {contentID = 10, contentMessage = "message for address"})] (pure mutationAddress) ---------------------------------------------------------------- subscriptionResolver = Subscription {subscriptionNewAddress, subscriptionNewUser} where subscriptionNewUser () = SubResolver [UPDATE_USER] subResolver where subResolver (Event _ Update {}) = fetchUser subscriptionNewAddress () = SubResolver [UPDATE_ADDRESS] subResolver where subResolver (Event _ Update {contentID}) = fetchAddress ---------------------------------------------------------------------------------------------- fetchAddress = pure Address {addressCity = constRes "", addressStreet = constRes "", addressHouseNumber = constRes 0} fetchUser :: Resolver QUERY IO (Event Channel Content) (User (Resolver QUERY IO (Event Channel Content))) fetchUser = pure User { userName = constRes "George" , userEmail = constRes "George@email.com" , userAddress = const fetchAddress , userOffice = constRes Nothing , userHome = constRes HH , userEntity = constRes Nothing } mutationAddress = Address { addressCity = constRes "", addressStreet = constRes "", addressHouseNumber = constRes 0 }