diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 4186604fd7..d2258977f5 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -49,10 +49,11 @@ jobs: format: runs-on: ubuntu-latest steps: - - uses: actions/checkout@v2 - - uses: mrkkrp/ormolu-action@v7 - with: - pattern: morpheus-graphql*/**/*.hs + - uses: actions/checkout@v4 + - uses: ./.github/actions/setup-hs + - name: check + shell: bash + run: hconf format --check concurrency: group: ${{ github.ref }} diff --git a/examples/client/src/Client/DefineByIntrospection.hs b/examples/client/src/Client/DefineByIntrospection.hs index b7bf7d9e4b..7bfd597c5e 100644 --- a/examples/client/src/Client/DefineByIntrospection.hs +++ b/examples/client/src/Client/DefineByIntrospection.hs @@ -77,16 +77,16 @@ declareLocalTypesInline usersApi :: ByteString -> IO ByteString usersApi _ = - pure $ - "{\"data\":{" - <> "\"myUser\":{ " - <> " \"boo3\": \"name\"," - <> " \"myUserEmail\": \"some field\"," - <> " \"address\":{ \"city\":\"some city\" }," - <> " \"customAdress\":{ \"customCity\":\"some custom city\" }" - <> "}," - <> " \"user\":{ \"email\":\"some email\" }" - <> "}}" + pure + $ "{\"data\":{" + <> "\"myUser\":{ " + <> " \"boo3\": \"name\"," + <> " \"myUserEmail\": \"some field\"," + <> " \"address\":{ \"city\":\"some city\" }," + <> " \"customAdress\":{ \"customCity\":\"some custom city\" }" + <> "}," + <> " \"user\":{ \"email\":\"some email\" }" + <> "}}" fetchUsers :: IO (Either (FetchError GetUser) GetUser) fetchUsers = fetch usersApi userArgs diff --git a/examples/code-gen-docs/src/Server/API.hs b/examples/code-gen-docs/src/Server/API.hs index f79f9f966c..124ecb7d08 100644 --- a/examples/code-gen-docs/src/Server/API.hs +++ b/examples/code-gen-docs/src/Server/API.hs @@ -10,7 +10,7 @@ import Scalars (Markdown (..)) import Server.Blog resolvePost :: - Monad m => + (Monad m) => ID -> m (Post m) resolvePost (ID x) = @@ -21,7 +21,7 @@ resolvePost (ID x) = } resolveUser :: - Monad m => + (Monad m) => ID -> m (User m) resolveUser (ID x) = @@ -31,7 +31,7 @@ resolveUser (ID x) = posts = traverse resolvePost ["id1", "id2"] } -resolveQuery :: Monad m => Query m +resolveQuery :: (Monad m) => Query m resolveQuery = Query { getPosts = traverse resolvePost ["id1", "id2"], @@ -39,7 +39,7 @@ resolveQuery = } rootResolver :: - Monad m => + (Monad m) => RootResolver m () Query Undefined Undefined rootResolver = defaultRootResolver {queryResolver = resolveQuery} diff --git a/examples/code-gen/src/Domains/Posts/Resolver.hs b/examples/code-gen/src/Domains/Posts/Resolver.hs index 179444e83e..2180f82db7 100644 --- a/examples/code-gen/src/Domains/Posts/Resolver.hs +++ b/examples/code-gen/src/Domains/Posts/Resolver.hs @@ -10,19 +10,19 @@ import Data.Morpheus.Types import Domains.Posts.Posts resolvePost :: - Monad m => + (Monad m) => ID -> m (Maybe (Post m)) resolvePost postId = - pure $ - Just $ - Post - { Domains.Posts.Posts.id = pure postId, - title = pure "Post Tittle", - authorID = pure "Post Author" - } + pure + $ Just + $ Post + { Domains.Posts.Posts.id = pure postId, + title = pure "Post Tittle", + authorID = pure "Post Author" + } -resolveQuery :: Monad m => Query m +resolveQuery :: (Monad m) => Query m resolveQuery = Query { posts = @@ -36,7 +36,7 @@ resolveQuery = } rootResolver :: - Monad m => + (Monad m) => RootResolver m () Query Undefined Undefined rootResolver = defaultRootResolver {queryResolver = resolveQuery} diff --git a/examples/code-gen/src/Domains/Users/Resolver.hs b/examples/code-gen/src/Domains/Users/Resolver.hs index ca3bbda46c..1cdab6e7bc 100644 --- a/examples/code-gen/src/Domains/Users/Resolver.hs +++ b/examples/code-gen/src/Domains/Users/Resolver.hs @@ -10,18 +10,18 @@ import Data.Morpheus.Types import Domains.Users.Users resolveUser :: - Monad m => + (Monad m) => ID -> m (Maybe (User m)) resolveUser postId = - pure $ - Just $ - User - { Domains.Users.Users.id = pure postId, - name = pure "User Tittle" - } + pure + $ Just + $ User + { Domains.Users.Users.id = pure postId, + name = pure "User Tittle" + } -resolveQuery :: Monad m => Query m +resolveQuery :: (Monad m) => Query m resolveQuery = Query { users = @@ -35,7 +35,7 @@ resolveQuery = } rootResolver :: - Monad m => + (Monad m) => RootResolver m () Query Undefined Undefined rootResolver = defaultRootResolver {queryResolver = resolveQuery} diff --git a/examples/scotty-fraxl/src/Fraxl/API.hs b/examples/scotty-fraxl/src/Fraxl/API.hs index 5c28bc3c7f..0236d203d9 100644 --- a/examples/scotty-fraxl/src/Fraxl/API.hs +++ b/examples/scotty-fraxl/src/Fraxl/API.hs @@ -235,7 +235,7 @@ isSchema = param "schema" httpEndpoint :: RoutePattern -> ScottyM () httpEndpoint route = do - get route $ - (isSchema *> raw (render app)) - <|> raw httpPlayground + get route + $ (isSchema *> raw (render app)) + <|> raw httpPlayground post route (raw . DB.runQuery . runFraxl fetchSource . runApp app =<< body) diff --git a/examples/scotty-freer-simple/src/API.hs b/examples/scotty-freer-simple/src/API.hs index 23484f39b3..86ed44a743 100644 --- a/examples/scotty-freer-simple/src/API.hs +++ b/examples/scotty-freer-simple/src/API.hs @@ -42,7 +42,7 @@ importGQLDocument =<< makeRelativeToProject "src/api.gql" api :: (Member DR.DeityRepo effs, Typeable effs) => ByteString -> Eff effs ByteString api = interpreter rootResolver -rootResolver :: Member DR.DeityRepo effs => RootResolver (Eff effs) () Query Mutation Undefined +rootResolver :: (Member DR.DeityRepo effs) => RootResolver (Eff effs) () Query Mutation Undefined rootResolver = defaultRootResolver { queryResolver = Query {deity = deityResolver}, @@ -62,5 +62,5 @@ toResponse :: toResponse (Right deity) = Right $ toResponse' deity toResponse (Left error) = Left $ show error -toResponse' :: Applicative m => T.Deity -> Deity m +toResponse' :: (Applicative m) => T.Deity -> Deity m toResponse' (T.Deity name power) = Deity {name = pure name, power = pure power} diff --git a/examples/scotty-freer-simple/src/DeityRepo.hs b/examples/scotty-freer-simple/src/DeityRepo.hs index 77e6244ef5..01601406a2 100644 --- a/examples/scotty-freer-simple/src/DeityRepo.hs +++ b/examples/scotty-freer-simple/src/DeityRepo.hs @@ -15,8 +15,8 @@ data DeityRepo r where CreateDeity :: Deity -> DeityRepo (Either Error Deity) -- Interface for use -getDeityByName :: Member DeityRepo effs => Name -> Eff effs (Either Error Deity) +getDeityByName :: (Member DeityRepo effs) => Name -> Eff effs (Either Error Deity) getDeityByName name = send $ GetDeityByName name -createDeity :: Member DeityRepo effs => Deity -> Eff effs (Either Error Deity) +createDeity :: (Member DeityRepo effs) => Deity -> Eff effs (Either Error Deity) createDeity deity = send $ CreateDeity deity diff --git a/examples/scotty-freer-simple/src/ExampleDeityRepoHandler.hs b/examples/scotty-freer-simple/src/ExampleDeityRepoHandler.hs index 72de1c6361..db4b9fde99 100644 --- a/examples/scotty-freer-simple/src/ExampleDeityRepoHandler.hs +++ b/examples/scotty-freer-simple/src/ExampleDeityRepoHandler.hs @@ -30,7 +30,7 @@ exampleDeityRepoHandler dbRef = writeIORef dbRef $ addOrReplace diety deities pure (Right diety) -addOrReplace :: Eq a => a -> [a] -> [a] +addOrReplace :: (Eq a) => a -> [a] -> [a] addOrReplace a as = a : filter (/= a) as toEither :: b -> Maybe a -> Either b a diff --git a/examples/scotty-freer-simple/src/Lib.hs b/examples/scotty-freer-simple/src/Lib.hs index dc76fbd67f..0ba8290480 100644 --- a/examples/scotty-freer-simple/src/Lib.hs +++ b/examples/scotty-freer-simple/src/Lib.hs @@ -32,8 +32,8 @@ server' showStart readyAction = do routes where settings = - setBeforeMainLoop readyAction $ - setPort + setBeforeMainLoop readyAction + $ setPort 8080 defaultSettings showStartMessage = if showStart then 1 else 0 diff --git a/examples/scotty-haxl/src/HaxlAPI/API.hs b/examples/scotty-haxl/src/HaxlAPI/API.hs index 326e33580e..586702d08e 100644 --- a/examples/scotty-haxl/src/HaxlAPI/API.hs +++ b/examples/scotty-haxl/src/HaxlAPI/API.hs @@ -100,7 +100,7 @@ httpEndpoint route = do get route $ (isSchema *> raw (render app)) <|> raw httpPlayground post route $ raw =<< (liftIO . runHaxlApp (deriveApp rootResolver) =<< body) -runHaxlApp :: MapAPI a b => App e Haxl -> a -> IO b +runHaxlApp :: (MapAPI a b) => App e Haxl -> a -> IO b runHaxlApp haxlApp input = do let stateStore = stateSet DeityState stateEmpty environment <- initEnv stateStore () diff --git a/examples/scotty-haxl/src/HaxlAPI/DataSource.hs b/examples/scotty-haxl/src/HaxlAPI/DataSource.hs index 8eeddd4ecc..7062cbb2e3 100644 --- a/examples/scotty-haxl/src/HaxlAPI/DataSource.hs +++ b/examples/scotty-haxl/src/HaxlAPI/DataSource.hs @@ -83,7 +83,7 @@ instance DataSourceName DeityReq where instance DataSource u DeityReq where fetch _ _ _ = BackgroundFetch myfetch -fetchAll :: Foldable t => t (ResultVar [ID]) -> IO () +fetchAll :: (Foldable t) => t (ResultVar [ID]) -> IO () fetchAll allIdVars = do allIds <- fetchDeityIds mapM_ (`putSuccess` allIds) allIdVars diff --git a/examples/scotty/src/Server/MonadIO/API.hs b/examples/scotty/src/Server/MonadIO/API.hs index 39934ec2a6..a6c50c8981 100644 --- a/examples/scotty/src/Server/MonadIO/API.hs +++ b/examples/scotty/src/Server/MonadIO/API.hs @@ -186,9 +186,9 @@ loginResolver LoginArgs {username, password} = do | userId userRow == 1 = tokenUser1 | userId userRow == 2 = tokenUser2 | otherwise = tokenUser3 - pure $ - Just $ - Session {token = pure tokenUser, user = userResolver userRow} + pure + $ Just + $ Session {token = pure tokenUser, user = userResolver userRow} Nothing -> fail "Invalid user or password" getUserResolver :: (RESOLVER t) => Arg "id" Int -> Wrapped t Maybe User @@ -224,8 +224,8 @@ addDogResolver (Arg name) = do ------------------------------------------------------------------------------- userResolver :: (RESOLVER t) => UserRow -> Value t User userResolver UserRow {userId = thisUserId, userFullName} = - pure $ - User + pure + $ User { id = idResolver, name = nameResolver, favoriteDog = favoriteDogResolver, @@ -271,14 +271,14 @@ api = interpreter rootResolver app :: IO () app = do db <- newTVarIO dbInit - scotty 8080 $ - post "/api" $ - do - reqBody <- body - reqHeaders <- headers - let env = Env db $ map (both $ T.pack . LT.unpack) reqHeaders - res <- - liftIO . runExceptT . flip runReaderT env . runWeb $ api reqBody - case res of - Left code -> status $ Status code "Error" - Right rawResponse -> raw rawResponse + scotty 8080 + $ post "/api" + $ do + reqBody <- body + reqHeaders <- headers + let env = Env db $ map (both $ T.pack . LT.unpack) reqHeaders + res <- + liftIO . runExceptT . flip runReaderT env . runWeb $ api reqBody + case res of + Left code -> status $ Status code "Error" + Right rawResponse -> raw rawResponse diff --git a/examples/scotty/src/Server/Mythology/API.hs b/examples/scotty/src/Server/Mythology/API.hs index eec258d6a3..a70f27c428 100644 --- a/examples/scotty/src/Server/Mythology/API.hs +++ b/examples/scotty/src/Server/Mythology/API.hs @@ -67,7 +67,7 @@ resolveDeity :: DeityArgs -> ResolverQ e IO Deity resolveDeity DeityArgs {name, bornPlace} = liftEither $ dbDeity name bornPlace -resolveCharacter :: Applicative m => [Character m] +resolveCharacter :: (Applicative m) => [Character m] resolveCharacter = [ CharacterHuman someHuman, CharacterDeity someDeity, diff --git a/examples/scotty/src/Server/Mythology/Character.hs b/examples/scotty/src/Server/Mythology/Character.hs index efc635bdf9..dc27063d86 100644 --- a/examples/scotty/src/Server/Mythology/Character.hs +++ b/examples/scotty/src/Server/Mythology/Character.hs @@ -45,7 +45,7 @@ data Human m = Human type PersonGuard m = TypeGuard Person (UnionPerson m) -resolvePersons :: Applicative m => [PersonGuard m] +resolvePersons :: (Applicative m) => [PersonGuard m] resolvePersons = ResolveType <$> [UnionPersonDeity someDeity, UnionPersonHuman someHuman] data UnionPerson m @@ -53,7 +53,7 @@ data UnionPerson m | UnionPersonHuman (Human m) deriving (Generic, GQLType) -someHuman :: Applicative m => Human m +someHuman :: (Applicative m) => Human m someHuman = Human {name = pure "Odysseus", bornAt = pure Ithaca} someDeity :: Deity @@ -67,11 +67,11 @@ someDeity = dbDeity :: Text -> Maybe City -> IO (Either String Deity) dbDeity _ bornAt = - return $ - Right $ - Deity - { name = "Morpheus", - power = Just "Shapeshifting", - realm = Dream, - bornAt - } + return + $ Right + $ Deity + { name = "Morpheus", + power = Just "Shapeshifting", + realm = Dream, + bornAt + } diff --git a/examples/scotty/src/Server/NamedResolvers/Authors.hs b/examples/scotty/src/Server/NamedResolvers/Authors.hs index 5ec24fa856..4ac67eb573 100644 --- a/examples/scotty/src/Server/NamedResolvers/Authors.hs +++ b/examples/scotty/src/Server/NamedResolvers/Authors.hs @@ -63,8 +63,8 @@ instance ResolveNamed m (Author (NamedResolverT m)) where resolveBatched = traverse getAuthor where getAuthor uid = - pure $ - Just + pure + $ Just Author { authorId = resolve (pure uid), role = resolve (pure uid), @@ -85,8 +85,8 @@ instance ResolveNamed m (Post (NamedResolverT m)) where resolveBatched = traverse getPost where getPost uid = - pure $ - Just + pure + $ Just Post { author = resolve (pure uid) } diff --git a/examples/scotty/src/Server/NamedResolvers/Pages.hs b/examples/scotty/src/Server/NamedResolvers/Pages.hs index c1557d0310..b115de3d8b 100644 --- a/examples/scotty/src/Server/NamedResolvers/Pages.hs +++ b/examples/scotty/src/Server/NamedResolvers/Pages.hs @@ -59,7 +59,7 @@ data Query m = Query GQLType ) -instance MonadError GQLError m => ResolveNamed m (Query (NamedResolverT m)) where +instance (MonadError GQLError m) => ResolveNamed m (Query (NamedResolverT m)) where type Dep (Query (NamedResolverT m)) = () resolveBatched _ = pure diff --git a/examples/scotty/src/Server/NamedResolvers/Posts.hs b/examples/scotty/src/Server/NamedResolvers/Posts.hs index 1b24222d17..8a2f40c916 100644 --- a/examples/scotty/src/Server/NamedResolvers/Posts.hs +++ b/examples/scotty/src/Server/NamedResolvers/Posts.hs @@ -50,12 +50,12 @@ data Post m = Post getPost :: (Monad m) => ID -> m (Maybe (Post (NamedResolverT m))) getPost pid = - pure $ - Just $ - Post - { postID = resolve (pure pid), - title = resolve (pure $ "title for \"" <> unpackID pid <> "\"") - } + pure + $ Just + $ Post + { postID = resolve (pure pid), + title = resolve (pure $ "title for \"" <> unpackID pid <> "\"") + } instance ResolveNamed m (Post (NamedResolverT m)) where type Dep (Post (NamedResolverT m)) = ID @@ -71,7 +71,7 @@ data Query m = Query GQLType ) -instance MonadError GQLError m => ResolveNamed m (Query (NamedResolverT m)) where +instance (MonadError GQLError m) => ResolveNamed m (Query (NamedResolverT m)) where type Dep (Query (NamedResolverT m)) = () resolveBatched _ = pure diff --git a/examples/scotty/src/Server/Sophisticated/API.hs b/examples/scotty/src/Server/Sophisticated/API.hs index b4a9e48c67..d874afcfa6 100644 --- a/examples/scotty/src/Server/Sophisticated/API.hs +++ b/examples/scotty/src/Server/Sophisticated/API.hs @@ -248,7 +248,7 @@ userUpdate :: EVENT userUpdate = Event [USER] (Content {contentID = 12}) -- DB::Getter -------------------------------------------------------------------- -getDBAddress :: WithOperation o => Content -> IO (Address (Resolver o EVENT IO)) +getDBAddress :: (WithOperation o) => Content -> IO (Address (Resolver o EVENT IO)) getDBAddress _id = do city <- dbText street <- dbText @@ -260,11 +260,11 @@ getDBAddress _id = do addressHouseNumber = pure number } -getDBUser :: WithOperation o => Content -> IO (Either String (User (Resolver o EVENT IO))) +getDBUser :: (WithOperation o) => Content -> IO (Either String (User (Resolver o EVENT IO))) getDBUser _ = do Person {name, email} <- dbPerson - pure $ - Right + pure + $ Right User { userName = pure name, userEmail = pure email, @@ -311,16 +311,16 @@ setDBAddress = do setDBUser :: IO (Either String (User (Resolver MUTATION EVENT IO))) setDBUser = do Person {name, email} <- dbPerson - pure $ - Right $ - User - { userName = pure name, - userEmail = pure email, - userAddress = const $ lift setDBAddress, - userOffice = constRes Nothing, - userHome = pure CityIDHH, - userEntity = pure [] - } + pure + $ Right + $ User + { userName = pure name, + userEmail = pure email, + userAddress = const $ lift setDBAddress, + userOffice = constRes Nothing, + userHome = pure CityIDHH, + userEntity = pure [] + } -- DB ---------------------- data Person = Person @@ -337,5 +337,5 @@ dbInt = pure 11 dbPerson :: IO Person dbPerson = pure Person {name = "George", email = "George@email.com"} -requireAuthorized :: WithOperation o => Resolver o e IO () +requireAuthorized :: (WithOperation o) => Resolver o e IO () requireAuthorized = pure () diff --git a/examples/scotty/src/Server/Subscription/SimpleSubscription.hs b/examples/scotty/src/Server/Subscription/SimpleSubscription.hs index 1b2603ddc9..8d511493e9 100644 --- a/examples/scotty/src/Server/Subscription/SimpleSubscription.hs +++ b/examples/scotty/src/Server/Subscription/SimpleSubscription.hs @@ -70,8 +70,8 @@ rootResolver = subResolver (Event [ChannelA] (ContentB _value)) = fetchDeity -- resolve New State subResolver _ = fetchDeity -- Resolve Old State --------------------------------------------------------- - fetchDeity :: Applicative m => m Deity + fetchDeity :: (Applicative m) => m Deity fetchDeity = pure someDeity -requireAuthorized :: WithOperation o => Resolver o e IO () +requireAuthorized :: (WithOperation o) => Resolver o e IO () requireAuthorized = pure () diff --git a/examples/scotty/src/Server/Utils.hs b/examples/scotty/src/Server/Utils.hs index 64ed3bee5d..b399965ba2 100644 --- a/examples/scotty/src/Server/Utils.hs +++ b/examples/scotty/src/Server/Utils.hs @@ -63,16 +63,16 @@ httpEndpoint :: App e IO -> ScottyM () httpEndpoint route publish app = do - get route $ - (isSchema *> raw (render app)) - <|> raw httpPlayground + get route + $ (isSchema *> raw (render app)) + <|> raw httpPlayground post route $ raw =<< (liftIO . httpPubApp publish app =<< body) startServer :: ServerApp -> ScottyM () -> IO () startServer wsApp app = do httpApp <- scottyApp app - runSettings settings $ - websocketsOr + runSettings settings + $ websocketsOr defaultConnectionOptions wsApp httpApp diff --git a/examples/servant/src/Server/API/Simple.hs b/examples/servant/src/Server/API/Simple.hs index 4f53c0453a..1fef09445b 100644 --- a/examples/servant/src/Server/API/Simple.hs +++ b/examples/servant/src/Server/API/Simple.hs @@ -75,8 +75,8 @@ rootResolver = newDeity = subscribe New $ pure handler where handler (Event _ Contet {deityName, deityPower}) = - pure $ - Deity + pure + $ Deity { name = pure deityName, power = pure deityPower } diff --git a/examples/servant/src/Server/Utils.hs b/examples/servant/src/Server/Utils.hs index a4b2915aa2..fc182e5813 100644 --- a/examples/servant/src/Server/Utils.hs +++ b/examples/servant/src/Server/Utils.hs @@ -71,14 +71,14 @@ import Servant import Prelude startServer :: - HasServer api '[] => + (HasServer api '[]) => ServerApp -> Proxy api -> Server api -> IO () startServer wsApp proxy api = - runSettings settings $ - websocketsOr + runSettings settings + $ websocketsOr defaultConnectionOptions wsApp (serve proxy api) diff --git a/examples/yesod-pubsub/src/Server/Gql.hs b/examples/yesod-pubsub/src/Server/Gql.hs index fa2d221816..9a04b16cca 100644 --- a/examples/yesod-pubsub/src/Server/Gql.hs +++ b/examples/yesod-pubsub/src/Server/Gql.hs @@ -45,11 +45,11 @@ import Server.ServerState (Channel (..), Content (..), MEvent, ServerState) import qualified Server.ServerState as ServerState newtype Query m - = Query { queryCounter :: m Int } + = Query {queryCounter :: m Int} deriving (Generic, GQLType) newtype FunctionSearchArgs - = FunctionSearchArgs { fn :: Text } + = FunctionSearchArgs {fn :: Text} deriving (Generic, GQLType) data QueryCounterArgs @@ -72,7 +72,7 @@ resolveQuCounter serverState = do liftEither . return $ Right results newtype Mutation m - = Mutation { updateCounter :: UpdateCounter -> m Int } + = Mutation {updateCounter :: UpdateCounter -> m Int} deriving (Generic, GQLType) newtype UpdateCounter diff --git a/examples/yesod-pubsub/src/Server/Server.hs b/examples/yesod-pubsub/src/Server/Server.hs index 59fcb04a72..9b6dd62a7c 100644 --- a/examples/yesod-pubsub/src/Server/Server.hs +++ b/examples/yesod-pubsub/src/Server/Server.hs @@ -42,8 +42,9 @@ postGraphqlR = do let morpheusApp = Data.Morpheus.deriveApp $ Gql.rootResolver serverState body <- requireCheckJsonBody :: Handler GQLRequest publisher <- liftIO $ ServerState.readPublisher serverState - result <- liftIO - (MorpheusSub.httpPubApp [publisher] morpheusApp body :: IO GQLResponse) + result <- + liftIO + (MorpheusSub.httpPubApp [publisher] morpheusApp body :: IO GQLResponse) returnJson result main :: IO () @@ -63,8 +64,8 @@ mkWebsocketApp serverState httpApp = do let morpheusApp = Data.Morpheus.deriveApp $ Gql.rootResolver serverState (wsApp, pub) <- MorpheusSub.webSocketsApp morpheusApp ServerState.savePublisher serverState pub - return $ - WaiWebSockets.websocketsOr + return + $ WaiWebSockets.websocketsOr WebSockets.defaultConnectionOptions wsApp httpApp diff --git a/examples/yesod-pubsub/src/Server/ServerState.hs b/examples/yesod-pubsub/src/Server/ServerState.hs index f09b73ea61..e14b6f8dfe 100644 --- a/examples/yesod-pubsub/src/Server/ServerState.hs +++ b/examples/yesod-pubsub/src/Server/ServerState.hs @@ -40,8 +40,8 @@ new :: IO ServerState new = do initCounter <- newIORef 0 initPublisher <- newIORef $ \_ -> return () -- Initially, NOP - return $ - ServerState + return + $ ServerState { counter = initCounter, publisher = initPublisher } diff --git a/morpheus-graphql-app/src/Data/Morpheus/App.hs b/morpheus-graphql-app/src/Data/Morpheus/App.hs index 1bd1f4cb0e..c0e3ea7f0b 100644 --- a/morpheus-graphql-app/src/Data/Morpheus/App.hs +++ b/morpheus-graphql-app/src/Data/Morpheus/App.hs @@ -141,36 +141,36 @@ validateReq :: Config -> GQLRequest -> ResponseStream event m ResolverContext -validateReq constraints inputSchema config request = ResultT $ - pure $ - do - validSchema <- validateSchema True config inputSchema - schema <- internalSchema <:> validSchema - operation <- parseRequestWith config validSchema request - checkConstraints schema operation constraints - pure - ( [], - ResolverContext - { schema, - config, - operation, - currentType = - toAny $ - fromMaybe - (AST.query schema) - (rootType (operationType operation) schema), - currentSelection = - Selection - { selectionName = "Root", - selectionArguments = empty, - selectionPosition = operationPosition operation, - selectionAlias = Nothing, - selectionContent = SelectionSet (operationSelection operation), - selectionDirectives = empty, - selectionOrigin = Nothing - } - } - ) +validateReq constraints inputSchema config request = ResultT + $ pure + $ do + validSchema <- validateSchema True config inputSchema + schema <- internalSchema <:> validSchema + operation <- parseRequestWith config validSchema request + checkConstraints schema operation constraints + pure + ( [], + ResolverContext + { schema, + config, + operation, + currentType = + toAny + $ fromMaybe + (AST.query schema) + (rootType (operationType operation) schema), + currentSelection = + Selection + { selectionName = "Root", + selectionArguments = empty, + selectionPosition = operationPosition operation, + selectionAlias = Nothing, + selectionContent = SelectionSet (operationSelection operation), + selectionDirectives = empty, + selectionOrigin = Nothing + } + } + ) rootType :: OperationType -> Schema s -> Maybe (AST.TypeDefinition AST.OBJECT s) rootType OPERATION_QUERY = Just . AST.query diff --git a/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/Batching.hs b/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/Batching.hs index 93f7fa1774..56578055ab 100644 --- a/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/Batching.hs +++ b/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/Batching.hs @@ -116,20 +116,20 @@ instance (MonadReader ResolverContext m) => MonadReader ResolverContext (Resolve instance MonadTrans ResolverMapT where lift = ResolverMapT . lift . lift -deriving instance MonadError GQLError m => MonadError GQLError (ResolverMapT m) +deriving instance (MonadError GQLError m) => MonadError GQLError (ResolverMapT m) -runBatchedT :: Monad m => ResolverMapT m a -> ResolverMap m -> m a +runBatchedT :: (Monad m) => ResolverMapT m a -> ResolverMap m -> m a runBatchedT (ResolverMapT m) rmap = fst <$> runStateT (runReaderT m rmap) empty toKeys :: BatchEntry -> [CacheKey] toKeys (BatchEntry sel name deps) = map (CacheKey sel name) deps -inCache :: Monad m => CacheT m a -> ResolverMapT m a +inCache :: (Monad m) => CacheT m a -> ResolverMapT m a inCache = ResolverMapT . lift -class MonadTrans t => MonadBatching t where - resolveRef :: ResolverMonad m => SelectionContent VALID -> NamedResolverRef -> t m (CacheKey, CacheValue m) - storeValue :: ResolverMonad m => CacheKey -> ValidValue -> t m ValidValue +class (MonadTrans t) => MonadBatching t where + resolveRef :: (ResolverMonad m) => SelectionContent VALID -> NamedResolverRef -> t m (CacheKey, CacheValue m) + storeValue :: (ResolverMonad m) => CacheKey -> ValidValue -> t m ValidValue instance MonadBatching IdentityT where resolveRef _ _ = throwError $ internal "batching is only allowed with named resolvers" @@ -148,7 +148,7 @@ instance MonadBatching ResolverMapT where resolveRef _ ref = throwError (internal ("expected only one resolved value for " <> msg (show ref :: String))) storeValue key = inCache . cacheValue key -prefetch :: ResolverMonad m => BatchEntry -> ResolverMapT m () +prefetch :: (ResolverMonad m) => BatchEntry -> ResolverMapT m () prefetch batch = do value <- run batch batches <- buildBatches . concat <$> traverse (lift . scanRefs (batchedSelection batch)) value diff --git a/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/Cache.hs b/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/Cache.hs index 20dc4a69d6..b955273327 100644 --- a/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/Cache.hs +++ b/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/Cache.hs @@ -42,7 +42,7 @@ import Prelude (Show (show)) type CacheT m = (StateT (CacheStore m) m) -printSelectionKey :: RenderGQL a => a -> String +printSelectionKey :: (RenderGQL a) => a -> String printSelectionKey sel = map replace $ filter ignoreSpaces $ unpack (render sel) where ignoreSpaces x = x /= ' ' @@ -80,21 +80,21 @@ instance Show (CacheStore m) where instance Empty (CacheStore m) where empty = CacheStore empty -cacheResolverValues :: ResolverMonad m => [(CacheKey, ResolverValue m)] -> CacheT m () +cacheResolverValues :: (ResolverMonad m) => [(CacheKey, ResolverValue m)] -> CacheT m () cacheResolverValues pres = do CacheStore oldCache <- get let updates = unsafeFromList (map (second CachedResolver) pres) cache <- labeledDebug "\nUPDATE|>" $ CacheStore $ updates <> oldCache modify (const cache) -useCached :: ResolverMonad m => CacheKey -> CacheT m (CacheValue m) +useCached :: (ResolverMonad m) => CacheKey -> CacheT m (CacheValue m) useCached v = do cache <- get >>= labeledDebug "\nUSE|>" case lookup v (_unpackStore cache) of Just x -> pure x Nothing -> throwError (internal $ "cache value could not found for key" <> msg (show v :: String)) -isCached :: Monad m => CacheKey -> CacheT m Bool +isCached :: (Monad m) => CacheKey -> CacheT m Bool isCached key = isJust . lookup key . _unpackStore <$> get setValue :: (CacheKey, ValidValue) -> CacheStore m -> CacheStore m @@ -110,5 +110,5 @@ labeledDebug label v = showValue <$> asks (debug . config) withDebug :: (Show a, MonadReader ResolverContext m) => a -> m a withDebug = labeledDebug "" -cacheValue :: Monad m => CacheKey -> ValidValue -> CacheT m ValidValue +cacheValue :: (Monad m) => CacheKey -> ValidValue -> CacheT m ValidValue cacheValue key value = modify (setValue (key, value)) $> value diff --git a/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/ResolveValue.hs b/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/ResolveValue.hs index 561284eb39..ffee79b879 100644 --- a/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/ResolveValue.hs +++ b/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/ResolveValue.hs @@ -55,13 +55,13 @@ import Data.Morpheus.Types.Internal.AST import Relude hiding (empty) -- UNCACHED -resolvePlainRoot :: MonadResolver m => ObjectTypeResolver m -> SelectionSet VALID -> m ValidValue +resolvePlainRoot :: (MonadResolver m) => ObjectTypeResolver m -> SelectionSet VALID -> m ValidValue resolvePlainRoot resolver selection = do name <- asks (typeName . currentType) runIdentityT (resolveSelection (SelectionSet selection) (ResObject (Just name) resolver)) -- CACHED -resolveNamedRoot :: MonadResolver m => TypeName -> ResolverMap m -> SelectionSet VALID -> m ValidValue +resolveNamedRoot :: (MonadResolver m) => TypeName -> ResolverMap m -> SelectionSet VALID -> m ValidValue resolveNamedRoot typeName resolvers selection = runBatchedT (resolveSelection (SelectionSet selection) (ResRef $ pure (NamedResolverRef typeName ["ROOT"]))) diff --git a/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/Resolver.hs b/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/Resolver.hs index 2cdd8ce799..afa9bcb5dc 100644 --- a/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/Resolver.hs +++ b/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/Resolver.hs @@ -178,7 +178,7 @@ instance (LiftOperation o, Monad m) => MonadReader ResolverContext (Resolver o e local f (ResolverS resM) = ResolverS $ mapReaderT (local f) <$> resM class LiftOperation (o :: OperationType) where - packResolver :: Monad m => ResolverStateT e m a -> Resolver o e m a + packResolver :: (Monad m) => ResolverStateT e m a -> Resolver o e m a instance LiftOperation QUERY where packResolver = ResolverQ . clearStateResolverEvents @@ -189,7 +189,7 @@ instance LiftOperation MUTATION where instance LiftOperation SUBSCRIPTION where packResolver = ResolverS . pure . lift . clearStateResolverEvents -toEventResolver :: Monad m => ResolverContext -> SubEventRes event m ValidValue -> (event -> m GQLResponse) +toEventResolver :: (Monad m) => ResolverContext -> SubEventRes event m ValidValue -> (event -> m GQLResponse) toEventResolver sel (ReaderT subRes) event = renderResponse <$> runResolverStateValueM (subRes event) sel subscriptionEvents :: diff --git a/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/ResolverState.hs b/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/ResolverState.hs index e195c53ee1..ae136f24f6 100644 --- a/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/ResolverState.hs +++ b/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/ResolverState.hs @@ -110,15 +110,15 @@ fieldTypeName name t = case typeContent t of inSelectionField :: (MonadReader ResolverContext m, MonadError GQLError m) => Selection VALID -> m b -> m b inSelectionField selection m = do - inField (selectionName selection) $ - local (\ctx -> ctx {currentSelection = selection}) m + inField (selectionName selection) + $ local (\ctx -> ctx {currentSelection = selection}) m inField :: (MonadReader ResolverContext m, MonadError GQLError m) => FieldName -> m b -> m b inField fieldName m = do fieldType <- askFieldTypeName fieldName updateCurrentType fieldType m -askFieldTypeName :: MonadReader ResolverContext m => FieldName -> m (Maybe TypeName) +askFieldTypeName :: (MonadReader ResolverContext m) => FieldName -> m (Maybe TypeName) askFieldTypeName name = asks (fieldTypeName name . currentType) type ResolverState = ResolverStateT () Identity @@ -129,7 +129,7 @@ runResolverStateT = runReaderT . _runResolverStateT runResolverStateM :: ResolverStateT e m a -> ResolverContext -> m (Result GQLError ([e], a)) runResolverStateM res = runResultT . runResolverStateT res -runResolverStateValueM :: Functor m => ResolverStateT e m a -> ResolverContext -> m (Result GQLError a) +runResolverStateValueM :: (Functor m) => ResolverStateT e m a -> ResolverContext -> m (Result GQLError a) runResolverStateValueM res = fmap (fmap snd) . runResolverStateM res runResolverState :: ResolverState a -> ResolverContext -> GQLResult a @@ -153,10 +153,10 @@ instance (Monad m) => MonadError GQLError (ResolverStateT e m) where throwError err = do ctx <- asks id let f = if isInternal err then renderInternalResolverError ctx else resolverFailureMessage ctx - ResolverStateT $ - lift $ - throwError $ - f err + ResolverStateT + $ lift + $ throwError + $ f err catchError (ResolverStateT mx) f = ResolverStateT $ catchError mx (_runResolverStateT . f) instance (Monad m) => PushEvents e (ResolverStateT e m) where @@ -171,7 +171,7 @@ mapResolverState :: mapResolverState f (ResolverStateT x) = ResolverStateT (mapReaderT f x) toResolverStateT :: - Applicative m => + (Applicative m) => ResolverState a -> ResolverStateT e m a toResolverStateT = mapResolverState injectResult @@ -204,9 +204,9 @@ resolverFailureMessage renderInternalResolverError :: ResolverContext -> GQLError -> GQLError renderInternalResolverError ctx@ResolverContext {currentSelection} err = - internal $ - (err <> ". " <> msg (renderContext ctx)) - `at` selectionPosition currentSelection + internal + $ (err <> ". " <> msg (renderContext ctx)) + `at` selectionPosition currentSelection withInternalContext :: ResolverContext -> GQLError withInternalContext ResolverContext {config = Config {debug = False}} = "" @@ -225,7 +225,7 @@ renderContext <> renderSection "OperationDefinition" operation <> renderSection "SchemaDefinition" schema -renderSection :: RenderGQL a => GQLError -> a -> GQLError +renderSection :: (RenderGQL a) => GQLError -> a -> GQLError renderSection label content = "\n\n" <> label diff --git a/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/SchemaAPI.hs b/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/SchemaAPI.hs index 3fb9a1a446..e9ba33bd06 100644 --- a/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/SchemaAPI.hs +++ b/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/SchemaAPI.hs @@ -42,8 +42,8 @@ import Relude hiding (empty) resolveSchema :: (MonadResolver m) => Schema VALID -> m (ResolverValue m) resolveSchema schema@Schema {..} = - pure $ - mkObject + pure + $ mkObject "__Schema" [ ("types", renderI $ toList $ typeDefinitions schema), ("queryType", renderI (Just query)), diff --git a/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/Utils.hs b/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/Utils.hs index d158662faf..8c4b59ba71 100644 --- a/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/Utils.hs +++ b/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Resolving/Utils.hs @@ -76,7 +76,7 @@ lookupResJSON name (Object fields) = fields lookupResJSON _ _ = mkEmptyObject -mkEmptyObject :: Monad m => m (ObjectTypeResolver a) +mkEmptyObject :: (Monad m) => m (ObjectTypeResolver a) mkEmptyObject = pure $ ObjectTypeResolver mempty mkValue :: @@ -110,7 +110,7 @@ withSelf txt = case breakOnEnd "::" txt of _ -> NoAPI txt _ -> NoAPI txt -requireObject :: MonadError GQLError f => ResolverValue m -> f (ObjectTypeResolver m) +requireObject :: (MonadError GQLError f) => ResolverValue m -> f (ObjectTypeResolver m) requireObject (ResObject _ x) = pure x requireObject _ = throwError (internal "resolver must be an object") @@ -118,7 +118,7 @@ unpackJSONName :: Value -> Maybe TypeName unpackJSONName (String x) = Just (packName x) unpackJSONName _ = Nothing -withField :: Monad m' => a -> (m (ResolverValue m) -> m' a) -> FieldName -> ObjectTypeResolver m -> m' a +withField :: (Monad m') => a -> (m (ResolverValue m) -> m' a) -> FieldName -> ObjectTypeResolver m -> m' a withField fb suc selectionName ObjectTypeResolver {..} = maybe (pure fb) suc (lookup selectionName objectFields) withObject :: diff --git a/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Stitching.hs b/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Stitching.hs index c6daca6fe1..dd1633a94d 100644 --- a/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Stitching.hs +++ b/morpheus-graphql-app/src/Data/Morpheus/App/Internal/Stitching.hs @@ -50,7 +50,7 @@ equal err p1 p2 | p1 == p2 = pure p2 | otherwise = throwError err -fstM :: Applicative m => a -> a -> m a +fstM :: (Applicative m) => a -> a -> m a fstM x _ = pure x concatM :: (Applicative m, Semigroup a) => a -> a -> m a @@ -59,7 +59,7 @@ concatM x = pure . (x <>) class Stitching a where stitch :: (Monad m, MonadError GQLError m) => a -> a -> m a -instance Stitching a => Stitching (Maybe a) where +instance (Stitching a) => Stitching (Maybe a) where stitch = optional stitch instance Stitching (Schema s) where @@ -80,7 +80,7 @@ instance Stitching (DirectivesDefinition s) where instance Stitching (Directives s) where stitch = merge -optional :: Applicative f => (t -> t -> f t) -> Maybe t -> Maybe t -> f (Maybe t) +optional :: (Applicative f) => (t -> t -> f t) -> Maybe t -> Maybe t -> f (Maybe t) optional _ Nothing y = pure y optional _ (Just x) Nothing = pure (Just x) optional f (Just x) (Just y) = Just <$> f x y @@ -132,7 +132,7 @@ rootProp f x y = do y' <- f y merge x' y' -stitchSubscriptions :: MonadError GQLError m => Maybe a -> Maybe a -> m (Maybe a) +stitchSubscriptions :: (MonadError GQLError m) => Maybe a -> Maybe a -> m (Maybe a) stitchSubscriptions Just {} Just {} = throwError ("can't merge subscription applications" :: GQLError) stitchSubscriptions x Nothing = pure x stitchSubscriptions Nothing x = pure x @@ -165,11 +165,11 @@ instance (MonadError GQLError m) => Stitching (NamedResolver m) where } | otherwise = throwError "ResolverMap must have same resolverName" -instance Monad m => Stitching (RootResolverValue e m) where +instance (Monad m) => Stitching (RootResolverValue e m) where stitch x@RootResolverValue {} y@RootResolverValue {} = do channelMap <- stitchSubscriptions (channelMap x) (channelMap y) - pure $ - RootResolverValue + pure + $ RootResolverValue { queryResolver = rootProp queryResolver x y, mutationResolver = rootProp mutationResolver x y, subscriptionResolver = rootProp subscriptionResolver x y, diff --git a/morpheus-graphql-app/src/Data/Morpheus/App/NamedResolvers.hs b/morpheus-graphql-app/src/Data/Morpheus/App/NamedResolvers.hs index 8be6729d6c..65b51c179d 100644 --- a/morpheus-graphql-app/src/Data/Morpheus/App/NamedResolvers.hs +++ b/morpheus-graphql-app/src/Data/Morpheus/App/NamedResolvers.hs @@ -50,10 +50,10 @@ enum = mkEnum list :: [ResolverValue m] -> ResolverValue m list = mkList -ref :: Applicative m => TypeName -> ValidValue -> ResolverValue m +ref :: (Applicative m) => TypeName -> ValidValue -> ResolverValue m ref typeName = ResRef . pure . NamedResolverRef typeName . pure -refs :: Applicative m => TypeName -> [ValidValue] -> ResolverValue m +refs :: (Applicative m) => TypeName -> [ValidValue] -> ResolverValue m refs typeName = mkList . map (ref typeName) type NamedResolverFunction o e m = NamedFunction (Resolver o e m) @@ -70,7 +70,7 @@ variant tName = pure . Union tName nullRes :: (MonadResolver m) => m (ResultBuilder m) nullRes = pure Null -queryResolvers :: Monad m => [(TypeName, NamedFunction (Resolver QUERY e m))] -> RootResolverValue e m +queryResolvers :: (Monad m) => [(TypeName, NamedFunction (Resolver QUERY e m))] -> RootResolverValue e m queryResolvers = NamedResolversValue . mkResolverMap -- INTERNAL @@ -79,10 +79,10 @@ data ResultBuilder m | Union TypeName ValidValue | Null -mkResolverMap :: MonadResolver m => [(TypeName, NamedFunction m)] -> ResolverMap m +mkResolverMap :: (MonadResolver m) => [(TypeName, NamedFunction m)] -> ResolverMap m mkResolverMap = HM.fromList . map packRes where - packRes :: MonadResolver m => (TypeName, NamedFunction m) -> (TypeName, NamedResolver m) + packRes :: (MonadResolver m) => (TypeName, NamedFunction m) -> (TypeName, NamedResolver m) packRes (typeName, f) = (typeName, NamedResolver typeName (fmap (map mapValue) . f)) where mapValue (Object x) = NamedObjectResolver (ObjectTypeResolver $ HM.fromList x) diff --git a/morpheus-graphql-app/src/Data/Morpheus/App/RenderIntrospection.hs b/morpheus-graphql-app/src/Data/Morpheus/App/RenderIntrospection.hs index b90c303461..3339597412 100644 --- a/morpheus-graphql-app/src/Data/Morpheus/App/RenderIntrospection.hs +++ b/morpheus-graphql-app/src/Data/Morpheus/App/RenderIntrospection.hs @@ -76,13 +76,13 @@ import Relude iError :: GQLError -> GQLError iError x = internal ("INTROSPECTION" <> x) -getType :: MonadResolver m => TypeName -> m TypeDef +getType :: (MonadResolver m) => TypeName -> m TypeDef getType name = asks schema >>= selectBy (iError $ "type \"" <> msg name <> "\" not found!") name - . typeDefinitions + . typeDefinitions -assertINTERFACE :: MonadResolver m => TypeDef -> m TypeDef +assertINTERFACE :: (MonadResolver m) => TypeDef -> m TypeDef assertINTERFACE t@TypeDefinition {typeContent = DataInterface {}} = pure t assertINTERFACE t = throwError $ iError $ "Type " <> msg (typeName t) <> " must be an Interface!" @@ -93,7 +93,7 @@ type IValue m = m (ResolverValue m) type IField m = (FieldName, IValue m) class RenderI a where - renderI :: MonadResolver m => a -> IValue m + renderI :: (MonadResolver m) => a -> IValue m instance RenderI (Name t) where renderI = pure . mkString . unpackName @@ -101,10 +101,10 @@ instance RenderI (Name t) where instance RenderI Description where renderI = pure . mkString -instance RenderI a => RenderI [a] where +instance (RenderI a) => RenderI [a] where renderI ls = mkList <$> traverse renderI ls -instance RenderI a => RenderI (Maybe a) where +instance (RenderI a) => RenderI (Maybe a) where renderI (Just value) = renderI value renderI Nothing = pure mkNull @@ -130,9 +130,9 @@ instance RenderI DirectiveLocation where instance RenderI (TypeDefinition c VALID) where renderI TypeDefinition {..} = renderContent typeContent where - __type :: MonadResolver m => TypeKind -> [IField m] -> IValue m + __type :: (MonadResolver m) => TypeKind -> [IField m] -> IValue m __type kind = __Type kind typeName typeDescription - renderContent :: MonadResolver m => TypeContent bool a VALID -> IValue m + renderContent :: (MonadResolver m) => TypeContent bool a VALID -> IValue m renderContent DataScalar {} = __type KIND_SCALAR [] renderContent (DataEnum enums) = __type KIND_ENUM [("enumValues", renderI enums)] renderContent (DataInputObject inputFields) = @@ -175,7 +175,7 @@ instance RenderI (TypeDefinition c VALID) where instance RenderI (UnionMember OUT s) where renderI UnionMember {memberName} = getType memberName >>= renderI -instance RenderI (FieldDefinition cat s) => RenderI (FieldsDefinition cat s) where +instance (RenderI (FieldDefinition cat s)) => RenderI (FieldsDefinition cat s) where renderI = renderI . filter fieldVisibility . toList instance RenderI (FieldContent TRUE IN VALID) where @@ -187,13 +187,13 @@ instance RenderI (Value VALID) where instance RenderI (FieldDefinition OUT VALID) where renderI FieldDefinition {..} = - object "__Field" $ - [ fName fieldName, - fDescription fieldDescription, - fType fieldType, - ("args", maybe (pure $ mkList []) renderI fieldContent) - ] - <> fDeprecated fieldDirectives + object "__Field" + $ [ fName fieldName, + fDescription fieldDescription, + fType fieldType, + ("args", maybe (pure $ mkList []) renderI fieldContent) + ] + <> fDeprecated fieldDirectives instance RenderI (FieldContent TRUE OUT VALID) where renderI (FieldArgs args) = renderI args @@ -213,11 +213,11 @@ instance RenderI (FieldDefinition IN VALID) where instance RenderI (DataEnumValue VALID) where renderI DataEnumValue {..} = - object "__EnumValue" $ - [ fName enumName, - fDescription enumDescription - ] - <> fDeprecated enumDirectives + object "__EnumValue" + $ [ fName enumName, + fDescription enumDescription + ] + <> fDeprecated enumDirectives instance RenderI TypeRef where renderI TypeRef {..} = renderWrapper typeWrappers @@ -229,12 +229,12 @@ instance RenderI TypeRef where kind <- kindOf <$> getType typeConName __Type kind typeConName Nothing [] -withNonNull :: MonadResolver m => Bool -> IValue m -> IValue m +withNonNull :: (MonadResolver m) => Bool -> IValue m -> IValue m withNonNull True = wrapper KIND_NON_NULL withNonNull False = id __Type :: - MonadResolver m => + (MonadResolver m) => TypeKind -> Name t -> Maybe Description -> @@ -250,7 +250,7 @@ __Type kind name desc etc = <> etc ) -wrapper :: MonadResolver m => TypeKind -> IValue m -> IValue m +wrapper :: (MonadResolver m) => TypeKind -> IValue m -> IValue m wrapper k t = object "__Type" @@ -258,26 +258,26 @@ wrapper k t = ("ofType", t) ] -object :: Monad m => TypeName -> [IField m] -> IValue m +object :: (Monad m) => TypeName -> [IField m] -> IValue m object name = pure . mkObject name -fDeprecated :: MonadResolver m => Directives s -> [IField m] +fDeprecated :: (MonadResolver m) => Directives s -> [IField m] fDeprecated dirs = [ ("isDeprecated", renderI (isJust $ lookupDeprecated dirs)), ("deprecationReason", renderI (lookupDeprecated dirs >>= lookupDeprecatedReason)) ] -fDescription :: MonadResolver m => Maybe Description -> IField m +fDescription :: (MonadResolver m) => Maybe Description -> IField m fDescription = ("description",) . renderI -fName :: MonadResolver m => Name t -> IField m +fName :: (MonadResolver m) => Name t -> IField m fName = ("name",) . renderI -fKind :: MonadResolver m => TypeKind -> IField m +fKind :: (MonadResolver m) => TypeKind -> IField m fKind = ("kind",) . renderI -fType :: MonadResolver m => TypeRef -> IField m +fType :: (MonadResolver m) => TypeRef -> IField m fType = ("type",) . renderI -fDefaultValue :: MonadResolver m => Maybe (FieldContent TRUE IN VALID) -> IField m +fDefaultValue :: (MonadResolver m) => Maybe (FieldContent TRUE IN VALID) -> IField m fDefaultValue = ("defaultValue",) . renderI diff --git a/morpheus-graphql-app/src/Data/Morpheus/Types/GQLWrapper.hs b/morpheus-graphql-app/src/Data/Morpheus/Types/GQLWrapper.hs index 265cca075d..23dfb6fec4 100644 --- a/morpheus-graphql-app/src/Data/Morpheus/Types/GQLWrapper.hs +++ b/morpheus-graphql-app/src/Data/Morpheus/Types/GQLWrapper.hs @@ -108,7 +108,7 @@ haveSameSize setVal listVal | otherwise = ExceptT $ pure $ Left (fromString ("Expected a List without duplicates, found " <> show (length listVal - length setVal) <> " duplicates")) withRefinedList :: - Monad m => + (Monad m) => ([a] -> Either GQLError (rList a)) -> (ValidValue -> m a) -> ValidValue -> diff --git a/morpheus-graphql-app/test/APIConstraints.hs b/morpheus-graphql-app/test/APIConstraints.hs index 445be46a5a..fc9a3775d3 100644 --- a/morpheus-graphql-app/test/APIConstraints.hs +++ b/morpheus-graphql-app/test/APIConstraints.hs @@ -44,13 +44,13 @@ import Test.Tasty ( TestTree, ) -resolvers :: Monad m => RootResolverValue e m +resolvers :: (Monad m) => RootResolverValue e m resolvers = queryResolvers [ ( "Query", traverse - ( const $ - object + ( const + $ object [ ("success", pure "success"), ("forbidden", pure "forbidden!"), ("limited", pure "num <= 5") diff --git a/morpheus-graphql-app/test/Batching.hs b/morpheus-graphql-app/test/Batching.hs index f07855d7af..bcf5c90d36 100644 --- a/morpheus-graphql-app/test/Batching.hs +++ b/morpheus-graphql-app/test/Batching.hs @@ -61,10 +61,10 @@ type BatchedValues = (HashSet ValidValue) type BatchingConstraints = Map Text BatchedValues -typeConstraint :: Monad m => BatchingConstraints -> (TypeName, NamedResolverFunction QUERY e m) -> (TypeName, NamedResolverFunction QUERY e m) +typeConstraint :: (Monad m) => BatchingConstraints -> (TypeName, NamedResolverFunction QUERY e m) -> (TypeName, NamedResolverFunction QUERY e m) typeConstraint cons (name, f) = (name,) $ maybe f (require f) (lookup (unpackName name) cons) -require :: Monad m => NamedResolverFunction QUERY e m -> BatchedValues -> NamedResolverFunction QUERY e m +require :: (Monad m) => NamedResolverFunction QUERY e m -> BatchedValues -> NamedResolverFunction QUERY e m require f req args | fromList args == req = f args | otherwise = throwError ("was not batched! expected: " <> msg (List $ toList req) <> "got: " <> msg (List args)) @@ -84,7 +84,7 @@ getPowers "zeus" = [enum "Thunderbolt"] getPowers "morpheus" = [enum "Shapeshifting"] getPowers _ = [] -deityResolver :: Monad m => NamedResolverFunction QUERY e m +deityResolver :: (Monad m) => NamedResolverFunction QUERY e m deityResolver = traverse getDeity where getDeity name @@ -95,7 +95,7 @@ deityResolver = traverse getDeity ] | otherwise = nullRes -resolveQuery :: Monad m => NamedResolverFunction QUERY e m +resolveQuery :: (Monad m) => NamedResolverFunction QUERY e m resolveQuery = traverse getQuery where getQuery _ = @@ -104,13 +104,13 @@ resolveQuery = traverse getQuery ("deities", pure $ refs "Deity" ["zeus", "morpheus"]) ] -resolvers :: Monad m => BatchingConstraints -> RootResolverValue e m +resolvers :: (Monad m) => BatchingConstraints -> RootResolverValue e m resolvers cons = - queryResolvers $ - typeConstraint cons - <$> [ ("Query", resolveQuery), - ("Deity", deityResolver) - ] + queryResolvers + $ typeConstraint cons + <$> [ ("Query", resolveQuery), + ("Deity", deityResolver) + ] getSchema :: FileUrl -> IO (Schema VALID) getSchema url = LBS.readFile (toString url) >>= resultOr (fail . show) pure . parseSchema diff --git a/morpheus-graphql-app/test/Execution.hs b/morpheus-graphql-app/test/Execution.hs index 4124adc2da..9a2d6e11eb 100644 --- a/morpheus-graphql-app/test/Execution.hs +++ b/morpheus-graphql-app/test/Execution.hs @@ -56,23 +56,23 @@ getName "poseidon" = "Zeus" getName "cronos" = "Cronos" getName _ = "" -restrictExecutions :: Monad m => Int -> ResQ m () +restrictExecutions :: (Monad m) => Int -> ResQ m () restrictExecutions expected = do count <- lift get if expected == count then pure () else throwError ("unexpected execution count. expected " <> msg expected <> " but got " <> msg count <> ".") -deityResolver :: Monad m => ValidValue -> ResQ m (ResolverValue (ResQ m)) +deityResolver :: (Monad m) => ValidValue -> ResQ m (ResolverValue (ResQ m)) deityResolver name = do lift (modify (+ 1)) pure $ mkObject "Deity" [("name", pure $ getName name)] -resolvers :: Monad m => RootResolverValue () (ExecState m) +resolvers :: (Monad m) => RootResolverValue () (ExecState m) resolvers = RootResolverValue { queryResolver = pure - ( ObjectTypeResolver $ - fromList + ( ObjectTypeResolver + $ fromList [ ("deity", (getArgument "id" >>= deityResolver) <* restrictExecutions 1), ("deities", (list <$> traverse deityResolver ["zeus", "morpheus"]) <* restrictExecutions 2) ] diff --git a/morpheus-graphql-app/test/NamedResolvers.hs b/morpheus-graphql-app/test/NamedResolvers.hs index 7cd41edf4e..9464abc81b 100644 --- a/morpheus-graphql-app/test/NamedResolvers.hs +++ b/morpheus-graphql-app/test/NamedResolvers.hs @@ -47,13 +47,13 @@ import Test.Tasty ) -- DEITIES -resolverDeities :: Monad m => RootResolverValue e m +resolverDeities :: (Monad m) => RootResolverValue e m resolverDeities = queryResolvers [ ( "Query", traverse - ( const $ - object + ( const + $ object [ ("deity", ref "Deity" <$> getArgument "id"), ("deities", pure $ refs "Deity" ["zeus", "morpheus"]) ] @@ -62,7 +62,7 @@ resolverDeities = ("Deity", deityResolver) ] -deityResolver :: Monad m => NamedResolverFunction QUERY e m +deityResolver :: (Monad m) => NamedResolverFunction QUERY e m deityResolver = traverse deityRes where deityRes "zeus" = @@ -77,13 +77,13 @@ deityResolver = traverse deityRes ] -- REALMS -resolverRealms :: Monad m => RootResolverValue e m +resolverRealms :: (Monad m) => RootResolverValue e m resolverRealms = queryResolvers [ ( "Query", traverse - ( const $ - object + ( const + $ object [ ("realm", ref "Realm" <$> getArgument "id"), ("realms", pure $ refs "Realm" ["olympus", "dreams"]) ] @@ -93,14 +93,14 @@ resolverRealms = ("Realm", realmResolver) ] -deityResolverExt :: Monad m => NamedResolverFunction QUERY e m +deityResolverExt :: (Monad m) => NamedResolverFunction QUERY e m deityResolverExt = traverse deityExt where deityExt "zeus" = object [("realm", pure $ ref "Realm" "olympus")] deityExt "morpheus" = object [("realm", pure $ ref "Realm" "dreams")] deityExt _ = object [] -realmResolver :: Monad m => NamedResolverFunction QUERY e m +realmResolver :: (Monad m) => NamedResolverFunction QUERY e m realmResolver = traverse realmResolver' where realmResolver' "olympus" = @@ -119,17 +119,17 @@ realmResolver = traverse realmResolver' ] -- ENTITIES -resolverEntities :: Monad m => RootResolverValue e m +resolverEntities :: (Monad m) => RootResolverValue e m resolverEntities = queryResolvers [ ( "Query", traverse - ( const $ - object + ( const + $ object [ ("entity", ref "Entity" <$> getArgument "id"), ( "entities", - pure $ - refs + pure + $ refs "Entity" ["zeus", "morpheus", "olympus", "dreams"] ) @@ -139,7 +139,7 @@ resolverEntities = ("Entity", resolveEntity) ] -resolveEntity :: Monad m => NamedResolverFunction QUERY e m +resolveEntity :: (Monad m) => NamedResolverFunction QUERY e m resolveEntity = traverse resEntity where resEntity "zeus" = variant "Deity" "zeus" @@ -156,10 +156,10 @@ getApps _ = do schemaDeities <- getSchema "test/named-resolvers/deities.gql" schemaRealms <- getSchema "test/named-resolvers/realms.gql" schemaEntities <- getSchema "test/named-resolvers/entities.gql" - pure $ - mkApp schemaDeities resolverDeities - <> mkApp schemaRealms resolverRealms - <> mkApp schemaEntities resolverEntities + pure + $ mkApp schemaDeities resolverDeities + <> mkApp schemaRealms resolverRealms + <> mkApp schemaEntities resolverEntities runNamedResolversTest :: FileUrl -> FileUrl -> TestTree runNamedResolversTest url = testApi api diff --git a/morpheus-graphql-client/src/Data/Morpheus/Client/CodeGen/AST.hs b/morpheus-graphql-client/src/Data/Morpheus/Client/CodeGen/AST.hs index df5a3153b1..06c161e5f8 100644 --- a/morpheus-graphql-client/src/Data/Morpheus/Client/CodeGen/AST.hs +++ b/morpheus-graphql-client/src/Data/Morpheus/Client/CodeGen/AST.hs @@ -115,10 +115,10 @@ instance Pretty ClientMethod where mapP (UString v) = prettyLit v mapP (UVar v) = pretty v -list :: Foldable t => t (Doc ann) -> Doc ann +list :: (Foldable t) => t (Doc ann) -> Doc ann list xs = "[" <> indent 1 (foldr1 (\a b -> a <> "," <> line <> b) xs) <> line <> "]" -tuple :: Foldable t => t (Doc ann) -> Doc ann +tuple :: (Foldable t) => t (Doc ann) -> Doc ann tuple ls = "(" <> foldr1 (\a b -> a <> "," <+> b) ls <> ")" instance PrintExp ClientMethod where @@ -162,7 +162,7 @@ printFieldExp (v, o, str) = uInfixE (toVar v) (toVar o) (toString str) printFieldDoc :: AesonField -> Doc n printFieldDoc (v, o, l) = printTHName v <+> printTHName o <+> prettyLit l -prettyLit :: Show a => a -> Doc ann +prettyLit :: (Show a) => a -> Doc ann prettyLit a = pretty (show a) prettyName :: TypeName -> Doc ann diff --git a/morpheus-graphql-client/src/Data/Morpheus/Client/CodeGen/Interpreting/Local.hs b/morpheus-graphql-client/src/Data/Morpheus/Client/CodeGen/Interpreting/Local.hs index d86ddcb7d5..d579005fc7 100755 --- a/morpheus-graphql-client/src/Data/Morpheus/Client/CodeGen/Interpreting/Local.hs +++ b/morpheus-graphql-client/src/Data/Morpheus/Client/CodeGen/Interpreting/Local.hs @@ -166,11 +166,11 @@ checkTypename :: Position -> [FieldName] -> Maybe (SelectionSet VALID) -> UnionT checkTypename pos path iFace UnionTag {..} | any (member "__typename") (unionTagSelection : toList iFace) = pure () | otherwise = - warning $ - withPath + warning + $ withPath ("missing \"__typename\" for selection " <> msg unionTagName <> ". this can lead to undesired behavior at runtime!") (map (PropName . unpackName) path) - `at` pos + `at` pos type Variant = (CodeGenTypeName, Maybe TypeName) diff --git a/morpheus-graphql-client/src/Data/Morpheus/Client/CodeGen/Interpreting/PreDeclarations.hs b/morpheus-graphql-client/src/Data/Morpheus/Client/CodeGen/Interpreting/PreDeclarations.hs index 12a48d9c3e..a0c16ad9bc 100644 --- a/morpheus-graphql-client/src/Data/Morpheus/Client/CodeGen/Interpreting/PreDeclarations.hs +++ b/morpheus-graphql-client/src/Data/Morpheus/Client/CodeGen/Interpreting/PreDeclarations.hs @@ -56,7 +56,7 @@ import Data.Morpheus.Types.Internal.AST (Msg (..), internal) import Language.Haskell.TH.Syntax (Name) import Relude hiding (ToString, Type, toString) -mapPreDeclarations :: MonadFail m => ClientPreDeclaration -> m ClientDeclaration +mapPreDeclarations :: (MonadFail m) => ClientPreDeclaration -> m ClientDeclaration mapPreDeclarations (FromJSONClass mode dec) = InstanceDeclaration mode <$> deriveFromJSON mode dec mapPreDeclarations (FromJSONObjectClass cType CodeGenConstructor {..}) = pure $ InstanceDeclaration TYPE_MODE $ mkFromJSON cType $ FromJSONObjectMethod (getFullName constructorName) (map defField constructorFields) @@ -84,13 +84,13 @@ getRequestInstance RequestTypeDefinition {..} = ] -- FromJSON -deriveFromJSONMethod :: MonadFail m => DERIVING_MODE -> CodeGenType -> m ClientMethod +deriveFromJSONMethod :: (MonadFail m) => DERIVING_MODE -> CodeGenType -> m ClientMethod deriveFromJSONMethod SCALAR_MODE _ = pure $ FunctionNameMethod 'scalarFromJSON deriveFromJSONMethod ENUM_MODE CodeGenType {..} = - pure $ - MatchMethod $ - map (fromJSONEnum . constructorName) cgConstructors - <> [MFunction "v" 'invalidConstructorError] + pure + $ MatchMethod + $ map (fromJSONEnum . constructorName) cgConstructors + <> [MFunction "v" 'invalidConstructorError] deriveFromJSONMethod _ CodeGenType {..} = emptyTypeError cgTypeName defField :: CodeGenField -> AesonField @@ -101,7 +101,7 @@ bindField nullable | nullable = '(.:?) | otherwise = '(.:) -deriveToJSONMethod :: MonadFail m => DERIVING_MODE -> CodeGenType -> m (MethodArgument, ClientMethod) +deriveToJSONMethod :: (MonadFail m) => DERIVING_MODE -> CodeGenType -> m (MethodArgument, ClientMethod) deriveToJSONMethod SCALAR_MODE _ = pure (NoArgument, FunctionNameMethod 'scalarToJSON) deriveToJSONMethod _ CodeGenType {cgConstructors = [], ..} = emptyTypeError cgTypeName deriveToJSONMethod ENUM_MODE CodeGenType {cgConstructors} = @@ -129,7 +129,7 @@ toJSONEnum name = MTo (getFullName name) (typename name) fromJSONEnum :: CodeGenTypeName -> MValue fromJSONEnum name = MFrom (typename name) (getFullName name) -deriveToJSON :: MonadFail m => DERIVING_MODE -> CodeGenType -> m (TypeClassInstance ClientMethod) +deriveToJSON :: (MonadFail m) => DERIVING_MODE -> CodeGenType -> m (TypeClassInstance ClientMethod) deriveToJSON mode cType = do (args, expr) <- deriveToJSONMethod mode cType pure @@ -151,8 +151,8 @@ mkFromJSON typeClassTarget expr = typeClassMethods = [('parseJSON, NoArgument, expr)] } -deriveFromJSON :: MonadFail m => DERIVING_MODE -> CodeGenType -> m (TypeClassInstance ClientMethod) +deriveFromJSON :: (MonadFail m) => DERIVING_MODE -> CodeGenType -> m (TypeClassInstance ClientMethod) deriveFromJSON mode cType = mkFromJSON (cgTypeName cType) <$> deriveFromJSONMethod mode cType -emptyTypeError :: MonadFail m => CodeGenTypeName -> m a +emptyTypeError :: (MonadFail m) => CodeGenTypeName -> m a emptyTypeError name = fail $ show $ internal ("Type " <> msg (getFullName name) <> " Should Have at least one Constructor") diff --git a/morpheus-graphql-client/src/Data/Morpheus/Client/CodeGen/QuasiQuoter.hs b/morpheus-graphql-client/src/Data/Morpheus/Client/CodeGen/QuasiQuoter.hs index c4d54681b0..444ecd5b0d 100644 --- a/morpheus-graphql-client/src/Data/Morpheus/Client/CodeGen/QuasiQuoter.hs +++ b/morpheus-graphql-client/src/Data/Morpheus/Client/CodeGen/QuasiQuoter.hs @@ -17,9 +17,9 @@ import Relude hiding (ByteString) notSupported :: Text -> a notSupported things = - error $ - things - <> " are not supported by the GraphQL QuasiQuoter" + error + $ things + <> " are not supported by the GraphQL QuasiQuoter" -- | QuasiQuoter to insert multiple lines of text in Haskell raw :: QuasiQuoter diff --git a/morpheus-graphql-client/src/Data/Morpheus/Client/Fetch.hs b/morpheus-graphql-client/src/Data/Morpheus/Client/Fetch.hs index c9aafb2e28..2c1f0f92ee 100644 --- a/morpheus-graphql-client/src/Data/Morpheus/Client/Fetch.hs +++ b/morpheus-graphql-client/src/Data/Morpheus/Client/Fetch.hs @@ -28,12 +28,12 @@ import Data.Morpheus.Client.Fetch.Types ) import Relude hiding (ByteString) -decodeResponse :: FromJSON a => ByteString -> Either (FetchError a) a +decodeResponse :: (FromJSON a) => ByteString -> Either (FetchError a) a decodeResponse = (first FetchErrorParseFailure . eitherDecode) >=> processResponse class (RequestType a, ToJSON (Args a), FromJSON a) => Fetch a where type Args a :: Type - fetch :: Monad m => (ByteString -> m ByteString) -> Args a -> m (Either (FetchError a) a) + fetch :: (Monad m) => (ByteString -> m ByteString) -> Args a -> m (Either (FetchError a) a) instance (RequestType a, ToJSON (Args a), FromJSON a) => Fetch a where type Args a = RequestArgs a diff --git a/morpheus-graphql-client/src/Data/Morpheus/Client/Fetch/RequestType.hs b/morpheus-graphql-client/src/Data/Morpheus/Client/Fetch/RequestType.hs index 6ed020746e..0a272a31dc 100644 --- a/morpheus-graphql-client/src/Data/Morpheus/Client/Fetch/RequestType.hs +++ b/morpheus-graphql-client/src/Data/Morpheus/Client/Fetch/RequestType.hs @@ -61,7 +61,7 @@ toRequest r@Request {requestArgs} = } ) -decodeResponse :: FromJSON a => ByteString -> Either (FetchError a) a +decodeResponse :: (FromJSON a) => ByteString -> Either (FetchError a) a decodeResponse = (first FetchErrorParseFailure . eitherDecode) >=> processResponse processResponse :: JSONResponse a -> Either (FetchError a) a @@ -79,5 +79,5 @@ class RequestType a where newtype Request (a :: Type) = Request {requestArgs :: RequestArgs a} -isSubscription :: RequestType a => Request a -> Bool +isSubscription :: (RequestType a) => Request a -> Bool isSubscription x = __type x == OPERATION_SUBSCRIPTION diff --git a/morpheus-graphql-client/src/Data/Morpheus/Client/Fetch/ResponseStream.hs b/morpheus-graphql-client/src/Data/Morpheus/Client/Fetch/ResponseStream.hs index ba4e2e55a4..e115386eb0 100644 --- a/morpheus-graphql-client/src/Data/Morpheus/Client/Fetch/ResponseStream.hs +++ b/morpheus-graphql-client/src/Data/Morpheus/Client/Fetch/ResponseStream.hs @@ -39,7 +39,7 @@ import qualified Data.Text as T import Relude hiding (ByteString) import Text.URI (URI, mkURI) -parseURI :: MonadFail m => String -> m URI +parseURI :: (MonadFail m) => String -> m URI parseURI url = maybe (fail ("Invalid Endpoint: " <> show url <> "!")) pure (mkURI (T.pack url)) requestSingle :: ResponseStream a -> IO (Either (FetchError a) a) @@ -68,7 +68,8 @@ requestMany f ResponseStream {..} endSession conn sid -- PUBLIC API -data ResponseStream a = ClientTypeConstraint a => +data ResponseStream a + = (ClientTypeConstraint a) => ResponseStream { _req :: Request a, _uri :: URI, @@ -83,7 +84,7 @@ request GQLClient {clientURI, clientHeaders} requestArgs = do pure ResponseStream {_req, _uri, _headers = clientHeaders} -- | returns first response from the server -single :: MonadIO m => ResponseStream a -> m (GQLClientResult a) +single :: (MonadIO m) => ResponseStream a -> m (GQLClientResult a) single = liftIO . requestSingle -- | returns loop listening subscription events forever. if you want to run it in background use `forkIO` diff --git a/morpheus-graphql-client/src/Data/Morpheus/Client/Fetch/WebSockets.hs b/morpheus-graphql-client/src/Data/Morpheus/Client/Fetch/WebSockets.hs index 9dfa755f6a..c93f036b6d 100644 --- a/morpheus-graphql-client/src/Data/Morpheus/Client/Fetch/WebSockets.hs +++ b/morpheus-graphql-client/src/Data/Morpheus/Client/Fetch/WebSockets.hs @@ -60,12 +60,12 @@ data WebSocketSettings = WebSocketSettings } deriving (Show) -parseProtocol :: MonadFail m => Text -> m Bool +parseProtocol :: (MonadFail m) => Text -> m Bool parseProtocol "ws" = pure False parseProtocol "wss" = pure True parseProtocol p = fail $ "unsupported protocol" <> show p -getWebsocketURI :: MonadFail m => URI -> Headers -> m WebSocketSettings +getWebsocketURI :: (MonadFail m) => URI -> Headers -> m WebSocketSettings getWebsocketURI URI {uriScheme = Just scheme, uriAuthority = Right Authority {authHost, authPort}, uriPath} headers = do isSecure <- parseProtocol $ unRText scheme pure @@ -78,7 +78,7 @@ getWebsocketURI URI {uriScheme = Just scheme, uriAuthority = Right Authority {au } getWebsocketURI uri _ = fail ("Invalid Endpoint: " <> show uri <> "!") -toHeader :: IsString a => (Text, Text) -> (a, BS.ByteString) +toHeader :: (IsString a) => (Text, Text) -> (a, BS.ByteString) toHeader (x, y) = (fromString $ T.unpack x, BS.pack $ T.unpack y) _useWS :: WebSocketSettings -> (Connection -> IO a) -> IO a @@ -98,7 +98,7 @@ processMessage :: ApolloSubscription (JSONResponse a) -> GQLClientResult a processMessage ApolloSubscription {apolloPayload = Just payload} = processResponse payload processMessage ApolloSubscription {} = Left (FetchErrorParseFailure "empty message") -decodeMessage :: A.FromJSON a => ByteString -> GQLClientResult a +decodeMessage :: (A.FromJSON a) => ByteString -> GQLClientResult a decodeMessage = (first FetchErrorParseFailure . A.eitherDecode) >=> processMessage initialMessage :: ApolloSubscription () @@ -116,10 +116,10 @@ encodeRequestMessage uid r = endMessage :: Text -> ApolloSubscription () endMessage uid = ApolloSubscription {apolloType = GqlComplete, apolloPayload = Nothing, apolloId = Just uid} -endSession :: MonadIO m => Connection -> Text -> m () +endSession :: (MonadIO m) => Connection -> Text -> m () endSession conn uid = liftIO $ sendTextData conn $ A.encode $ endMessage uid -receiveResponse :: MonadIO m => A.FromJSON a => Connection -> m (GQLClientResult a) +receiveResponse :: (MonadIO m) => (A.FromJSON a) => Connection -> m (GQLClientResult a) receiveResponse conn = liftIO $ do message <- receiveData conn pure $ decodeMessage message @@ -133,5 +133,5 @@ responseStream conn = getResponse : responseStream conn sendRequest :: (RequestType a, A.ToJSON (RequestArgs a), MonadIO m) => Connection -> Text -> Request a -> m () sendRequest conn uid r = liftIO $ sendTextData conn (encodeRequestMessage uid r) -sendInitialRequest :: MonadIO m => Connection -> m () +sendInitialRequest :: (MonadIO m) => Connection -> m () sendInitialRequest conn = liftIO $ sendTextData conn (A.encode initialMessage) diff --git a/morpheus-graphql-client/src/Data/Morpheus/Client/Schema/JSON/Types.hs b/morpheus-graphql-client/src/Data/Morpheus/Client/Schema/JSON/Types.hs index c9acda780f..e5d4420ae6 100644 --- a/morpheus-graphql-client/src/Data/Morpheus/Client/Schema/JSON/Types.hs +++ b/morpheus-graphql-client/src/Data/Morpheus/Client/Schema/JSON/Types.hs @@ -91,7 +91,7 @@ instance FromJSON EnumValue where where objectParser o = EnumValue <$> o .: "name" -instance FromJSON a => FromJSON (JSONResponse a) where +instance (FromJSON a) => FromJSON (JSONResponse a) where parseJSON = withObject "JSONResponse" objectParser where objectParser o = diff --git a/morpheus-graphql-client/test/Case/Github/Test.hs b/morpheus-graphql-client/test/Case/Github/Test.hs index 4973a41345..4e8006f517 100644 --- a/morpheus-graphql-client/test/Case/Github/Test.hs +++ b/morpheus-graphql-client/test/Case/Github/Test.hs @@ -73,16 +73,16 @@ test = }, edges = Just - [ Just $ - GetTagsRepositoryRefsEdges + [ Just + $ GetTagsRepositoryRefsEdges { cursor = "test cursor", node = Just GetTagsRepositoryRefsEdgesNode { name = "test name", target = - Just $ - GetTagsRepositoryRefsEdgesNodeTargetVariantGitObject + Just + $ GetTagsRepositoryRefsEdgesNodeTargetVariantGitObject GetTagsRepositoryRefsEdgesNodeTargetGitObject { __typename = "GitObject" } diff --git a/morpheus-graphql-client/test/Spec.hs b/morpheus-graphql-client/test/Spec.hs index eba4d99582..21046cc229 100644 --- a/morpheus-graphql-client/test/Spec.hs +++ b/morpheus-graphql-client/test/Spec.hs @@ -25,8 +25,8 @@ import Prelude main :: IO () main = - defaultMain $ - testGroup + defaultMain + $ testGroup "Client tests" [ Interface.test, LowercaseTypeName.test, diff --git a/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Internal/AST.hs b/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Internal/AST.hs index f2c1c34d93..4a051db020 100644 --- a/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Internal/AST.hs +++ b/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Internal/AST.hs @@ -86,8 +86,8 @@ instance Pretty TypeValue where pretty (TypeValueObject name xs) = pretty (unpackName name :: Text) <+> "{" - <> vsep (punctuate "," (map renderField xs)) - <> "}" + <> vsep (punctuate "," (map renderField xs)) + <> "}" pretty (TypeValueNumber x) = pretty x pretty (TypeValueString x) = pretty (show x :: String) pretty (TypeValueBool x) = pretty x @@ -111,10 +111,10 @@ instance Pretty CodeGenType where pretty t@CodeGenType {..} = (if isNewType t then "newtype" else "data") <+> ignore (print cgTypeName) - <> renderConstructors cgConstructors - <> line - <> indent 2 (renderDeriving cgDerivations) - <> line + <> renderConstructors cgConstructors + <> line + <> indent 2 (renderDeriving cgDerivations) + <> line where renderConstructors [cons] = (" =" <+>) $ print' cons renderConstructors conses = nest 2 . (line <>) . vsep . prefixVariants $ map print' conses @@ -184,8 +184,8 @@ fromTypeName = CodeGenTypeName [] [] instance Printer CodeGenTypeName where print cgName = - HSDoc (not $ null (typeParameters cgName)) $ - parametrizedType + HSDoc (not $ null (typeParameters cgName)) + $ parametrizedType (unpackName (getFullName cgName)) (typeParameters cgName) @@ -199,7 +199,7 @@ data ModuleDefinition dec = ModuleDefinition types :: [dec] } -instance Pretty dec => Pretty (ModuleDefinition dec) where +instance (Pretty dec) => Pretty (ModuleDefinition dec) where pretty ModuleDefinition {..} = vsep (map renderExtension (sort extensions)) @@ -208,12 +208,12 @@ instance Pretty dec => Pretty (ModuleDefinition dec) where <> "module" <+> pretty moduleName <+> "where" - <> line - <> line - <> vsep (map renderImport $ organizeImports imports) - <> line - <> line - <> vsep (filter notEmpty $ map pretty types) + <> line + <> line + <> vsep (map renderImport $ organizeImports imports) + <> line + <> line + <> vsep (filter notEmpty $ map pretty types) notEmpty :: Doc a -> Bool notEmpty x = not $ null (show x :: String) @@ -250,16 +250,16 @@ data TypeClassInstance body = TypeClassInstance } deriving (Show) -instance Pretty a => Pretty (TypeClassInstance a) where +instance (Pretty a) => Pretty (TypeClassInstance a) where pretty TypeClassInstance {..} = "instance" <> optional renderTypeableConstraints (typeParameters typeClassTarget) <+> printTHName typeClassName <+> typeHead <+> "where" - <> line - <> indent 2 (vsep (map renderAssoc assoc <> map renderMethodD typeClassMethods)) - <> line + <> line + <> indent 2 (vsep (map renderAssoc assoc <> map renderMethodD typeClassMethods)) + <> line where typeHead = unpack (print typeClassTarget) renderAssoc (name, a) = "type" <+> printTHName name <+> typeHead <+> "=" <+> pretty a diff --git a/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Internal/Flags.hs b/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Internal/Flags.hs index 44c865d477..9ccbd3abe6 100644 --- a/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Internal/Flags.hs +++ b/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Internal/Flags.hs @@ -40,16 +40,16 @@ newtype CodeGenT ctx (m :: Type -> Type) a = CodeGenT Flags ) -deriving instance MonadError GQLError m => MonadError GQLError (CodeGenT ctx m) +deriving instance (MonadError GQLError m) => MonadError GQLError (CodeGenT ctx m) instance MonadTrans (CodeGenT ctx) where lift = CodeGenT . lift . lift -runCodeGenT :: Monad m => CodeGenT ctx m a -> ctx -> m (a, Flags) +runCodeGenT :: (Monad m) => CodeGenT ctx m a -> ctx -> m (a, Flags) runCodeGenT (CodeGenT m) ctx = runStateT (runReaderT m ctx) mempty -langExtension :: MonadState Flags m => Text -> m () +langExtension :: (MonadState Flags m) => Text -> m () langExtension ext = modify (FlagLanguageExtension ext :) -requireExternal :: MonadState Flags m => Text -> m () +requireExternal :: (MonadState Flags m) => Text -> m () requireExternal ext = modify (FlagExternal ext :) diff --git a/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Internal/Name.hs b/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Internal/Name.hs index 70d686a307..9397b93562 100644 --- a/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Internal/Name.hs +++ b/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Internal/Name.hs @@ -35,9 +35,9 @@ capitalize = mapFstChar toUpper camelCaseTypeName :: [N.Name t] -> TypeName -> TypeName camelCaseTypeName list name = - packName $ - T.concat $ - map (capitalize . unpackName) (list <> [coerce name]) + packName + $ T.concat + $ map (capitalize . unpackName) (list <> [coerce name]) toHaskellTypeName :: TypeName -> Text toHaskellTypeName "String" = "Text" @@ -53,9 +53,9 @@ uncapitalize = mapFstChar toLower camelCaseFieldName :: TypeName -> FieldName -> FieldName camelCaseFieldName nSpace name = - packName $ - uncapitalize (unpackName nSpace) - <> capitalize (unpackName name) + packName + $ uncapitalize (unpackName nSpace) + <> capitalize (unpackName name) toHaskellName :: FieldName -> String toHaskellName name diff --git a/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Printer.hs b/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Printer.hs index ab4a8ad615..e596f61190 100644 --- a/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Printer.hs +++ b/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/Printer.hs @@ -48,7 +48,7 @@ renderMaybe False = (.<>) "Maybe" renderList :: HSDoc n -> HSDoc n renderList = pack . list . pure . rawDocument -print' :: Printer a => a -> Doc n +print' :: (Printer a) => a -> Doc n print' = unpack . print pack :: Doc n -> HSDoc n diff --git a/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/TH.hs b/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/TH.hs index 3e4ad515b9..fe25e8a702 100644 --- a/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/TH.hs +++ b/morpheus-graphql-code-gen-utils/src/Data/Morpheus/CodeGen/TH.hs @@ -66,7 +66,7 @@ import Relude hiding _' :: PatQ _' = toVar (mkName "_") -v' :: ToVar Name a => a +v' :: (ToVar Name a) => a v' = toVar (mkName "v") wrappedType :: TypeWrapper -> Type -> Type @@ -108,7 +108,7 @@ instance ToName FieldName where class ToString a b where toString :: a -> b -instance ToString a b => ToString a (Q b) where +instance (ToString a b) => ToString a (Q b) where toString = pure . toString instance ToString TypeName Lit where @@ -129,7 +129,7 @@ instance ToString FieldName Exp where class ToCon a b where toCon :: a -> b -instance ToCon a b => ToCon a (Q b) where +instance (ToCon a b) => ToCon a (Q b) where toCon = pure . toCon instance (ToName a) => ToCon a Type where @@ -150,7 +150,7 @@ instance (ToName a) => ToCon a Pat where class ToVar a b where toVar :: a -> b -instance ToVar a b => ToVar a (Q b) where +instance (ToVar a b) => ToVar a (Q b) where toVar = pure . toVar instance (ToName a) => ToVar a Type where @@ -163,7 +163,7 @@ instance (ToName a) => ToVar a Pat where toVar = VarP . toName class Apply a where - apply :: ToCon i a => i -> [a] -> a + apply :: (ToCon i a) => i -> [a] -> a instance Apply TypeQ where apply = foldl' appT . toCon @@ -289,7 +289,7 @@ printField CodeGenField {..} = foldr applyWrapper (toCon fieldType) wrappers ) -printTypeSynonym :: ToName a => a -> [Name] -> Type -> Dec +printTypeSynonym :: (ToName a) => a -> [Name] -> Type -> Dec printTypeSynonym name params = TySynD (toName name) (toTypeVars params) instance ToName CodeGenTypeName where @@ -322,7 +322,7 @@ instance PrintType AssociatedType where printType (AssociatedLocations xs) = pure $ foldr (AppT . AppT PromotedConsT . PromotedT . toName) PromotedNilT xs printType (AssociatedTypeName name) = toCon name -instance PrintExp body => PrintDec (TypeClassInstance body) where +instance (PrintExp body) => PrintDec (TypeClassInstance body) where printDec TypeClassInstance {..} = instanceD (printConstraints typeClassContext) @@ -345,8 +345,8 @@ printArg ProxyArgument = [_'] instance PrintDec CodeGenType where printDec CodeGenType {..} = - pure $ - DataD + pure + $ DataD [] (toName cgTypeName) (toTypeVars $ map toName $ typeParameters cgTypeName) diff --git a/morpheus-graphql-code-gen/app/CLI/Generator.hs b/morpheus-graphql-code-gen/app/CLI/Generator.hs index c56696b8bc..9a0345743f 100644 --- a/morpheus-graphql-code-gen/app/CLI/Generator.hs +++ b/morpheus-graphql-code-gen/app/CLI/Generator.hs @@ -49,30 +49,30 @@ collectExternals buildOptions exts = mapMaybe (resolveExternal buildOptions) (S. getImports :: ServiceOptions -> [Flag] -> [(Text, [Text])] getImports buildOptions flags = collectExternals buildOptions [x | FlagExternal x <- flags] -uniq :: Ord a => [a] -> [a] +uniq :: (Ord a) => [a] -> [a] uniq = S.toList . S.fromList processServerDocument :: BuildConfig -> Text -> ByteString -> GQLResult ByteString processServerDocument BuildConfig {..} moduleName schema = do (types, flags) <- second uniq <$> parseServerTypeDefinitions CodeGenConfig {namespace = optionNamespace buildOptions} schema - pure $ - print $ - ModuleDefinition - { moduleName, - imports = - [ ("Data.Morpheus.Server.CodeGen.Internal", ["*"]), - ("Data.Morpheus.Server.Types", ["*"]) - ] - <> map (,["*"]) (optionImports buildOptions) - <> getImports buildOptions flags, - extensions = - [ "DeriveGeneric", - "DuplicateRecordFields", - "TypeFamilies" - ] - <> getExtensions flags, - types - } + pure + $ print + $ ModuleDefinition + { moduleName, + imports = + [ ("Data.Morpheus.Server.CodeGen.Internal", ["*"]), + ("Data.Morpheus.Server.Types", ["*"]) + ] + <> map (,["*"]) (optionImports buildOptions) + <> getImports buildOptions flags, + extensions = + [ "DeriveGeneric", + "DuplicateRecordFields", + "TypeFamilies" + ] + <> getExtensions flags, + types + } isScalars :: ClientDeclaration -> Bool isScalars (InstanceDeclaration SCALAR_MODE _) = True @@ -91,25 +91,25 @@ processClientDocument BuildConfig {..} schema query moduleName = do if null types then pure Nothing else - pure $ - Just $ - print - ModuleDefinition - { moduleName, - imports = - [("Data.Morpheus.Client.CodeGen.Internal", ["*"])] - <> map (,["*"]) (optionImports buildOptions) - <> externalImports - <> getImports buildOptions flags, - extensions = - [ "DeriveGeneric", - "DuplicateRecordFields", - "OverloadedStrings", - "TypeFamilies" - ] - <> getExtensions flags, - types - } + pure + $ Just + $ print + ModuleDefinition + { moduleName, + imports = + [("Data.Morpheus.Client.CodeGen.Internal", ["*"])] + <> map (,["*"]) (optionImports buildOptions) + <> externalImports + <> getImports buildOptions flags, + extensions = + [ "DeriveGeneric", + "DuplicateRecordFields", + "OverloadedStrings", + "TypeFamilies" + ] + <> getExtensions flags, + types + } -print :: Pretty a => a -> ByteString +print :: (Pretty a) => a -> ByteString print = pack . show . pretty diff --git a/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Internal/AST.hs b/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Internal/AST.hs index 1b167539f9..5337626a9a 100644 --- a/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Internal/AST.hs +++ b/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Internal/AST.hs @@ -112,8 +112,8 @@ data InterfaceDefinition = InterfaceDefinition instance PrintDec InterfaceDefinition where printDec InterfaceDefinition {..} = - pure $ - printTypeSynonym + pure + $ printTypeSynonym aliasName [m_] ( apply @@ -144,7 +144,7 @@ instance Pretty ServerDeclaration where <+> "TypeGuard" <+> unpack (print interfaceName .<> "m") <+> unpack (print unionName .<> "m") - <> line + <> line pretty ScalarType {} = "" pretty (DataType cgType) = pretty cgType pretty (GQLTypeInstance kind gql) diff --git a/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Interpreting/Directive.hs b/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Interpreting/Directive.hs index 5fbc814c38..d9177ada84 100644 --- a/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Interpreting/Directive.hs +++ b/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Interpreting/Directive.hs @@ -55,12 +55,12 @@ import qualified Data.Morpheus.Types.Internal.AST as AST import Data.Text (head) import Relude hiding (ByteString, get, head) -withDir :: CodeGenM m => [ServerDirectiveUsage] -> m [ServerDirectiveUsage] +withDir :: (CodeGenM m) => [ServerDirectiveUsage] -> m [ServerDirectiveUsage] withDir xs | null xs = pure [] | otherwise = langExtension "OverloadedStrings" >> pure xs -getRenameDir :: CodeGenM m => Name t -> Name t -> m [ServerDirectiveUsage] +getRenameDir :: (CodeGenM m) => Name t -> Name t -> m [ServerDirectiveUsage] getRenameDir originalTypeName hsTypeName = withDir [TypeDirectiveUsage (dirRename originalTypeName) | originalTypeName /= hsTypeName] getDirectives :: (CodeGenM m, Meta a) => a -> m [ServerDirectiveUsage] @@ -79,7 +79,7 @@ getDefaultValueDir _ = pure [] defValDirective :: Value CONST -> TypeValue defValDirective desc = TypeValueObject "DefaultValue" [("defaultValue", PrintableTypeValue $ PrintableValue desc)] -getNamespaceDirs :: CodeGenM m => Text -> m [ServerDirectiveUsage] +getNamespaceDirs :: (CodeGenM m) => Text -> m [ServerDirectiveUsage] getNamespaceDirs genTypeName = do namespaces <- asks hasNamespace withDir [TypeDirectiveUsage (dirDropNamespace genTypeName) | namespaces] @@ -96,7 +96,7 @@ dirRename :: Name t -> TypeValue dirRename name = TypeValueObject "Rename" [("newName", TypeValueString (unpackName name))] class Meta a where - getDirs :: CodeGenM m => a -> m [ServerDirectiveUsage] + getDirs :: (CodeGenM m) => a -> m [ServerDirectiveUsage] instance (Meta a) => Meta (Maybe a) where getDirs (Just x) = getDirs x @@ -134,7 +134,7 @@ instance Meta (FieldDefinition c CONST) where let renameField = [FieldDirectiveUsage name (dirRename fieldName) | isUpperCase fieldName] pure $ renameField <> map (FieldDirectiveUsage name) (dirs <> descDirective fieldDescription) -directiveTypeValue :: CodeGenM m => Directive CONST -> m TypeValue +directiveTypeValue :: (CodeGenM m) => Directive CONST -> m TypeValue directiveTypeValue Directive {..} = inType typeContext $ do dirs <- getDirective directiveName TypeValueObject typename <$> traverse (renderArgumentValue directiveArgs) (toList $ directiveDefinitionArgs dirs) @@ -170,7 +170,7 @@ renderArgumentValue args ArgumentDefinition {..} = do fName <- getFieldName dirName pure (fName, typeValue) -mapWrappedValue :: CodeGenM m => TypeRef -> AST.Value CONST -> m TypeValue +mapWrappedValue :: (CodeGenM m) => TypeRef -> AST.Value CONST -> m TypeValue mapWrappedValue (TypeRef name (AST.BaseType isRequired)) value | isRequired = mapValue name value | value == AST.Null = pure (TypedValueMaybe Nothing) @@ -180,24 +180,24 @@ mapWrappedValue (TypeRef name (AST.TypeList elems isRequired)) d = case d of (AST.List xs) -> TypedValueMaybe . Just . TypeValueList <$> traverse (mapWrappedValue (TypeRef name elems)) xs value -> expected "list" value -mapValue :: CodeGenM m => TypeName -> AST.Value CONST -> m TypeValue +mapValue :: (CodeGenM m) => TypeName -> AST.Value CONST -> m TypeValue mapValue name (AST.List xs) = TypeValueList <$> traverse (mapValue name) xs mapValue _ (AST.Enum name) = pure $ TypeValueObject name [] mapValue name (AST.Object fields) = TypeValueObject name <$> traverse (mapField name) (toList fields) mapValue _ (AST.Scalar x) = mapScalarValue x mapValue t v = expected (show t) v -mapScalarValue :: CodeGenM m => AST.ScalarValue -> m TypeValue +mapScalarValue :: (CodeGenM m) => AST.ScalarValue -> m TypeValue mapScalarValue (AST.Int x) = pure $ TypeValueNumber (fromIntegral x) mapScalarValue (AST.Float x) = pure $ TypeValueNumber x mapScalarValue (AST.String x) = pure $ TypeValueString x mapScalarValue (AST.Boolean x) = pure $ TypeValueBool x mapScalarValue (AST.Value _) = fail "JSON objects are not supported!" -expected :: MonadFail m => String -> AST.Value CONST -> m TypeValue +expected :: (MonadFail m) => String -> AST.Value CONST -> m TypeValue expected typ value = fail ("expected " <> typ <> ", found " <> show (render value) <> "!") -mapField :: CodeGenM m => TypeName -> ObjectEntry CONST -> m (FieldName, TypeValue) +mapField :: (CodeGenM m) => TypeName -> ObjectEntry CONST -> m (FieldName, TypeValue) mapField tName ObjectEntry {..} = do t <- lookupFieldType tName entryName value <- mapWrappedValue t entryValue diff --git a/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Interpreting/Transform.hs b/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Interpreting/Transform.hs index bc25bab013..77c1ad2e12 100755 --- a/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Interpreting/Transform.hs +++ b/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Interpreting/Transform.hs @@ -201,8 +201,8 @@ genTypeDefinition namespaceDirs <- getNamespaceDirs (unpackName hsTypeName) dirs <- getDirectives typeDef renameDir <- getRenameDir originalTypeName hsTypeName - pure $ - gqlTypeToInstance + pure + $ gqlTypeToInstance GQLTypeDefinition { gqlTarget = cgTypeName, gqlTypeDirectiveUses = renameDir <> namespaceDirs <> dirs <> defaultValueDirs, @@ -271,7 +271,8 @@ mkFieldArguments [ ArgumentDefinition FieldDefinition {fieldName, fieldType} ] = checkTypeExistence (typeConName fieldType) - >> langExtension "DataKinds" $> [TAGGED_ARG ''Arg fieldName fieldType] + >> langExtension "DataKinds" + $> [TAGGED_ARG ''Arg fieldName fieldType] mkFieldArguments fName genName _ = pure [ARG (genName fName)] toArgList :: Maybe (FieldContent bool cat s) -> [ArgumentDefinition s] @@ -369,8 +370,8 @@ genTypeContent typeName (DataUnion members) = do mkUnionFieldDefinition :: (CodeGenM m) => TypeName -> TypeName -> m CodeGenConstructor mkUnionFieldDefinition typeName memberName = do fieldType <- getFieldTypeName memberName - pure $ - CodeGenConstructor + pure + $ CodeGenConstructor { constructorName, constructorFields = [ CodeGenField diff --git a/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Interpreting/Utils.hs b/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Interpreting/Utils.hs index 03caf0d45f..756c997b73 100644 --- a/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Interpreting/Utils.hs +++ b/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Interpreting/Utils.hs @@ -91,16 +91,16 @@ getFieldTypeName name = checkTypeExistence name $> packName (toHaskellTypeName n getFieldName :: (CodeGenM m) => FieldName -> m FieldName getFieldName fieldName = do ServerCodeGenContext {hasNamespace, currentTypeName} <- ask - pure $ - if hasNamespace + pure + $ if hasNamespace then maybe fieldName (`camelCaseFieldName` fieldName) currentTypeName else fieldName getEnumName :: (MonadReader ServerCodeGenContext m) => TypeName -> m CodeGenTypeName getEnumName enumName = do ServerCodeGenContext {hasNamespace, currentTypeName} <- ask - pure $ - if hasNamespace + pure + $ if hasNamespace then CodeGenTypeName (map coerce $ maybeToList currentTypeName) [] enumName else fromTypeName enumName diff --git a/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Printing/TH.hs b/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Printing/TH.hs index 5a850a4b93..da8aff5163 100644 --- a/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Printing/TH.hs +++ b/morpheus-graphql-code-gen/src/Data/Morpheus/CodeGen/Server/Printing/TH.hs @@ -42,7 +42,9 @@ mkQuasiQuoter ctx = compileDocument :: CodeGenConfig -> ByteString -> Q [Dec] compileDocument config = parseServerTypeDefinitions config - >=> fmap concat . traverse printServerDec . fst + >=> fmap concat + . traverse printServerDec + . fst printServerDec :: ServerDeclaration -> Q [Dec] printServerDec (InterfaceType interface) = pure <$> printDec interface diff --git a/morpheus-graphql-core/src/Data/Mergeable/Internal/Merge.hs b/morpheus-graphql-core/src/Data/Mergeable/Internal/Merge.hs index bae47f9ba8..bbd307e4cc 100644 --- a/morpheus-graphql-core/src/Data/Mergeable/Internal/Merge.hs +++ b/morpheus-graphql-core/src/Data/Mergeable/Internal/Merge.hs @@ -51,7 +51,7 @@ mergeConcat (value :| (x : xs)) = do a <- merge value x mergeConcat (a :| xs) -throwErrors :: MonadError e m => NonEmpty e -> m b +throwErrors :: (MonadError e m) => NonEmpty e -> m b throwErrors (e :| es) = throwError e <* traverse throwError es -- Merge Object with of Failure as an Option diff --git a/morpheus-graphql-core/src/Data/Mergeable/Internal/NameCollision.hs b/morpheus-graphql-core/src/Data/Mergeable/Internal/NameCollision.hs index 75d85b272d..ec04e893d4 100644 --- a/morpheus-graphql-core/src/Data/Mergeable/Internal/NameCollision.hs +++ b/morpheus-graphql-core/src/Data/Mergeable/Internal/NameCollision.hs @@ -14,5 +14,5 @@ import Relude class NameCollision e a where nameCollision :: a -> e -instance NameCollision e a => NameCollision e (Indexed k a) where +instance (NameCollision e a) => NameCollision e (Indexed k a) where nameCollision = nameCollision . indexedValue diff --git a/morpheus-graphql-core/src/Data/Mergeable/Internal/Resolution.hs b/morpheus-graphql-core/src/Data/Mergeable/Internal/Resolution.hs index 891d74bdb0..151ac49e2a 100644 --- a/morpheus-graphql-core/src/Data/Mergeable/Internal/Resolution.hs +++ b/morpheus-graphql-core/src/Data/Mergeable/Internal/Resolution.hs @@ -28,7 +28,7 @@ fromListT :: (Monad m, Eq k, Hashable k) => [(k, a)] -> ResolutionT k a coll m c fromListT = traverse resolveDuplicatesM . fromListDuplicates >=> fromNoDuplicatesM resolveWith :: - Monad m => + (Monad m) => (a -> a -> m a) -> NonEmpty a -> m a @@ -50,9 +50,9 @@ data Indexed k a = Indexed fromListDuplicates :: (Eq k, Hashable k) => [(k, a)] -> [(k, NonEmpty a)] fromListDuplicates xs = - sortedEntries $ - HM.elems $ - clusterDuplicates (indexed xs) HM.empty + sortedEntries + $ HM.elems + $ clusterDuplicates (indexed xs) HM.empty indexed :: [(k, a)] -> [Indexed k a] indexed = __indexed 0 @@ -61,10 +61,10 @@ indexed = __indexed 0 __indexed _ [] = [] __indexed i ((k, x) : xs) = Indexed i k x : __indexed (i + 1) xs -resolveDuplicatesM :: Monad m => (k, NonEmpty a) -> ResolutionT k a coll m (k, a) +resolveDuplicatesM :: (Monad m) => (k, NonEmpty a) -> ResolutionT k a coll m (k, a) resolveDuplicatesM (k, xs) = asks resolveDuplicates >>= lift . fmap (k,) . (xs &) -fromNoDuplicatesM :: Monad m => [(k, a)] -> ResolutionT k a coll m coll +fromNoDuplicatesM :: (Monad m) => [(k, a)] -> ResolutionT k a coll m coll fromNoDuplicatesM xs = asks ((xs &) . fromNoDuplicates) insertWithList :: (Eq k, Hashable k) => Indexed k (NonEmpty a) -> HashMap k (Indexed k (NonEmpty a)) -> HashMap k (Indexed k (NonEmpty a)) diff --git a/morpheus-graphql-core/src/Data/Mergeable/IsMap.hs b/morpheus-graphql-core/src/Data/Mergeable/IsMap.hs index 387f0825b3..5db31571d1 100644 --- a/morpheus-graphql-core/src/Data/Mergeable/IsMap.hs +++ b/morpheus-graphql-core/src/Data/Mergeable/IsMap.hs @@ -64,7 +64,7 @@ instance IsMap Key A.KeyMap where selectBy :: (MonadError e m, IsMap k c, Monad m) => e -> k -> c a -> m a selectBy err = selectOr (throwError err) pure -selectOr :: IsMap k c => d -> (a -> d) -> k -> c a -> d +selectOr :: (IsMap k c) => d -> (a -> d) -> k -> c a -> d selectOr fb f key lib = maybe fb f (lookup key lib) class FromList m map k a where diff --git a/morpheus-graphql-core/src/Data/Mergeable/MergeMap.hs b/morpheus-graphql-core/src/Data/Mergeable/MergeMap.hs index 66592964c8..484b744f85 100644 --- a/morpheus-graphql-core/src/Data/Mergeable/MergeMap.hs +++ b/morpheus-graphql-core/src/Data/Mergeable/MergeMap.hs @@ -80,7 +80,7 @@ instance where merge (MergeMap x) (MergeMap y) = resolveMergeable (x <> y) -instance Monad m => Merge m (MergeMap 'True k a) where +instance (Monad m) => Merge m (MergeMap 'True k a) where merge (MergeMap x) (MergeMap y) = pure $ MergeMap $ x <> y resolveMergeable :: diff --git a/morpheus-graphql-core/src/Data/Morpheus/Ext/KeyOf.hs b/morpheus-graphql-core/src/Data/Morpheus/Ext/KeyOf.hs index 3a2db082a7..366980d693 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Ext/KeyOf.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Ext/KeyOf.hs @@ -28,5 +28,5 @@ instance (Eq name, Hashable name) => KeyOf name (Ref name) where instance (Eq k, Hashable k) => KeyOf k (Indexed k a) where keyOf = indexedKey -toPair :: KeyOf k a => a -> (k, a) +toPair :: (KeyOf k a) => a -> (k, a) toPair x = (keyOf x, x) diff --git a/morpheus-graphql-core/src/Data/Morpheus/Ext/Result.hs b/morpheus-graphql-core/src/Data/Morpheus/Ext/Result.hs index aa6696b23e..a41fbeedcb 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Ext/Result.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Ext/Result.hs @@ -67,7 +67,7 @@ instance MonadError er (Result er) where catchError (Failure (x :| _)) f = f x catchError x _ = x -instance IsString err => MonadFail (Result err) where +instance (IsString err) => MonadFail (Result err) where fail = Failure . pure . fromString resultOr :: (NonEmpty err -> a') -> (a -> a') -> Result err a -> a' @@ -84,16 +84,16 @@ newtype ResultT event (m :: Type -> Type) a = ResultT } deriving (Functor) -instance Applicative m => Applicative (ResultT event m) where +instance (Applicative m) => Applicative (ResultT event m) where pure = ResultT . pure . pure . ([],) ResultT app1 <*> ResultT app2 = ResultT $ liftA2 (<*>) (fx <$> app1) app2 where - fx :: Monad f => f ([event], a -> b) -> f (([event], a) -> ([event], b)) + fx :: (Monad f) => f ([event], a -> b) -> f (([event], a) -> ([event], b)) fx x = do (e', f) <- x pure $ \(e, a) -> (e <> e', f a) -instance Monad m => Monad (ResultT event m) where +instance (Monad m) => Monad (ResultT event m) where return = pure (ResultT m1) >>= mFunc = ResultT $ do result <- m1 @@ -108,24 +108,24 @@ instance Monad m => Monad (ResultT event m) where instance MonadTrans (ResultT event) where lift = ResultT . fmap (pure . ([],)) -instance Monad m => MonadError GQLError (ResultT event m) where +instance (Monad m) => MonadError GQLError (ResultT event m) where throwError = ResultT . pure . throwError catchError (ResultT mx) f = ResultT (mx >>= catchResultError) where catchResultError (Failure (x :| _)) = runResultT (f x) catchResultError x = pure x -instance Applicative m => PushEvents event (ResultT event m) where +instance (Applicative m) => PushEvents event (ResultT event m) where pushEvents x = ResultT $ pure $ pure (x, ()) cleanEvents :: - Functor m => + (Functor m) => ResultT e m a -> ResultT e' m a cleanEvents resT = ResultT $ fmap (first (const [])) <$> runResultT resT mapEvent :: - Monad m => + (Monad m) => (e -> e') -> ResultT e m value -> ResultT e' m value diff --git a/morpheus-graphql-core/src/Data/Morpheus/Internal/Utils.hs b/morpheus-graphql-core/src/Data/Morpheus/Internal/Utils.hs index 9ed0ec56ba..7b8891b323 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Internal/Utils.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Internal/Utils.hs @@ -64,7 +64,7 @@ import Relude hiding (<:>) :: (Merge (HistoryT m) a, Monad m) => a -> a -> m a x <:> y = startHistory (merge x y) -addPath :: MonadReader [a1] m => a1 -> m a2 -> m a2 +addPath :: (MonadReader [a1] m) => a1 -> m a2 -> m a2 addPath p = local (\xs -> xs <> [p]) type HistoryT = ReaderT [Ref FieldName] diff --git a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Document/TypeSystem.hs b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Document/TypeSystem.hs index 2b6fbbf31c..72ae73c181 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Document/TypeSystem.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Document/TypeSystem.hs @@ -110,11 +110,11 @@ scalarTypeDefinition :: Maybe Description -> Parser (TypeDefinition ANY s) scalarTypeDefinition typeDescription = - label "ScalarTypeDefinition" $ - TypeDefinition typeDescription - <$> typeDeclaration "scalar" - <*> optionalDirectives - <*> pure (DataScalar (ScalarDefinition pure)) + label "ScalarTypeDefinition" + $ TypeDefinition typeDescription + <$> typeDeclaration "scalar" + <*> optionalDirectives + <*> pure (DataScalar (ScalarDefinition pure)) {-# INLINEABLE scalarTypeDefinition #-} -- Objects : https://graphql.github.io/graphql-spec/June2018/#sec-Objects @@ -137,12 +137,12 @@ objectTypeDefinition :: Maybe Description -> Parser (TypeDefinition ANY s) objectTypeDefinition typeDescription = - label "ObjectTypeDefinition" $ - mkObject typeDescription - <$> typeDeclaration "type" - <*> optionalImplementsInterfaces - <*> optionalDirectives - <*> fieldsDefinition + label "ObjectTypeDefinition" + $ mkObject typeDescription + <$> typeDeclaration "type" + <*> optionalImplementsInterfaces + <*> optionalDirectives + <*> fieldsDefinition {-# INLINEABLE objectTypeDefinition #-} optionalImplementsInterfaces :: Parser [TypeName] @@ -162,11 +162,11 @@ interfaceTypeDefinition :: Maybe Description -> Parser (TypeDefinition ANY s) interfaceTypeDefinition typeDescription = - label "InterfaceTypeDefinition" $ - TypeDefinition typeDescription - <$> typeDeclaration "interface" - <*> optionalDirectives - <*> (DataInterface <$> fieldsDefinition) + label "InterfaceTypeDefinition" + $ TypeDefinition typeDescription + <$> typeDeclaration "interface" + <*> optionalDirectives + <*> (DataInterface <$> fieldsDefinition) {-# INLINEABLE interfaceTypeDefinition #-} -- Unions : https://graphql.github.io/graphql-spec/June2018/#sec-Unions @@ -183,16 +183,17 @@ unionTypeDefinition :: Maybe Description -> Parser (TypeDefinition ANY s) unionTypeDefinition typeDescription = - label "UnionTypeDefinition" $ - TypeDefinition typeDescription - <$> typeDeclaration "union" - <*> optionalDirectives - <*> (DataUnion <$> unionMemberTypes) + label "UnionTypeDefinition" + $ TypeDefinition typeDescription + <$> typeDeclaration "union" + <*> optionalDirectives + <*> (DataUnion <$> unionMemberTypes) where unionMemberTypes = - lift . fromElems + lift + . fromElems =<< equal - *> pipe (mkUnionMember <$> parseTypeName) + *> pipe (mkUnionMember <$> parseTypeName) {-# INLINEABLE unionTypeDefinition #-} -- Enums : https://graphql.github.io/graphql-spec/June2018/#sec-Enums @@ -211,11 +212,11 @@ enumTypeDefinition :: Maybe Description -> Parser (TypeDefinition ANY s) enumTypeDefinition typeDescription = - label "EnumTypeDefinition" $ - TypeDefinition typeDescription - <$> typeDeclaration "enum" - <*> optionalDirectives - <*> (DataEnum <$> collection enumValueDefinition) + label "EnumTypeDefinition" + $ TypeDefinition typeDescription + <$> typeDeclaration "enum" + <*> optionalDirectives + <*> (DataEnum <$> collection enumValueDefinition) {-# INLINEABLE enumTypeDefinition #-} -- Input Objects : https://graphql.github.io/graphql-spec/June2018/#sec-Input-Objects @@ -231,12 +232,12 @@ inputObjectTypeDefinition :: Maybe Description -> Parser (TypeDefinition ANY s) inputObjectTypeDefinition typeDescription = - label "InputObjectTypeDefinition" $ - TypeDefinition + label "InputObjectTypeDefinition" + $ TypeDefinition typeDescription - <$> typeDeclaration "input" - <*> optionalDirectives - <*> (DataInputObject <$> inputFieldsDefinition) + <$> typeDeclaration "input" + <*> optionalDirectives + <*> (DataInputObject <$> inputFieldsDefinition) {-# INLINEABLE inputObjectTypeDefinition #-} -- 3.13 DirectiveDefinition @@ -252,15 +253,15 @@ parseDirectiveDefinition :: Maybe Description -> Parser (DirectiveDefinition s) parseDirectiveDefinition directiveDefinitionDescription = - label "DirectiveDefinition" $ - DirectiveDefinition - <$> ( keyword "directive" - *> at - *> parseName - ) - <*> pure directiveDefinitionDescription - <*> optionalCollection argumentsDefinition - <*> (optional (keyword "repeatable") *> keyword "on" *> pipe parseDirectiveLocation) + label "DirectiveDefinition" + $ DirectiveDefinition + <$> ( keyword "directive" + *> at + *> parseName + ) + <*> pure directiveDefinitionDescription + <*> optionalCollection argumentsDefinition + <*> (optional (keyword "repeatable") *> keyword "on" *> pipe parseDirectiveLocation) {-# INLINEABLE parseDirectiveDefinition #-} -- 3.2 Schema @@ -278,12 +279,12 @@ parseDirectiveDefinition directiveDefinitionDescription = -- } parseSchemaDefinition :: Maybe Description -> Parser SchemaDefinition parseSchemaDefinition _schemaDescription = - label "SchemaDefinition" $ - keyword "schema" - *> ( SchemaDefinition - <$> optionalDirectives - <*> setOf parseRootOperationTypeDefinition - ) + label "SchemaDefinition" + $ keyword "schema" + *> ( SchemaDefinition + <$> optionalDirectives + <*> setOf parseRootOperationTypeDefinition + ) {-# INLINEABLE parseSchemaDefinition #-} parseRootOperationTypeDefinition :: Parser RootOperationTypeDefinition @@ -296,13 +297,15 @@ parseRootOperationTypeDefinition = parseTypeSystemUnit :: Parser RawTypeDefinition parseTypeSystemUnit = - label "TypeDefinition" $ - do + label "TypeDefinition" + $ do description <- optDescription -- scalar | enum | input | object | union | interface parseTypeDef description - <|> RawSchemaDefinition <$> parseSchemaDefinition description - <|> RawDirectiveDefinition <$> parseDirectiveDefinition description + <|> RawSchemaDefinition + <$> parseSchemaDefinition description + <|> RawDirectiveDefinition + <$> parseDirectiveDefinition description where parseTypeDef description = RawTypeDefinition @@ -351,9 +354,9 @@ withSchemaDefinition (x : xs, _, _) = throwErrors (nameCollision <$> (x :| xs)) parseRawTypeDefinitions :: Parser [RawTypeDefinition] parseRawTypeDefinitions = - label "TypeSystemDefinitions" $ - ignoredTokens - *> manyTill parseTypeSystemUnit eof + label "TypeSystemDefinitions" + $ ignoredTokens + *> manyTill parseTypeSystemUnit eof typeSystemDefinition :: ByteString -> @@ -364,7 +367,8 @@ typeSystemDefinition :: ) typeSystemDefinition = processParser parseRawTypeDefinitions - >=> withSchemaDefinition . typePartition + >=> withSchemaDefinition + . typePartition parseDefinitions :: ByteString -> GQLResult [RawTypeDefinition] parseDefinitions = processParser parseRawTypeDefinitions diff --git a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/Arguments.hs b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/Arguments.hs index 6bac6eeb30..d0d4aa7e72 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/Arguments.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/Arguments.hs @@ -31,17 +31,17 @@ import Text.Megaparsec (label) -- -- Argument[Const] -- Name : Value[Const] -valueArgument :: Parse (Value s) => Parser (Argument s) +valueArgument :: (Parse (Value s)) => Parser (Argument s) valueArgument = - label "Argument" $ - Argument - <$> getLocation - <*> (parseName <* colon) - <*> parse + label "Argument" + $ Argument + <$> getLocation + <*> (parseName <* colon) + <*> parse {-# INLINEABLE valueArgument #-} -maybeArguments :: Parse (Value s) => Parser (Arguments s) +maybeArguments :: (Parse (Value s)) => Parser (Arguments s) maybeArguments = - label "Arguments" $ - uniqTupleOpt valueArgument + label "Arguments" + $ uniqTupleOpt valueArgument {-# INLINEABLE maybeArguments #-} diff --git a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/Pattern.hs b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/Pattern.hs index 94cf15b0d4..4f51a8ff83 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/Pattern.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/Pattern.hs @@ -76,14 +76,14 @@ import Text.Megaparsec.Byte (string) -- Description(opt) EnumValue Directives(Const)(opt) -- enumValueDefinition :: - Parse (Value s) => + (Parse (Value s)) => Parser (DataEnumValue s) enumValueDefinition = - label "EnumValueDefinition" $ - DataEnumValue - <$> optDescription - <*> parseTypeName - <*> optionalDirectives + label "EnumValueDefinition" + $ DataEnumValue + <$> optDescription + <*> parseTypeName + <*> optionalDirectives {-# INLINEABLE enumValueDefinition #-} -- InputValue : https://graphql.github.io/graphql-spec/June2018/#InputValueDefinition @@ -92,16 +92,16 @@ enumValueDefinition = -- Description(opt) Name : Type DefaultValue(opt) Directives (Const)(opt) -- inputValueDefinition :: - Parse (Value s) => + (Parse (Value s)) => Parser (FieldDefinition IN s) inputValueDefinition = - label "InputValueDefinition" $ - FieldDefinition - <$> optDescription - <*> parseName - <*> (colon *> parseType) - <*> optional (DefaultInputValue <$> parseDefaultValue) - <*> optionalDirectives + label "InputValueDefinition" + $ FieldDefinition + <$> optDescription + <*> parseName + <*> (colon *> parseType) + <*> optional (DefaultInputValue <$> parseDefaultValue) + <*> optionalDirectives {-# INLINEABLE inputValueDefinition #-} -- Field Arguments: https://graphql.github.io/graphql-spec/June2018/#sec-Field-Arguments @@ -110,11 +110,11 @@ inputValueDefinition = -- ( InputValueDefinition(list) ) -- argumentsDefinition :: - Parse (Value s) => + (Parse (Value s)) => Parser (ArgumentsDefinition s) argumentsDefinition = - label "ArgumentsDefinition" $ - uniqTuple (fmap ArgumentDefinition inputValueDefinition) + label "ArgumentsDefinition" + $ uniqTuple (fmap ArgumentDefinition inputValueDefinition) {-# INLINEABLE argumentsDefinition #-} -- FieldsDefinition : https://graphql.github.io/graphql-spec/June2018/#FieldsDefinition @@ -123,7 +123,7 @@ argumentsDefinition = -- { FieldDefinition(list) } -- fieldsDefinition :: - Parse (Value s) => + (Parse (Value s)) => Parser (FieldsDefinition OUT s) fieldsDefinition = label "FieldsDefinition" $ setOf fieldDefinition {-# INLINEABLE fieldsDefinition #-} @@ -131,15 +131,15 @@ fieldsDefinition = label "FieldsDefinition" $ setOf fieldDefinition -- FieldDefinition -- Description(opt) Name ArgumentsDefinition(opt) : Type Directives(Const)(opt) -- -fieldDefinition :: Parse (Value s) => Parser (FieldDefinition OUT s) +fieldDefinition :: (Parse (Value s)) => Parser (FieldDefinition OUT s) fieldDefinition = - label "FieldDefinition" $ - mkField - <$> optDescription - <*> parseName - <*> optional (FieldArgs <$> argumentsDefinition) - <*> (colon *> parseType) - <*> optionalDirectives + label "FieldDefinition" + $ mkField + <$> optDescription + <*> parseName + <*> optional (FieldArgs <$> argumentsDefinition) + <*> (colon *> parseType) + <*> optionalDirectives {-# INLINEABLE fieldDefinition #-} mkField :: @@ -158,7 +158,7 @@ mkField fieldDescription fieldName fieldContent fieldType fieldDirectives = -- { InputValueDefinition(list) } -- inputFieldsDefinition :: - Parse (Value s) => + (Parse (Value s)) => Parser (InputFieldsDefinition s) inputFieldsDefinition = label "InputFieldsDefinition" $ setOf inputValueDefinition {-# INLINEABLE inputFieldsDefinition #-} @@ -170,20 +170,20 @@ inputFieldsDefinition = label "InputFieldsDefinition" $ setOf inputValueDefiniti -- Directives[Const] -- Directive[Const](list) -- -optionalDirectives :: Parse (Value s) => Parser (Directives s) +optionalDirectives :: (Parse (Value s)) => Parser (Directives s) optionalDirectives = label "Directives" $ many directive >>= lift . fromElems {-# INLINEABLE optionalDirectives #-} -- Directive[Const] -- -- @ Name Arguments[Const](opt) -directive :: Parse (Value s) => Parser (Directive s) +directive :: (Parse (Value s)) => Parser (Directive s) directive = - label "Directive" $ - Directive - <$> getLocation - <*> (at *> parseName) - <*> maybeArguments + label "Directive" + $ Directive + <$> getLocation + <*> (at *> parseName) + <*> maybeArguments {-# INLINEABLE directive #-} -- typDeclaration : Not in spec ,start part of type definitions @@ -197,43 +197,43 @@ typeDeclaration kind = keyword kind *> parseTypeName parseOperationType :: Parser OperationType parseOperationType = - label "OperationType" $ - ( (string "query" $> OPERATION_QUERY) - <|> (string "mutation" $> OPERATION_MUTATION) - <|> (string "subscription" $> OPERATION_SUBSCRIPTION) - ) - <* ignoredTokens + label "OperationType" + $ ( (string "query" $> OPERATION_QUERY) + <|> (string "mutation" $> OPERATION_MUTATION) + <|> (string "subscription" $> OPERATION_SUBSCRIPTION) + ) + <* ignoredTokens {-# INLINEABLE parseOperationType #-} parseDirectiveLocation :: Parser DirectiveLocation parseDirectiveLocation = label "DirectiveLocation" - ( choice $ - toKeyword - <$> [ LOCATION_FIELD_DEFINITION, - LOCATION_FRAGMENT_DEFINITION, - LOCATION_FRAGMENT_SPREAD, - LOCATION_INLINE_FRAGMENT, - LOCATION_ARGUMENT_DEFINITION, - LOCATION_INTERFACE, - LOCATION_ENUM_VALUE, - LOCATION_INPUT_OBJECT, - LOCATION_INPUT_FIELD_DEFINITION, - LOCATION_SCHEMA, - LOCATION_SCALAR, - LOCATION_OBJECT, - LOCATION_QUERY, - LOCATION_MUTATION, - LOCATION_SUBSCRIPTION, - LOCATION_UNION, - LOCATION_ENUM, - LOCATION_FIELD - ] + ( choice + $ toKeyword + <$> [ LOCATION_FIELD_DEFINITION, + LOCATION_FRAGMENT_DEFINITION, + LOCATION_FRAGMENT_SPREAD, + LOCATION_INLINE_FRAGMENT, + LOCATION_ARGUMENT_DEFINITION, + LOCATION_INTERFACE, + LOCATION_ENUM_VALUE, + LOCATION_INPUT_OBJECT, + LOCATION_INPUT_FIELD_DEFINITION, + LOCATION_SCHEMA, + LOCATION_SCALAR, + LOCATION_OBJECT, + LOCATION_QUERY, + LOCATION_MUTATION, + LOCATION_SUBSCRIPTION, + LOCATION_UNION, + LOCATION_ENUM, + LOCATION_FIELD + ] ) <* ignoredTokens {-# INLINEABLE parseDirectiveLocation #-} -toKeyword :: Show a => a -> Parser a +toKeyword :: (Show a) => a -> Parser a toKeyword x = string (fromString $ show x) $> x {-# INLINEABLE toKeyword #-} diff --git a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/SourceText.hs b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/SourceText.hs index d1115bd1e8..2d8ffb187b 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/SourceText.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/SourceText.hs @@ -68,10 +68,10 @@ isSourceCharacter x = SPACE <= x && x <= NON_CHARACTER inlineString :: Parser ByteString inlineString = - label "String" $ - char DOUBLE_QUOTE - *> parseContent - <* ignoredTokens + label "String" + $ char DOUBLE_QUOTE + *> parseContent + <* ignoredTokens {-# INLINE inlineString #-} parseContent :: Parser ByteString @@ -126,9 +126,12 @@ ignored = (takeWhile1P Nothing isIgnored <|> comment) $> () where isIgnored x = (x >= TABULATION && x <= CARRIAGE_RETURN) - || x == SPACE - || x == COMMA - || x == UNICODE_BOM + || x + == SPACE + || x + == COMMA + || x + == UNICODE_BOM {-# INLINE isIgnored #-} comment = char HASH_TAG *> takeWhileP Nothing (\x -> isSourceCharacter x && x /= NEW_LINE) {-# INLINE comment #-} diff --git a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/Terms.hs b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/Terms.hs index 4ba4496f0d..25d6ef29c2 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/Terms.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/Terms.hs @@ -148,16 +148,17 @@ brackets = between (symbol 91) (symbol 93) -- Name name :: Parser AST.Token name = - label "Name" $ - fromLBS - <$> do - (<>) <$> takeWhile1P Nothing isStartChar <*> takeWhileP Nothing isContinueChar - <* ignoredTokens + label "Name" + $ fromLBS + <$> do + (<>) <$> takeWhile1P Nothing isStartChar <*> takeWhileP Nothing isContinueChar + <* ignoredTokens where isStartChar x = (x >= CHAR_a && x <= CHAR_z) || (x >= CHAR_A && x <= CHAR_Z) - || x == UNDERSCORE + || x + == UNDERSCORE {-# INLINE isStartChar #-} isContinueChar x = isStartChar x @@ -187,10 +188,10 @@ varName = symbol DOLLAR *> parseName <* ignoredTokens -- variable :: Parser (Ref FieldName) variable = - label "variable" $ - flip Ref - <$> getLocation - <*> varName + label "variable" + $ flip Ref + <$> getLocation + <*> varName {-# INLINE variable #-} -- Descriptions: https://graphql.github.io/graphql-spec/June2018/#Description @@ -229,10 +230,11 @@ parseNonNull = (symbol BANG $> True) <|> pure False uniqTuple :: (FromList GQLResult map k a, KeyOf k a) => Parser a -> Parser (map k a) uniqTuple parser = - label "Tuple" $ - parens + label "Tuple" + $ parens (parser `sepBy` ignoredTokens "empty Tuple value!") - >>= lift . fromElems + >>= lift + . fromElems {-# INLINE uniqTuple #-} uniqTupleOpt :: diff --git a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/Value.hs b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/Value.hs index 53d36780fe..9a58b29058 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/Value.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Internal/Value.hs @@ -55,9 +55,12 @@ valueNull = string "null" $> Null booleanValue :: Parser (Value a) booleanValue = - Scalar . Boolean - <$> ( string "true" $> True - <|> string "false" $> False + Scalar + . Boolean + <$> ( string "true" + $> True + <|> string "false" + $> False ) {-# INLINE booleanValue #-} @@ -114,9 +117,9 @@ instance Parse (Value CONST) where compoundValue :: Parser (Value a) -> Parser (Value a) compoundValue parser = - label "Value" $ - ( parsePrimitives - <|> (Object <$> objectValue parser) - <|> (List <$> listValue parser) - ) - <* ignoredTokens + label "Value" + $ ( parsePrimitives + <|> (Object <$> objectValue parser) + <|> (List <$> listValue parser) + ) + <* ignoredTokens diff --git a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Request/Operation.hs b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Request/Operation.hs index 42c599b97a..ac173a4c3e 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Request/Operation.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Request/Operation.hs @@ -51,12 +51,12 @@ import Text.Megaparsec -- variableDefinition :: Parser (Variable RAW) variableDefinition = - label "VariableDefinition" $ - Variable - <$> getLocation - <*> (varName <* colon) - <*> parseType - <*> (DefaultValue <$> optional parseDefaultValue) + label "VariableDefinition" + $ Variable + <$> getLocation + <*> (varName <* colon) + <*> parseType + <*> (DefaultValue <$> optional parseDefaultValue) -- Operations : https://graphql.github.io/graphql-spec/June2018/#sec-Language.Operations -- @@ -67,14 +67,14 @@ variableDefinition = -- query, mutation, subscription parseOperationDefinition :: Parser (Operation RAW) parseOperationDefinition = - label "OperationDefinition" $ - Operation - <$> getLocation - <*> parseOperationType - <*> optional parseName - <*> uniqTupleOpt variableDefinition - <*> optionalDirectives - <*> parseSelectionSet + label "OperationDefinition" + $ Operation + <$> getLocation + <*> parseOperationType + <*> optional parseName + <*> uniqTupleOpt variableDefinition + <*> optionalDirectives + <*> parseSelectionSet parseAnonymousQuery :: Parser (Operation RAW) parseAnonymousQuery = label "AnonymousQuery" $ do diff --git a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Request/Parser.hs b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Request/Parser.hs index 53c546e429..d434a112c2 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Request/Parser.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Request/Parser.hs @@ -55,13 +55,13 @@ import Text.Megaparsec parseExecutableDocument :: Variables -> Parser ExecutableDocument parseExecutableDocument variables = - label "ExecutableDocument" $ - ( ExecutableDocument variables - <$> (ignoredTokens *> parseOperation) - <*> (many parseFragmentDefinition >>= lift . fromElems) - ) - <* ignoredTokens - <* eof + label "ExecutableDocument" + $ ( ExecutableDocument variables + <$> (ignoredTokens *> parseOperation) + <*> (many parseFragmentDefinition >>= lift . fromElems) + ) + <* ignoredTokens + <* eof parseRequest :: GQLRequest -> GQLResult ExecutableDocument parseRequest GQLRequest {query, variables} = diff --git a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Request/Selection.hs b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Request/Selection.hs index c513ec8ab8..41229d72a0 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Parsing/Request/Selection.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Parsing/Request/Selection.hs @@ -60,10 +60,10 @@ parseSelectionSet :: Parser (SelectionSet RAW) parseSelectionSet = label "SelectionSet" $ setOf parseSelection where parseSelection = - label "Selection" $ - try inlineFragment - <|> spread - <|> parseSelectionField + label "Selection" + $ try inlineFragment + <|> spread + <|> parseSelectionField -- Fields: https://graphql.github.io/graphql-spec/June2018/#sec-Language.Fields -- @@ -72,21 +72,22 @@ parseSelectionSet = label "SelectionSet" $ setOf parseSelection -- parseSelectionField :: Parser (Selection RAW) parseSelectionField = - label "SelectionField" $ - Selection - <$> getLocation - <*> parseAlias - <*> parseName - <*> maybeArguments - <*> optionalDirectives - <*> parseSelectionContent - <*> pure empty + label "SelectionField" + $ Selection + <$> getLocation + <*> parseAlias + <*> parseName + <*> maybeArguments + <*> optionalDirectives + <*> parseSelectionContent + <*> pure empty parseSelectionContent :: Parser (SelectionContent RAW) parseSelectionContent = - label "SelectionContent" $ - SelectionSet <$> parseSelectionSet - <|> pure SelectionField + label "SelectionContent" + $ SelectionSet + <$> parseSelectionSet + <|> pure SelectionField -- -- Fragments: https://graphql.github.io/graphql-spec/June2018/#sec-Language.Fragments diff --git a/morpheus-graphql-core/src/Data/Morpheus/QuasiQuoter.hs b/morpheus-graphql-core/src/Data/Morpheus/QuasiQuoter.hs index ac6646b982..0c0553671c 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/QuasiQuoter.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/QuasiQuoter.hs @@ -40,9 +40,9 @@ import Relude hiding (ByteString) notSupported :: Text -> a notSupported things = - error $ - things - <> " are not supported by the GraphQL QuasiQuoter" + error + $ things + <> " are not supported by the GraphQL QuasiQuoter" gql :: QuasiQuoter gql = diff --git a/morpheus-graphql-core/src/Data/Morpheus/Rendering/RenderGQL.hs b/morpheus-graphql-core/src/Data/Morpheus/Rendering/RenderGQL.hs index 745e39daca..8e7f8cecce 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Rendering/RenderGQL.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Rendering/RenderGQL.hs @@ -34,7 +34,7 @@ import Relude hiding unwords, ) -render :: RenderGQL a => a -> ByteString +render :: (RenderGQL a) => a -> ByteString render x = runRendering (renderGQL x) 0 newtype Rendering = Rendering @@ -47,13 +47,13 @@ instance Semigroup Rendering where instance IsString Rendering where fromString = Rendering . const . LB.pack -fromShow :: Show a => a -> Rendering +fromShow :: (Show a) => a -> Rendering fromShow = fromString . show fromText :: Text -> Rendering fromText = fromString . T.unpack -nonNillSpace :: Foldable t => t a -> Rendering +nonNillSpace :: (Foldable t) => t a -> Rendering nonNillSpace t | null t = "" | otherwise = space @@ -62,7 +62,7 @@ class RenderGQL a where renderGQL :: a -> Rendering instance - RenderGQL a => + (RenderGQL a) => RenderGQL (Maybe a) where renderGQL = maybe "" renderGQL @@ -142,6 +142,6 @@ renderInputSeq :: Rendering renderInputSeq = fromMaybe "" . foldr' renderValue Nothing where - renderValue :: RenderGQL a => a -> Maybe Rendering -> Maybe Rendering + renderValue :: (RenderGQL a) => a -> Maybe Rendering -> Maybe Rendering renderValue value Nothing = Just (renderGQL value) renderValue value (Just txt) = Just (renderGQL value <> ", " <> txt) diff --git a/morpheus-graphql-core/src/Data/Morpheus/Types/GQLScalar.hs b/morpheus-graphql-core/src/Data/Morpheus/Types/GQLScalar.hs index 2a8a55c705..32a0f559e5 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Types/GQLScalar.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Types/GQLScalar.hs @@ -31,7 +31,7 @@ toScalar :: ValidValue -> Either Text ScalarValue toScalar (Scalar x) = pure x toScalar _ = Left "" -scalarValidator :: forall f a. DecodeScalar a => f a -> ScalarDefinition +scalarValidator :: forall f a. (DecodeScalar a) => f a -> ScalarDefinition scalarValidator _ = ScalarDefinition {validateValue = validator} where validator value = do @@ -95,10 +95,10 @@ instance DecodeScalar Double where instance EncodeScalar Double where encodeScalar = Float -scalarToJSON :: EncodeScalar a => a -> A.Value +scalarToJSON :: (EncodeScalar a) => a -> A.Value scalarToJSON = A.toJSON . encodeScalar -scalarFromJSON :: (Monad m, MonadFail m) => DecodeScalar a => A.Value -> m a +scalarFromJSON :: (Monad m, MonadFail m) => (DecodeScalar a) => A.Value -> m a scalarFromJSON x = case replaceValue x of Scalar value -> either (fail . unpack) pure (decodeScalar value) _ -> fail "input must be scalar value" diff --git a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/Base.hs b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/Base.hs index c6db583fc7..23a2756af3 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/Base.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/Base.hs @@ -75,5 +75,5 @@ data Ref name = Ref } deriving (Show, Lift, Eq) -instance Ord name => Ord (Ref name) where +instance (Ord name) => Ord (Ref name) where compare (Ref x _) (Ref y _) = compare x y diff --git a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/Error.hs b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/Error.hs index 3df5eecc68..f8d9617856 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/Error.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/Error.hs @@ -74,7 +74,7 @@ at :: GQLError -> Position -> GQLError at err pos = atPositions err [pos] {-# INLINE at #-} -atPositions :: Foldable t => GQLError -> t Position -> GQLError +atPositions :: (Foldable t) => GQLError -> t Position -> GQLError atPositions GQLError {..} pos = case toList pos of [] -> GQLError {..} posList -> GQLError {locations = locations <> Just posList, ..} @@ -144,7 +144,7 @@ instance FromJSON PropName where Right index -> pure (PropIndex index) parseJSON _ = fail "Property Name must be a either Name or Index" -invalidIndex :: MonadFail m => Double -> m a +invalidIndex :: (MonadFail m) => Double -> m a invalidIndex i = fail $ "Property Name must be a either Name or Index. it can't be " <> show i <> "." instance ToJSON PropName where diff --git a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/Selection.hs b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/Selection.hs index e451411067..4a44d51d61 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/Selection.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/Selection.hs @@ -310,8 +310,8 @@ mergeSelection selectionArguments <- mergeArguments selectionContent <- merge (selectionContent old) (selectionContent current) dirs <- selectionDirectives old <:> selectionDirectives current - pure $ - Selection + pure + $ Selection { selectionAlias = mergeAlias, selectionPosition = pos1, selectionDirectives = dirs, @@ -326,12 +326,12 @@ mergeSelection mergeArguments | selectionArguments old == selectionArguments current = pure $ selectionArguments current | otherwise = - mergeConflict $ - ("they have differing arguments. " <> useDifferentAliases) - `atPositions` [pos1, pos2] + mergeConflict + $ ("they have differing arguments. " <> useDifferentAliases) + `atPositions` [pos1, pos2] mergeSelection x y = mergeConflict ("INTERNAL: can't merge. " <> msgValue x <> msgValue y <> useDifferentAliases) -msgValue :: Show a => a -> GQLError +msgValue :: (Show a) => a -> GQLError msgValue = msg . show -- fails if alias matches but name not: @@ -347,14 +347,14 @@ mergeName :: mergeName pos old current | selectionName old == selectionName current = pure $ selectionName current | otherwise = - mergeConflict $ - ( msg (selectionName old) - <> " and " - <> msg (selectionName current) - <> " are different fields. " - <> useDifferentAliases - ) - `atPositions` pos + mergeConflict + $ ( msg (selectionName old) + <> " and " + <> msg (selectionName current) + <> " are different fields. " + <> useDifferentAliases + ) + `atPositions` pos deriving instance Show (Selection a) @@ -391,7 +391,7 @@ instance RenderGQL (Operation VALID) where getOperationName :: Maybe FieldName -> TypeName getOperationName = maybe "AnonymousOperation" coerce -getOperationDataType :: MonadError GQLError m => Operation s -> Schema VALID -> m (TypeDefinition OBJECT VALID) +getOperationDataType :: (MonadError GQLError m) => Operation s -> Schema VALID -> m (TypeDefinition OBJECT VALID) getOperationDataType Operation {operationType = OPERATION_QUERY} lib = pure (query lib) getOperationDataType Operation {operationType = OPERATION_MUTATION, operationPosition} lib = maybe (throwError $ mutationIsNotDefined operationPosition) pure (mutation lib) diff --git a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/TypeSystem.hs b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/TypeSystem.hs index 7bc085d487..8a0aa809eb 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/TypeSystem.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/TypeSystem.hs @@ -231,7 +231,7 @@ instance <*> mergeOptional (mutation s1) (mutation s2) <*> mergeOptional (subscription s1) (subscription s2) <*> directiveDefinitions s1 - <:> directiveDefinitions s2 + <:> directiveDefinitions s2 mergeOptional :: (Monad m, MonadError GQLError m) => @@ -347,8 +347,8 @@ withDirectives :: m (Schema s) withDirectives dirs Schema {..} = do dirs' <- directiveDefinitions <:> dirs - pure $ - Schema + pure + $ Schema { directiveDefinitions = dirs', .. } @@ -368,7 +368,7 @@ buildSchema (Just schemaDef, types, dirs) = where selectOp op = selectOperation schemaDef op types -traverse3 :: Applicative t => (a -> t b) -> (a, a, a) -> t (b, b, b) +traverse3 :: (Applicative t) => (a -> t b) -> (a, a, a) -> t (b, b, b) traverse3 f (a1, a2, a3) = (,,) <$> f a1 <*> f a2 <*> f a3 typeReference :: @@ -449,7 +449,7 @@ instance NameCollision GQLError (TypeDefinition cat s) where "There can Be only One TypeDefinition Named " <> msg (typeName x) <> "." instance - ToCategory (TypeContent TRUE) cat cat' => + (ToCategory (TypeContent TRUE) cat cat') => ToCategory TypeDefinition cat cat' where toCategory TypeDefinition {typeContent, ..} = @@ -474,8 +474,8 @@ possibleInterfaceTypes :: Schema s -> [TypeDefinition ANY s] possibleInterfaceTypes name schema = - sortWith typeName $ - mapMaybe + sortWith typeName + $ mapMaybe (isPossibleInterfaceType name) (toList $ typeDefinitions schema) @@ -657,7 +657,7 @@ defineDirective schema directive = updateTypes <$> insert directive (directiveDe where updateTypes directiveDefinitions = schema {directiveDefinitions} -lookupWith :: Eq k => (a -> k) -> k -> [a] -> Maybe a +lookupWith :: (Eq k) => (a -> k) -> k -> [a] -> Maybe a lookupWith f key = find ((== key) . f) popByKey :: @@ -669,10 +669,10 @@ popByKey types (RootOperationTypeDefinition opType name) = case lookupWith typeN Just dt@TypeDefinition {typeContent = DataObject {}} -> pure (fromAny dt) Just {} -> - throwError $ - msg (render opType) - <> " root type must be Object type if provided, it cannot be " - <> msg name + throwError + $ msg (render opType) + <> " root type must be Object type if provided, it cannot be " + <> msg name _ -> pure Nothing -- diff --git a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/Value.hs b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/Value.hs index a2c054bf98..9c7cb4894e 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/Value.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/AST/Value.hs @@ -266,8 +266,8 @@ replaceValue (A.Bool v) = mkBoolean v replaceValue (A.Number v) = Scalar $ decodeScientific v replaceValue (A.String v) = mkString v replaceValue (A.Object v) = - mkObject $ - fmap + mkObject + $ fmap (bimap packName replaceValue) (toAssoc v) replaceValue (A.Array li) = List (fmap replaceValue (V.toList li)) diff --git a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/Validation.hs b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/Validation.hs index 5e32b9c413..507e765e1d 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/Validation.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/Validation.hs @@ -99,7 +99,7 @@ import Relude hiding (Constraint) getUnused :: (KeyOf k b, IsMap k c, Foldable t) => c a -> t b -> [b] getUnused uses = filter (not . (`member` uses) . keyOf) . toList -failOnUnused :: Unused a => [a] -> Validator s (OperationContext s1 s2) () +failOnUnused :: (Unused a) => [a] -> Validator s (OperationContext s1 s2) () failOnUnused [] = pure () failOnUnused (x : xs) = do ctx <- Validator ask @@ -117,7 +117,7 @@ checkUnused :: checkUnused uses = failOnUnused . getUnused uses constraint :: - KindViolation k inp => + (KindViolation k inp) => Constraint (k :: TypeCategory) -> inp -> TypeDefinition ANY s -> diff --git a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/Validation/Internal.hs b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/Validation/Internal.hs index 3ffda2254c..bad11dc606 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/Validation/Internal.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/Validation/Internal.hs @@ -56,26 +56,27 @@ import Data.Morpheus.Types.Internal.Validation.Validator import Relude askType :: - Constraints m c cat s ctx => + (Constraints m c cat s ctx) => Typed cat s TypeRef -> m (TypeDefinition cat s) askType = untyped (__askType . typeConName) askType2 :: - Constraints m c cat s ctx => + (Constraints m c cat s ctx) => Typed cat s TypeName -> m (TypeDefinition cat s) askType2 = untyped __askType __askType :: - Constraints m c cat s ctx => TypeName -> m (TypeDefinition cat s) + (Constraints m c cat s ctx) => TypeName -> m (TypeDefinition cat s) __askType name = asks schema - >>= maybe (throwError (unknownType name)) pure . lookupDataType name + >>= maybe (throwError (unknownType name)) pure + . lookupDataType name >>= kindConstraint askTypeMember :: - Constraints m c cat s ctx => + (Constraints m c cat s ctx) => UnionMember cat s -> m (TypeDefinition (ToOBJECT cat) s) askTypeMember = askType2 . typed memberName >=> constraintObject @@ -89,8 +90,10 @@ askInterfaceTypes :: m (OrdMap TypeName (TypeDefinition IMPLEMENTABLE s)) askInterfaceTypes typeDef@TypeDefinition {typeName} = asks schema - >>= traverse (validate . fromCategory) . possibleInterfaceTypes typeName - >>= fromElems . (typeDef :) + >>= traverse (validate . fromCategory) + . possibleInterfaceTypes typeName + >>= fromElems + . (typeDef :) where validate (Just x) = pure x validate Nothing = throwError (internal "Invalid interface Types") @@ -115,7 +118,7 @@ type KindConstraint f c = ) _kindConstraint :: - KindConstraint f k => + (KindConstraint f k) => Token -> TypeDefinition ANY s -> f (TypeDefinition k s) @@ -126,7 +129,7 @@ _kindConstraint err anyType = (fromAny anyType) class KindErrors c where - kindConstraint :: KindConstraint f c => TypeDefinition ANY s -> f (TypeDefinition c s) + kindConstraint :: (KindConstraint f c) => TypeDefinition ANY s -> f (TypeDefinition c s) constraintObject :: ( Applicative f, MonadError GQLError f @@ -149,9 +152,9 @@ violation :: TypeName -> GQLError violation kind typeName = - internal $ - "Type \"" - <> msg typeName - <> "\" must be an" - <> msg kind - <> "." + internal + $ "Type \"" + <> msg typeName + <> "\" must be an" + <> msg kind + <> "." diff --git a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/Validation/Scope.hs b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/Validation/Scope.hs index 87ac4b8d32..5a0f374b55 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/Validation/Scope.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/Validation/Scope.hs @@ -101,7 +101,7 @@ renderScope <> render fieldName ) -renderSection :: RenderGQL a => GQLError -> a -> GQLError +renderSection :: (RenderGQL a) => GQLError -> a -> GQLError renderSection label content = "\n\n" <> label diff --git a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/Validation/Validator.hs b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/Validation/Validator.hs index 1185be6085..91842b55b6 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/Validation/Validator.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Types/Internal/Validation/Validator.hs @@ -173,21 +173,21 @@ inField .. } -inputValueSource :: MonadReader (ValidatorContext s (InputContext c)) m => m InputSource +inputValueSource :: (MonadReader (ValidatorContext s (InputContext c)) m) => m InputSource inputValueSource = asksLocal inputSource -asksScope :: MonadReader (ValidatorContext s ctx) m => (Scope -> a) -> m a +asksScope :: (MonadReader (ValidatorContext s ctx) m) => (Scope -> a) -> m a asksScope f = asks (f . scope) askTypeDefinitions :: - MonadReader (ValidatorContext s ctx) m => + (MonadReader (ValidatorContext s ctx) m) => m (HashMap TypeName (TypeDefinition ANY s)) askTypeDefinitions = asks (typeDefinitions . schema) -askVariables :: MonadReader (ValidatorContext s1 (OperationContext s2 s3)) m => m (VariableDefinitions s2) +askVariables :: (MonadReader (ValidatorContext s1 (OperationContext s2 s3)) m) => m (VariableDefinitions s2) askVariables = asksLocal variables -askFragments :: MonadReader (ValidatorContext s1 (OperationContext s2 s3)) m => m (Fragments s3) +askFragments :: (MonadReader (ValidatorContext s1 (OperationContext s2 s3)) m) => m (Fragments s3) askFragments = asksLocal fragments runValidator :: Validator s ctx a -> Config -> Schema s -> Scope -> ctx -> GQLResult a @@ -265,7 +265,7 @@ withScope :: m b withScope f = local (\ValidatorContext {..} -> ValidatorContext {scope = f scope, ..}) -asksLocal :: MonadReader (ValidatorContext s c) m => (c -> a) -> m a +asksLocal :: (MonadReader (ValidatorContext s c) m) => (c -> a) -> m a asksLocal f = asks (f . localContext) instance MonadError GQLError (Validator s ctx) where diff --git a/morpheus-graphql-core/src/Data/Morpheus/Types/SelectionTree.hs b/morpheus-graphql-core/src/Data/Morpheus/Types/SelectionTree.hs index 7f04de5076..f9da99a718 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Types/SelectionTree.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Types/SelectionTree.hs @@ -34,10 +34,10 @@ import Relude hiding (empty) __lookup :: (IsMap (Name t) m, ToString n) => n -> m a -> Maybe a __lookup name = lookup (fromString $ toString name) -__argument :: IsString name => Argument VALID -> (name, Value) +__argument :: (IsString name) => Argument VALID -> (name, Value) __argument Argument {..} = (fromString $ toString argumentName, toJSON argumentValue) -__variable :: IsString name => Variable VALID -> (name, Value) +__variable :: (IsString name) => Variable VALID -> (name, Value) __variable Variable {..} = (fromString $ toString variableName, __variableContent variableValue) __variableContent :: VariableContent VALID -> Value @@ -53,7 +53,7 @@ class SelectionTree node where isLeaf :: node -> Bool -- | get a node's name (real name. not alias) - getName :: IsString name => node -> name + getName :: (IsString name) => node -> name -- | Get the children getChildrenList :: node -> [ChildNode node] @@ -63,17 +63,17 @@ class SelectionTree node where getChildren :: node -> [ChildNode node] -- | lookup child node by name (does not use aliases) - getChild :: ToString name => name -> node -> Maybe (ChildNode node) + getChild :: (ToString name) => name -> node -> Maybe (ChildNode node) -- | checks if the node has a child with the specified name (does not use aliases) - hasChild :: ToString name => name -> node -> Bool + hasChild :: (ToString name) => name -> node -> Bool hasChild name = isJust . getChild name -- | get node arguments (as aeson values) - getArguments :: IsString name => node -> [(name, Value)] + getArguments :: (IsString name) => node -> [(name, Value)] -- | get node argument by name (as aeson values) - getArgument :: ToString name => name -> node -> Maybe Value + getArgument :: (ToString name) => name -> node -> Maybe Value instance SelectionTree (Selection VALID) where type ChildNode (Selection VALID) = Selection VALID @@ -99,7 +99,7 @@ instance SelectionTree (Selection VALID) where select (x : xs) = __lookup name x <|> select xs select [] = Nothing - getName :: IsString name => Selection VALID -> name + getName :: (IsString name) => Selection VALID -> name getName = toName . selectionName getArguments = map __argument . toList . selectionArguments @@ -121,5 +121,5 @@ instance SelectionTree (Operation VALID) where getArgument name = fmap (__variableContent . variableValue) . __lookup name . operationArguments -toName :: IsString name => Name t -> name +toName :: (IsString name) => Name t -> name toName = fromString . unpack . unpackName diff --git a/morpheus-graphql-core/src/Data/Morpheus/Validation/Document/Interface.hs b/morpheus-graphql-core/src/Data/Morpheus/Validation/Document/Interface.hs index ebd0efe506..68d7ccfee4 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Validation/Document/Interface.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Validation/Document/Interface.hs @@ -95,8 +95,8 @@ instance StructuralCompatibility (ArgumentsDefinition s) where subArguments `isCompatibleTo` arguments = traverse_ hasCompatibleSubArgument arguments where hasCompatibleSubArgument argument = - inArgument (keyOf argument) $ - selectOr (failImplements Missing) (`isCompatibleTo` argument) (keyOf argument) subArguments + inArgument (keyOf argument) + $ selectOr (failImplements Missing) (`isCompatibleTo` argument) (keyOf argument) subArguments instance StructuralCompatibility (ArgumentDefinition s) where isCompatibleTo = isCompatibleBy (fieldType . argument) diff --git a/morpheus-graphql-core/src/Data/Morpheus/Validation/Document/Validation.hs b/morpheus-graphql-core/src/Data/Morpheus/Validation/Document/Validation.hs index f329df4701..c4f074252c 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Validation/Document/Validation.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Validation/Document/Validation.hs @@ -123,14 +123,14 @@ instance TypeCheck (TypeDefinition cat) where typeDirectives, typeContent } = - inType typeName $ - TypeDefinition + inType typeName + $ TypeDefinition typeDescription - <$> checkName typeName - <*> validateDirectives (typeDirectiveLocation typeContent) typeDirectives - <*> typeCheck typeContent + <$> checkName typeName + <*> validateDirectives (typeDirectiveLocation typeContent) typeDirectives + <*> typeCheck typeContent -checkName :: MonadError GQLError f => Name t -> f (Name t) +checkName :: (MonadError GQLError f) => Name t -> f (Name t) checkName name | isValidName name = pure name | otherwise = throwError ("Invalid Name:" <> msg name) @@ -159,7 +159,7 @@ instance TypeCheck (TypeContent TRUE cat) where typeCheck DataUnion {unionMembers} = DataUnion <$> traverse typeCheck unionMembers typeCheck (DataInterface fields) = DataInterface <$> traverse typeCheck fields -instance FieldDirectiveLocation cat => TypeCheck (FieldDefinition cat) where +instance (FieldDirectiveLocation cat) => TypeCheck (FieldDefinition cat) where type TypeContext (FieldDefinition cat) = TypeEntity ON_TYPE typeCheck FieldDefinition {..} = inField @@ -187,8 +187,9 @@ instance FieldDirectiveLocation IN where instance TypeCheck DirectiveDefinition where typeCheck DirectiveDefinition {directiveDefinitionArgs = arguments, ..} = - inType "Directive" $ - inField directiveDefinitionName $ do + inType "Directive" + $ inField directiveDefinitionName + $ do directiveDefinitionArgs <- traverse typeCheck arguments pure DirectiveDefinition {..} diff --git a/morpheus-graphql-core/src/Data/Morpheus/Validation/Internal/Arguments.hs b/morpheus-graphql-core/src/Data/Morpheus/Validation/Internal/Arguments.hs index d6ca356dfe..d830e98fe1 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Validation/Internal/Arguments.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Validation/Internal/Arguments.hs @@ -100,12 +100,12 @@ validateArgumentValue :: validateArgumentValue field Argument {argumentValue, ..} = - withScope (setPosition argumentPosition) $ - startInput (SourceArgument argumentName) $ - Argument - argumentPosition - argumentName - <$> validateInputByTypeRef (typed fieldType field) argumentValue + withScope (setPosition argumentPosition) + $ startInput (SourceArgument argumentName) + $ Argument + argumentPosition + argumentName + <$> validateInputByTypeRef (typed fieldType field) argumentValue validateFieldArguments :: FieldDefinition OUT VALID -> @@ -119,7 +119,7 @@ validateFieldArguments field = arguments = fieldArguments field validateDirectiveArguments :: - ArgumentsConstraints ctx schemaStage valueStage => + (ArgumentsConstraints ctx schemaStage valueStage) => DirectiveDefinition schemaStage -> Arguments valueStage -> Validator schemaStage ctx (Arguments VALID) @@ -132,7 +132,7 @@ validateDirectiveArguments directiveDefinitionArgs validateArguments :: - ArgumentsConstraints ctx schemaStage s => + (ArgumentsConstraints ctx schemaStage s) => (Argument CONST -> Validator schemaStage ctx (ArgumentDefinition schemaStage)) -> ArgumentsDefinition schemaStage -> Arguments s -> @@ -145,13 +145,13 @@ validateArguments checkUnknown argsDef rawArgs = do class Resolve f s ctx where resolve :: f s -> Validator schemaS ctx (f CONST) -instance VariableConstraints (OperationContext VALID s) => Resolve Argument RAW (OperationContext VALID s) where +instance (VariableConstraints (OperationContext VALID s)) => Resolve Argument RAW (OperationContext VALID s) where resolve (Argument key position val) = Argument key position <$> resolve val instance Resolve f CONST ctx where resolve = pure -instance VariableConstraints (OperationContext VALID s) => Resolve Value RAW (OperationContext VALID s) where +instance (VariableConstraints (OperationContext VALID s)) => Resolve Value RAW (OperationContext VALID s) where resolve Null = pure Null resolve (Scalar x) = pure $ Scalar x resolve (Enum x) = pure $ Enum x @@ -160,7 +160,7 @@ instance VariableConstraints (OperationContext VALID s) => Resolve Value RAW (Op resolve (VariableValue ref) = askVariables >>= fmap (ResolvedVariable ref) - . selectRequired ref + . selectRequired ref -instance VariableConstraints (OperationContext VALID s) => Resolve ObjectEntry RAW (OperationContext VALID s) where +instance (VariableConstraints (OperationContext VALID s)) => Resolve ObjectEntry RAW (OperationContext VALID s) where resolve (ObjectEntry name value) = ObjectEntry name <$> resolve value diff --git a/morpheus-graphql-core/src/Data/Morpheus/Validation/Internal/Directive.hs b/morpheus-graphql-core/src/Data/Morpheus/Validation/Internal/Directive.hs index f0df1ba399..988f258e0b 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Validation/Internal/Directive.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Validation/Internal/Directive.hs @@ -51,14 +51,14 @@ import Data.Morpheus.Validation.Internal.Arguments import Relude validateDirectives :: - ArgumentsConstraints ctx schemaS s => + (ArgumentsConstraints ctx schemaS s) => DirectiveLocation -> Directives s -> Validator schemaS ctx (Directives VALID) validateDirectives location = traverse (validate location) validate :: - ArgumentsConstraints c schemaS s => + (ArgumentsConstraints c schemaS s) => DirectiveLocation -> Directive s -> Validator schemaS c (Directive VALID) @@ -82,9 +82,9 @@ validateDirectiveLocation DirectiveDefinition {directiveDefinitionLocations} | loc `elem` directiveDefinitionLocations = pure () | otherwise = - throwError $ - ("Directive " <> msg directiveName <> " may not to be used on " <> msg loc) - `at` directivePosition + throwError + $ ("Directive " <> msg directiveName <> " may not to be used on " <> msg loc) + `at` directivePosition directiveFulfilled :: Bool -> @@ -115,9 +115,9 @@ assertArgument :: Validator schemaS ctx Bool assertArgument asserted Argument {argumentValue = Scalar (Boolean actual)} = pure (asserted == actual) assertArgument _ Argument {argumentValue, argumentPosition} = - throwError $ - ( "Expected type Boolean!, found " - <> msg argumentValue - <> "." - ) - `at` argumentPosition + throwError + $ ( "Expected type Boolean!, found " + <> msg argumentValue + <> "." + ) + `at` argumentPosition diff --git a/morpheus-graphql-core/src/Data/Morpheus/Validation/Internal/Value.hs b/morpheus-graphql-core/src/Data/Morpheus/Validation/Internal/Value.hs index 080d2dafda..bb37534ed9 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Validation/Internal/Value.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Validation/Internal/Value.hs @@ -84,14 +84,14 @@ violation message value = do } <- asksScope id prefix <- inputMessagePrefix - throwError $ - ( prefix - <> typeViolation - (TypeRef currentTypeName currentTypeWrappers) - value - <> maybe "" (" " <>) message - ) - `atPositions` position + throwError + $ ( prefix + <> typeViolation + (TypeRef currentTypeName currentTypeWrappers) + value + <> maybe "" (" " <>) message + ) + `atPositions` position checkTypeCompatibility :: TypeRef -> @@ -103,7 +103,7 @@ checkTypeCompatibility valueType ref var@Variable {variableValue = ValidVariable | otherwise = throwError $ incompatibleVariableType ref var valueType validateInputByTypeRef :: - ValidateWithDefault c schemaS s => + (ValidateWithDefault c schemaS s) => Typed IN schemaS TypeRef -> Value s -> Validator schemaS (InputContext c) (Value VALID) @@ -117,7 +117,7 @@ validateInputByTypeRef value validateValueByField :: - ValidateWithDefault c schemaS s => + (ValidateWithDefault c schemaS s) => FieldDefinition IN schemaS -> Value s -> Validator schemaS (InputContext c) (Value VALID) @@ -128,7 +128,7 @@ validateValueByField field = -- Validate input Values validateInputByType :: - ValidateWithDefault ctx schemaS valueS => + (ValidateWithDefault ctx schemaS valueS) => TypeWrapper -> TypeDefinition IN schemaS -> Value valueS -> @@ -138,7 +138,7 @@ validateInputByType tyWrappers typeDef = -- VALIDATION validateWrapped :: - ValidateWithDefault ctx schemaS valueS => + (ValidateWithDefault ctx schemaS valueS) => TypeWrapper -> TypeDefinition IN schemaS -> Value valueS -> @@ -162,7 +162,7 @@ validateWrapped BaseType {} TypeDefinition {typeContent} entryValue = validateUnwrapped typeContent entryValue validateUnwrapped :: - ValidateWithDefault ctx schemaS valueS => + (ValidateWithDefault ctx schemaS valueS) => TypeContent TRUE IN schemaS -> Value valueS -> InputValidator schemaS ctx ValidValue @@ -178,7 +178,7 @@ validateUnwrapped _ value = violation Nothing value -- INPUT UNION validateInputUnion :: - ValidateWithDefault ctx schemaS s => + (ValidateWithDefault ctx schemaS s) => UnionTypeDefinition IN schemaS -> Object s -> InputValidator schemaS ctx (Value VALID) @@ -188,7 +188,7 @@ validateInputUnion inputUnion rawFields = Right (name, value) -> validateInputUnionMember name value validateInputUnionMember :: - ValidateWithDefault ctx schemaS valueS => + (ValidateWithDefault ctx schemaS valueS) => UnionMember IN schemaS -> Value valueS -> InputValidator schemaS ctx (Value VALID) @@ -214,7 +214,7 @@ mkInputUnionValue -- INPUT Object validateInputObject :: - ValidateWithDefault ctx schemaS valueS => + (ValidateWithDefault ctx schemaS valueS) => FieldsDefinition IN schemaS -> Object valueS -> InputValidator schemaS ctx (Object VALID) diff --git a/morpheus-graphql-core/src/Data/Morpheus/Validation/Query/Fragment.hs b/morpheus-graphql-core/src/Data/Morpheus/Validation/Query/Fragment.hs index 1eed070aa7..95b99a6d09 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Validation/Query/Fragment.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Validation/Query/Fragment.hs @@ -52,7 +52,7 @@ import Relude hiding (empty) class ValidateFragmentSelection (s :: Stage) where validateFragmentSelection :: - Applicative m => + (Applicative m) => (Fragment RAW -> m (SelectionSet VALID)) -> Fragment s -> m (SelectionSet VALID) @@ -64,7 +64,7 @@ instance ValidateFragmentSelection RAW where validateFragmentSelection f = f validateSpread :: - ValidateFragmentSelection s => + (ValidateFragmentSelection s) => (Fragment RAW -> FragmentValidator s (SelectionSet VALID)) -> [TypeName] -> Ref FragmentName -> diff --git a/morpheus-graphql-core/src/Data/Morpheus/Validation/Query/Selection.hs b/morpheus-graphql-core/src/Data/Morpheus/Validation/Query/Selection.hs index 6892cca236..5b3096a2b6 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Validation/Query/Selection.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Validation/Query/Selection.hs @@ -128,8 +128,8 @@ validateOperation validateDirectives (toDirectiveLocation operationType) operationDirectives - pure $ - Operation + pure + $ Operation { operationName, operationType, operationArguments = empty, @@ -152,8 +152,8 @@ processSelectionDirectives location rawDirectives sel = do directives <- validateDirectives location rawDirectives include <- shouldIncludeSelection directives selection <- sel directives - pure $ - if include + pure + $ if include then Just selection else Nothing @@ -172,15 +172,18 @@ validateSelectionSet :: SelectionSet RAW -> FragmentValidator s (SelectionSet VALID) validateSelectionSet typeDef = - traverse (validateSelection typeDef) . toList - >=> toNonEmpty . catMaybes - >=> startHistory . mergeConcat + traverse (validateSelection typeDef) + . toList + >=> toNonEmpty + . catMaybes + >=> startHistory + . mergeConcat -- validate single selection: InlineFragments and Spreads will Be resolved and included in SelectionSet -validateSelection :: ValidateFragmentSelection s => TypeDefinition IMPLEMENTABLE VALID -> Selection RAW -> FragmentValidator s (Maybe (SelectionSet VALID)) +validateSelection :: (ValidateFragmentSelection s) => TypeDefinition IMPLEMENTABLE VALID -> Selection RAW -> FragmentValidator s (Maybe (SelectionSet VALID)) validateSelection typeDef Selection {..} = - withScope (setSelection typeDef selectionRef) $ - processSelectionDirectives LOCATION_FIELD selectionDirectives validateContent + withScope (setSelection typeDef selectionRef) + $ processSelectionDirectives LOCATION_FIELD selectionDirectives validateContent where selectionRef = Ref selectionName selectionPosition validateContent directives = do @@ -194,16 +197,16 @@ validateSelection typeDef Selection {..} = } pure $ singleton (keyOf selection) selection validateSelection typeDef (Spread dirs ref) = - processSelectionDirectives LOCATION_FRAGMENT_SPREAD dirs $ - const $ - validateSpreadSelection typeDef ref + processSelectionDirectives LOCATION_FRAGMENT_SPREAD dirs + $ const + $ validateSpreadSelection typeDef ref validateSelection typeDef (InlineFragment fragment@Fragment {fragmentDirectives}) = - processSelectionDirectives LOCATION_INLINE_FRAGMENT fragmentDirectives $ - const $ - validateInlineFragmentSelection typeDef fragment + processSelectionDirectives LOCATION_INLINE_FRAGMENT fragmentDirectives + $ const + $ validateInlineFragmentSelection typeDef fragment validateSpreadSelection :: - ValidateFragmentSelection s => + (ValidateFragmentSelection s) => TypeDefinition a VALID -> Ref FragmentName -> FragmentValidator s (SelectionSet VALID) @@ -212,7 +215,7 @@ validateSpreadSelection typeDef ref = do unionTagSelection <$> validateSpread validateFragmentSelection types ref validateInlineFragmentSelection :: - ValidateFragmentSelection s => + (ValidateFragmentSelection s) => TypeDefinition IMPLEMENTABLE VALID -> Fragment RAW -> FragmentValidator s (SelectionSet VALID) @@ -238,7 +241,7 @@ selectSelectionField ref typeDef validateSelectionContent :: forall s. - ValidateFragmentSelection s => + (ValidateFragmentSelection s) => TypeDefinition IMPLEMENTABLE VALID -> Ref FieldName -> Arguments RAW -> @@ -297,8 +300,8 @@ validateByTypeContent validateSelectionSet (TypeDefinition {typeContent = DataInterface {..}, ..}) __validate _ = - const $ - throwError $ - hasNoSubfields - currentSelectionRef - typeDef + const + $ throwError + $ hasNoSubfields + currentSelectionRef + typeDef diff --git a/morpheus-graphql-core/src/Data/Morpheus/Validation/Query/UnionSelection.hs b/morpheus-graphql-core/src/Data/Morpheus/Validation/Query/UnionSelection.hs index 466cbb3832..eba5bf3bbb 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Validation/Query/UnionSelection.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Validation/Query/UnionSelection.hs @@ -77,7 +77,8 @@ splitFragment f types (Spread dirs ref) = do Left <$> validateSpread f (typeName <$> types) ref splitFragment f types (InlineFragment fragment@Fragment {..}) = do _ <- validateDirectives LOCATION_INLINE_FRAGMENT fragmentDirectives - Left . UnionTag fragmentType + Left + . UnionTag fragmentType <$> (castFragmentType Nothing fragmentPosition (typeName <$> types) fragment >>= f) exploreFragments :: @@ -142,7 +143,9 @@ joinClusters maybeSelSet typedSelections | null typedSelections = maybe noEmptySelection (pure . SelectionSet) maybeSelSet | otherwise = traverse mkUnionTag (toAssoc typedSelections) - >>= fmap (UnionSelection maybeSelSet) . startHistory . fromElems + >>= fmap (UnionSelection maybeSelSet) + . startHistory + . fromElems where mkUnionTag :: (TypeName, [SelectionSet VALID]) -> FragmentValidator s UnionTag mkUnionTag (typeName, fragments) = UnionTag typeName <$> (maybeMerge (toList maybeSelSet <> fragments) >>= maybe noEmptySelection pure) diff --git a/morpheus-graphql-core/src/Data/Morpheus/Validation/Query/Variable.hs b/morpheus-graphql-core/src/Data/Morpheus/Validation/Query/Variable.hs index 5b27c54fa7..98392ae1ba 100644 --- a/morpheus-graphql-core/src/Data/Morpheus/Validation/Query/Variable.hs +++ b/morpheus-graphql-core/src/Data/Morpheus/Validation/Query/Variable.hs @@ -105,7 +105,7 @@ allVariableRefs = collect <=< fmap (map toEntry . concat) . traverse (mapSelecti <$> ( askFragments >>= selectKnown reference >>= mapSelection searchRefs - . fragmentSelection + . fragmentSelection ) resolveOperationVariables :: @@ -142,13 +142,13 @@ lookupAndValidateValueOnBody variablePosition, variableValue = DefaultValue defaultValue } = - withScope (setPosition variablePosition) $ - toVariable - <$> ( askTypeDefinitions - >>= selectKnown (Ref typeConName variablePosition) - >>= constraint INPUT var - >>= checkType getVariable defaultValue - ) + withScope (setPosition variablePosition) + $ toVariable + <$> ( askTypeDefinitions + >>= selectKnown (Ref typeConName variablePosition) + >>= constraint INPUT var + >>= checkType getVariable defaultValue + ) where toVariable x = var {variableValue = ValidVariableValue x} getVariable :: Maybe ResolvedValue diff --git a/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/App.hs b/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/App.hs index 6f0b871736..cd4ee93caa 100644 --- a/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/App.hs +++ b/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/App.hs @@ -62,10 +62,10 @@ class where deriveApp :: f m event qu mu su -> App event m -instance RootResolverConstraint m e query mut sub => DeriveApp RootResolver m e query mut sub where +instance (RootResolverConstraint m e query mut sub) => DeriveApp RootResolver m e query mut sub where deriveApp root = resultOr FailApp (uncurry mkApp) $ (,) <$> deriveSchema (Identity root) <*> deriveResolvers root -instance NamedResolversConstraint m e query mut sub => DeriveApp NamedResolvers m e query mut sub where +instance (NamedResolversConstraint m e query mut sub) => DeriveApp NamedResolvers m e query mut sub where deriveApp root = resultOr FailApp (uncurry mkApp) $ (,deriveNamedResolvers root) <$> deriveSchema (Identity root) diff --git a/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Internal/Type.hs b/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Internal/Type.hs index 7c0ded6902..80e51eb8b5 100644 --- a/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Internal/Type.hs +++ b/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Internal/Type.hs @@ -210,8 +210,8 @@ toTypeDefinition :: GQLResult (TypeDefinition cat CONST) toTypeDefinition ctx proxy content = do dirs <- serializeDirectives ctx (getTypeDirectives ctx proxy) - pure $ - TypeDefinition + pure + $ TypeDefinition (visitTypeDescription ctx proxy Nothing) (useTypename ctx proxy) dirs diff --git a/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Internal/Value.hs b/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Internal/Value.hs index 7bc76fcf2c..0c36d93634 100644 --- a/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Internal/Value.hs +++ b/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Internal/Value.hs @@ -69,11 +69,11 @@ decideUnion drv (left, right) name value | name `elem` left = L1 <$> decodeRep drv value | name `elem` right = R1 <$> decodeRep drv value | otherwise = - throwError $ - internal $ - "Constructor \"" - <> msg name - <> "\" could not find in Union" + throwError + $ internal + $ "Constructor \"" + <> msg name + <> "\" could not find in Union" class DecodeRep ctx (f :: Type -> Type) where decodeRep :: ctx -> ValidValue -> DecoderT (f a) diff --git a/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Kinded/Channels.hs b/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Kinded/Channels.hs index 6eff2c658c..b6ccb199ff 100644 --- a/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Kinded/Channels.hs +++ b/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Kinded/Channels.hs @@ -110,7 +110,8 @@ instance (MonadResolver m, MonadOperation m ~ SUBSCRIPTION, MonadEvent m ~ e) => instance (MonadResolver m, MonadOperation m ~ SUBSCRIPTION, MonadEvent m ~ e, val arg) => GetChannel val e (arg -> SubscriptionField (m a)) where getChannel drv f sel@Selection {selectionArguments} = useDecodeArguments drv selectionArguments - >>= flip (getChannel drv) sel . f + >>= flip (getChannel drv) sel + . f ------------------------------------------------------ diff --git a/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Kinded/NamedResolverFun.hs b/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Kinded/NamedResolverFun.hs index d9ddcdb3af..3b72676ea5 100644 --- a/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Kinded/NamedResolverFun.hs +++ b/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Kinded/NamedResolverFun.hs @@ -128,8 +128,10 @@ packRef name v = ResRef $ pure $ NamedResolverRef name [v] instance (UseNamedResolver namedRes res gql val ~ ctx, Monad m, val a, MonadResolver m, res m b) => KindedNamedFunValue ctx CUSTOM m (a -> b) where kindedNamedFunValue ctx (Kinded f) = getArguments - >>= liftState . useDecodeArguments (namedDrv ctx) - >>= useNamedFieldResolver ctx . f + >>= liftState + . useDecodeArguments (namedDrv ctx) + >>= useNamedFieldResolver ctx + . f getOptions :: UseNamedResolver namedRes res gql val -> GRepFun gql (res m) Identity (m (ResolverValue m)) getOptions ctx = diff --git a/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Kinded/Resolver.hs b/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Kinded/Resolver.hs index 13b823afd3..bd77398936 100644 --- a/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Kinded/Resolver.hs +++ b/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Kinded/Resolver.hs @@ -75,8 +75,11 @@ instance (UseResolver res gql val ~ ctx, EXPLORE gql res m guard, EXPLORE gql re instance (UseResolver res gql val ~ ctx, Generic a, res m b, val a) => KindedResolver ctx CUSTOM m (a -> b) where kindedResolver res (Kinded f) = getArguments - >>= liftState . useDecodeValue res . argumentsToObject - >>= useEncodeResolver res . f + >>= liftState + . useDecodeValue res + . argumentsToObject + >>= useEncodeResolver res + . f instance (UseResolver res gql val ~ ctx, res m a) => KindedResolver ctx CUSTOM m (m a) where kindedResolver res (Kinded value) = value >>= useEncodeResolver res diff --git a/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Schema.hs b/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Schema.hs index dc85f0ed10..4da70379e6 100644 --- a/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Schema.hs +++ b/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Schema.hs @@ -123,15 +123,15 @@ checkTypeCollisions = fmap toList . foldlM collectTypes mempty failureRequirePrefix :: TypeName -> GQLResult b failureRequirePrefix typename = - throwError $ - "It appears that the Haskell type " - <> msg typename - <> " was used as both input and output type, which is not allowed by GraphQL specifications." - <> "\n\n " - <> "If you use \"InputTypeNamespace\" directive, " - <> "you can override the default type names for " - <> msg typename - <> " to solve this problem." + throwError + $ "It appears that the Haskell type " + <> msg typename + <> " was used as both input and output type, which is not allowed by GraphQL specifications." + <> "\n\n " + <> "If you use \"InputTypeNamespace\" directive, " + <> "you can override the default type names for " + <> msg typename + <> " to solve this problem." withSameCategory :: TypeFingerprint -> TypeFingerprint withSameCategory (TypeableFingerprint _ xs) = TypeableFingerprint OUT xs diff --git a/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Utils/Types.hs b/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Utils/Types.hs index 0428cea4ee..e32779975a 100644 --- a/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Utils/Types.hs +++ b/morpheus-graphql-server/src/Data/Morpheus/Server/Deriving/Utils/Types.hs @@ -101,11 +101,11 @@ toFieldContent _ _ = Nothing -- if value is already validated but value has different type typeMismatch :: GQLError -> Value s -> GQLError typeMismatch text jsType = - internal $ - "Type mismatch! expected:" - <> text - <> ", got: " - <> msg jsType + internal + $ "Type mismatch! expected:" + <> text + <> ", got: " + <> msg jsType coerceInputObject :: (MonadError GQLError m) => ValidValue -> m ValidObject coerceInputObject (Object object) = pure object diff --git a/morpheus-graphql-server/src/Data/Morpheus/Server/Resolvers.hs b/morpheus-graphql-server/src/Data/Morpheus/Server/Resolvers.hs index 664d5137fc..143ba811be 100644 --- a/morpheus-graphql-server/src/Data/Morpheus/Server/Resolvers.hs +++ b/morpheus-graphql-server/src/Data/Morpheus/Server/Resolvers.hs @@ -68,7 +68,8 @@ data event (query :: (Type -> Type) -> Type) (mutation :: (Type -> Type) -> Type) - (subscription :: (Type -> Type) -> Type) = RootResolver + (subscription :: (Type -> Type) -> Type) + = RootResolver { queryResolver :: query (Resolver QUERY event m), mutationResolver :: mutation (Resolver MUTATION event m), subscriptionResolver :: subscription (Resolver SUBSCRIPTION event m) diff --git a/morpheus-graphql-server/src/Data/Morpheus/Server/Types/Directives.hs b/morpheus-graphql-server/src/Data/Morpheus/Server/Types/Directives.hs index d5f7acad76..8d78324cdc 100644 --- a/morpheus-graphql-server/src/Data/Morpheus/Server/Types/Directives.hs +++ b/morpheus-graphql-server/src/Data/Morpheus/Server/Types/Directives.hs @@ -110,7 +110,7 @@ instance (ToLocation l, ToLocations ls) => ToLocations (l : ls) where instance ToLocations '[] where toLocations _ = [] -getLocations :: forall f a. ToLocations (DIRECTIVE_LOCATIONS a) => f a -> [DirectiveLocation] +getLocations :: forall f a. (ToLocations (DIRECTIVE_LOCATIONS a)) => f a -> [DirectiveLocation] getLocations _ = toLocations (Proxy :: Proxy (DIRECTIVE_LOCATIONS a)) type ALLOWED (a :: Type) (l :: [DirectiveLocation]) = OVERLAPS l (DIRECTIVE_LOCATIONS a) @@ -140,16 +140,16 @@ class -- TYPE VISITORS -visitTypeName' :: forall a. GQLDirective a => a -> Bool -> TypeName -> TypeName +visitTypeName' :: forall a. (GQLDirective a) => a -> Bool -> TypeName -> TypeName visitTypeName' = __visitTypeName (Proxy :: Proxy (ALLOWED a TYPE_VISITOR_KIND)) -visitTypeDescription' :: forall a. GQLDirective a => a -> Maybe Description -> Maybe Description +visitTypeDescription' :: forall a. (GQLDirective a) => a -> Maybe Description -> Maybe Description visitTypeDescription' = __visitTypeDescription (Proxy :: Proxy (ALLOWED a TYPE_VISITOR_KIND)) -visitFieldNames' :: forall a. GQLDirective a => a -> FieldName -> FieldName +visitFieldNames' :: forall a. (GQLDirective a) => a -> FieldName -> FieldName visitFieldNames' = __visitFieldNames (Proxy :: Proxy (ALLOWED a TYPE_VISITOR_KIND)) -visitEnumNames' :: forall a. GQLDirective a => a -> TypeName -> TypeName +visitEnumNames' :: forall a. (GQLDirective a) => a -> TypeName -> TypeName visitEnumNames' = __visitEnumNames (Proxy :: Proxy (ALLOWED a TYPE_VISITOR_KIND)) class VISIT_TYPE a (t :: Bool) where @@ -164,7 +164,7 @@ instance VISIT_TYPE a 'False where __visitFieldNames _ _ = id __visitEnumNames _ _ = id -instance Visitors.VisitType a => VISIT_TYPE a TRUE where +instance (Visitors.VisitType a) => VISIT_TYPE a TRUE where __visitTypeName _ x isInput name = packName $ Visitors.visitTypeName x isInput (unpackName name) __visitTypeDescription _ = Visitors.visitTypeDescription __visitFieldNames _ x = packName . Visitors.visitFieldNames x . unpackName @@ -172,13 +172,13 @@ instance Visitors.VisitType a => VISIT_TYPE a TRUE where -- FIELD VISITORS -visitFieldName' :: forall a. GQLDirective a => a -> FieldName -> FieldName +visitFieldName' :: forall a. (GQLDirective a) => a -> FieldName -> FieldName visitFieldName' = __visitFieldName (Proxy :: Proxy (ALLOWED a FIELD_VISITOR_KIND)) -visitFieldDescription' :: forall a. GQLDirective a => a -> Maybe Description -> Maybe Description +visitFieldDescription' :: forall a. (GQLDirective a) => a -> Maybe Description -> Maybe Description visitFieldDescription' = __visitFieldDescription (Proxy :: Proxy (ALLOWED a FIELD_VISITOR_KIND)) -visitFieldDefaultValue' :: forall a. GQLDirective a => a -> Maybe (Value CONST) -> Maybe (Value CONST) +visitFieldDefaultValue' :: forall a. (GQLDirective a) => a -> Maybe (Value CONST) -> Maybe (Value CONST) visitFieldDefaultValue' = __visitFieldDefaultValue (Proxy :: Proxy (ALLOWED a FIELD_VISITOR_KIND)) class VISIT_FIELD a (t :: Bool) where @@ -191,17 +191,17 @@ instance VISIT_FIELD a FALSE where __visitFieldDescription _ _ = id __visitFieldDefaultValue _ _ = id -instance Visitors.VisitField a => VISIT_FIELD a TRUE where +instance (Visitors.VisitField a) => VISIT_FIELD a TRUE where __visitFieldName _ x name = packName $ Visitors.visitFieldName x (unpackName name) __visitFieldDescription _ = Visitors.visitFieldDescription __visitFieldDefaultValue _ = Visitors.visitFieldDefaultValue -- VISIT_ENUM -visitEnumName' :: forall a. GQLDirective a => a -> TypeName -> TypeName +visitEnumName' :: forall a. (GQLDirective a) => a -> TypeName -> TypeName visitEnumName' = __visitEnumName (Proxy :: Proxy (ALLOWED a ENUM_VISITOR_KIND)) -visitEnumDescription' :: forall a. GQLDirective a => a -> Maybe Description -> Maybe Description +visitEnumDescription' :: forall a. (GQLDirective a) => a -> Maybe Description -> Maybe Description visitEnumDescription' = __visitEnumDescription (Proxy :: Proxy (ALLOWED a ENUM_VISITOR_KIND)) class VISIT_ENUM a (t :: Bool) where @@ -212,7 +212,7 @@ instance VISIT_ENUM a FALSE where __visitEnumName _ _ = id __visitEnumDescription _ _ = id -instance Visitors.VisitEnum a => VISIT_ENUM a TRUE where +instance (Visitors.VisitEnum a) => VISIT_ENUM a TRUE where __visitEnumName _ x name = packName $ Visitors.visitEnumName x (unpackName name) __visitEnumDescription _ = Visitors.visitEnumDescription diff --git a/morpheus-graphql-server/test/Feature/Collision/CategoryCollisionFail.hs b/morpheus-graphql-server/test/Feature/Collision/CategoryCollisionFail.hs index d902a45720..596519e8a5 100644 --- a/morpheus-graphql-server/test/Feature/Collision/CategoryCollisionFail.hs +++ b/morpheus-graphql-server/test/Feature/Collision/CategoryCollisionFail.hs @@ -47,8 +47,8 @@ rootResolver = { queryResolver = Query { deity = - const $ - pure + const + $ pure Deity { name = "Morpheus", diff --git a/morpheus-graphql-server/test/Feature/Collision/CategoryCollisionSuccess.hs b/morpheus-graphql-server/test/Feature/Collision/CategoryCollisionSuccess.hs index 90825f0748..955c5546e8 100644 --- a/morpheus-graphql-server/test/Feature/Collision/CategoryCollisionSuccess.hs +++ b/morpheus-graphql-server/test/Feature/Collision/CategoryCollisionSuccess.hs @@ -59,8 +59,8 @@ rootResolver = { queryResolver = Query { deity = - const $ - pure + const + $ pure Deity { name = "Morpheus", diff --git a/morpheus-graphql-server/test/Feature/Input/Collections.hs b/morpheus-graphql-server/test/Feature/Input/Collections.hs index 12205da495..3e0fee9a78 100644 --- a/morpheus-graphql-server/test/Feature/Input/Collections.hs +++ b/morpheus-graphql-server/test/Feature/Input/Collections.hs @@ -31,7 +31,7 @@ import Data.Vector (Vector) import GHC.Generics (Generic) -- query -testRes :: Applicative m => Arg "value" a -> m a +testRes :: (Applicative m) => Arg "value" a -> m a testRes = pure . argValue type Coll m a = Arg "value" a -> m a diff --git a/morpheus-graphql-server/test/Feature/Input/Enums.hs b/morpheus-graphql-server/test/Feature/Input/Enums.hs index d8f46e6115..2a7e8ca342 100644 --- a/morpheus-graphql-server/test/Feature/Input/Enums.hs +++ b/morpheus-graphql-server/test/Feature/Input/Enums.hs @@ -47,7 +47,7 @@ newtype TestArgs a = TestArgs deriving (Generic, Show, GQLType) -- query -testRes :: Applicative m => TestArgs a -> m a +testRes :: (Applicative m) => TestArgs a -> m a testRes TestArgs {level} = pure level -- resolver diff --git a/morpheus-graphql-server/test/Feature/Input/Objects.hs b/morpheus-graphql-server/test/Feature/Input/Objects.hs index 96136584ae..c44342a1d6 100644 --- a/morpheus-graphql-server/test/Feature/Input/Objects.hs +++ b/morpheus-graphql-server/test/Feature/Input/Objects.hs @@ -37,7 +37,7 @@ newtype Arg a = Arg deriving (Generic, Show, GQLType) -- query -testRes :: Show a => Applicative m => Arg a -> m Text +testRes :: (Show a) => (Applicative m) => Arg a -> m Text testRes Arg {value} = pure $ pack $ show value -- resolver diff --git a/morpheus-graphql-server/test/Feature/Input/Scalars.hs b/morpheus-graphql-server/test/Feature/Input/Scalars.hs index eedf64025a..005e90aca6 100644 --- a/morpheus-graphql-server/test/Feature/Input/Scalars.hs +++ b/morpheus-graphql-server/test/Feature/Input/Scalars.hs @@ -27,7 +27,7 @@ newtype Arg a = Arg deriving (Generic, Show, GQLType) -- query -testRes :: Applicative m => Arg a -> m a +testRes :: (Applicative m) => Arg a -> m a testRes Arg {value} = pure value -- resolver diff --git a/morpheus-graphql-server/test/Feature/NamedResolvers/DB.hs b/morpheus-graphql-server/test/Feature/NamedResolvers/DB.hs index 782da933c3..1138c69d73 100644 --- a/morpheus-graphql-server/test/Feature/NamedResolvers/DB.hs +++ b/morpheus-graphql-server/test/Feature/NamedResolvers/DB.hs @@ -40,7 +40,7 @@ getPlace "zeus" = pure "olympus" getPlace "morpheus" = pure "dreams" getPlace x = pure x -getDocsById :: Monad m => ID -> m (Maybe Text) +getDocsById :: (Monad m) => ID -> m (Maybe Text) getDocsById "morpheus" = pure $ Just "the god of dreams" getDocsById "zeus" = pure $ Just "the king of the gods" getDocsById "olympus" = pure $ Just "Mountain" diff --git a/morpheus-graphql-server/test/Feature/NamedResolvers/DeitiesApp.hs b/morpheus-graphql-server/test/Feature/NamedResolvers/DeitiesApp.hs index 2f1695bdd3..0691844d1b 100644 --- a/morpheus-graphql-server/test/Feature/NamedResolvers/DeitiesApp.hs +++ b/morpheus-graphql-server/test/Feature/NamedResolvers/DeitiesApp.hs @@ -36,11 +36,11 @@ getPower "sp" = pure (Just Shapeshifting) getPower "tb" = pure (Just Thunderbolt) getPower _ = pure Nothing -getDeity :: Monad m => ID -> m (Maybe (Deity (NamedResolverT m))) +getDeity :: (Monad m) => ID -> m (Maybe (Deity (NamedResolverT m))) getDeity uid | uid `elem` allDeities = - pure $ - Just + pure + $ Just Deity { name = resolve (getDeityName uid), power = resolve (getPowers uid), @@ -59,13 +59,13 @@ instance ResolveNamed m (Deity (NamedResolverT m)) where instance ResolveNamed m (Query (NamedResolverT m)) where type Dep (Query (NamedResolverT m)) = () resolveBatched = - ignoreBatching $ - const $ - pure - Query - { deity = \(Arg uid) -> resolve (pure uid), - deities = resolve (pure allDeities) - } + ignoreBatching + $ const + $ pure + Query + { deity = \(Arg uid) -> resolve (pure uid), + deities = resolve (pure allDeities) + } deitiesApp :: App () IO deitiesApp = deriveApp (NamedResolvers :: NamedResolvers IO () Query Undefined Undefined) diff --git a/morpheus-graphql-server/test/Feature/NamedResolvers/EntitiesApp.hs b/morpheus-graphql-server/test/Feature/NamedResolvers/EntitiesApp.hs index 6c4ecbb67a..48f09d1b50 100644 --- a/morpheus-graphql-server/test/Feature/NamedResolvers/EntitiesApp.hs +++ b/morpheus-graphql-server/test/Feature/NamedResolvers/EntitiesApp.hs @@ -46,13 +46,13 @@ instance ResolveNamed m (Entity (NamedResolverT m)) where instance ResolveNamed m (Query (NamedResolverT m)) where type Dep (Query (NamedResolverT m)) = () resolveBatched = - ignoreBatching $ - const $ - pure - Query - { entities = resolve (pure allEntities), - entity = \(Arg uid) -> resolve (pure uid) - } + ignoreBatching + $ const + $ pure + Query + { entities = resolve (pure allEntities), + entity = \(Arg uid) -> resolve (pure uid) + } entitiesApp :: App () IO entitiesApp = deriveApp (NamedResolvers :: NamedResolvers IO () Query Undefined Undefined) diff --git a/morpheus-graphql-server/test/Feature/NamedResolvers/RealmsApp.hs b/morpheus-graphql-server/test/Feature/NamedResolvers/RealmsApp.hs index 3b82d9a95f..33a0c07ac7 100644 --- a/morpheus-graphql-server/test/Feature/NamedResolvers/RealmsApp.hs +++ b/morpheus-graphql-server/test/Feature/NamedResolvers/RealmsApp.hs @@ -41,8 +41,8 @@ import Feature.NamedResolvers.Realms getRealm :: (Monad m) => ID -> m (Maybe (Realm (NamedResolverT m))) getRealm uid | uid `elem` allRealms = - pure $ - Just + pure + $ Just Realm { name = resolve (getRealmName uid), owner = resolve (getOwner uid), @@ -67,13 +67,13 @@ getDeity arg instance ResolveNamed m (Query (NamedResolverT m)) where type Dep (Query (NamedResolverT m)) = () resolveBatched = - ignoreBatching $ - const $ - pure - Query - { realm = \(Arg arg) -> resolve (pure arg), - realms = resolve (pure allRealms) - } + ignoreBatching + $ const + $ pure + Query + { realm = \(Arg arg) -> resolve (pure arg), + realms = resolve (pure allRealms) + } realmsApp :: App () IO realmsApp = diff --git a/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions.hs b/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions.hs index 67e63c2d2f..5fa0de52fb 100644 --- a/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions.hs +++ b/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions.hs @@ -93,10 +93,10 @@ instance (Show ch, Eq ch, Hashable ch) => SubApp ServerApp (Event ch con) where instance (Show ch, Eq ch, Hashable ch) => PubApp (Event ch con) where runPubApp [] app = runApp app runPubApp callbacks app = - mapAPI $ - runStreamHTTP PubContext {eventPublisher = runEvents callbacks} - . streamApp app - . Request + mapAPI + $ runStreamHTTP PubContext {eventPublisher = runEvents callbacks} + . streamApp app + . Request instance SubApp ServerApp () where runSubApp _ = diff --git a/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/Apollo.hs b/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/Apollo.hs index b4c76485c3..d55ad69680 100644 --- a/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/Apollo.hs +++ b/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/Apollo.hs @@ -91,9 +91,12 @@ instance (FromJSON a) => FromJSON (ApolloSubscription a) where where objectParser o = ApolloSubscription - <$> o .:? "id" - <*> o .: "type" - <*> o .:? "payload" + <$> o + .:? "id" + <*> o + .: "type" + <*> o + .:? "payload" data RequestPayload = RequestPayload { payloadOperationName :: Maybe FieldName, @@ -107,16 +110,20 @@ instance FromJSON RequestPayload where where objectParser o = RequestPayload - <$> o .:? "operationName" - <*> o .:? "query" - <*> o .:? "variables" + <$> o + .:? "operationName" + <*> o + .:? "query" + <*> o + .:? "variables" instance (ToJSON a) => ToJSON (ApolloSubscription a) where toEncoding (ApolloSubscription id' type' payload') = - pairs $ - encodeMaybe "id" id' - <> "type" .= type' - <> encodeMaybe "payload" payload' + pairs + $ encodeMaybe "id" id' + <> "type" + .= type' + <> encodeMaybe "payload" payload' where -- Messages should only include these fields when they have real values, -- for example the MessageAck response should only include the type and optionally @@ -131,8 +138,8 @@ acceptApolloRequest :: PendingConnection -> m Connection acceptApolloRequest pending = - liftIO $ - acceptRequestWith + liftIO + $ acceptRequestWith pending (acceptApolloSubProtocol (pendingRequest pending)) @@ -219,10 +226,10 @@ apolloFormat = validateReq . eitherDecode validateSub ApolloSubscription {apolloType = GqlComplete, apolloId} = SessionStop <$> validateSession apolloId validateSub ApolloSubscription {apolloType} = - Left $ - "Unknown Request type \"" - <> pack (unpack $ apolloResponseToProtocolMsgType apolloType) - <> "\"." + Left + $ "Unknown Request type \"" + <> pack (unpack $ apolloResponseToProtocolMsgType apolloType) + <> "\"." validateSession :: Maybe ID -> Validation ID validateSession = maybe (Left "\"id\" was not provided") Right diff --git a/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/ClientConnectionStore.hs b/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/ClientConnectionStore.hs index 00a29bb5d1..dfff489d26 100644 --- a/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/ClientConnectionStore.hs +++ b/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/ClientConnectionStore.hs @@ -202,7 +202,7 @@ data ClientConnectionStore e (m :: Type -> Type) where ClientConnectionStore (Event channel content) m deriving instance - Show e => + (Show e) => Show (ClientConnectionStore (Event e c) m) type StoreMap e m = diff --git a/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/Internal.hs b/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/Internal.hs index 7c3070f17e..c25fd1b555 100644 --- a/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/Internal.hs +++ b/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/Internal.hs @@ -85,7 +85,7 @@ import Data.Morpheus.Subscriptions.Stream import Data.UUID.V4 (nextRandom) import Relude hiding (empty, toList) -connect :: MonadIO m => m (Input SUB) +connect :: (MonadIO m) => m (Input SUB) connect = InitConnection <$> liftIO nextRandom disconnect :: ApiContext SUB e m -> Input SUB -> m () @@ -128,7 +128,7 @@ initDefaultStore = do writeStore = \changes -> liftIO $ modifyMVar_ store (return . changes) } -finallyM :: MonadUnliftIO m => m () -> m () -> m () +finallyM :: (MonadUnliftIO m) => m () -> m () -> m () finallyM loop end = withRunInIO $ \runIO -> finally (runIO loop) (runIO end) connectionThread :: diff --git a/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/Stream.hs b/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/Stream.hs index 60cd00d489..deefe65aff 100644 --- a/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/Stream.hs +++ b/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/Stream.hs @@ -158,11 +158,11 @@ handleWSRequest gqlApp clientId = handle . apolloFormat handleAction (SessionStart sessionId request) = handleResponseStream (SessionID clientId sessionId) (gqlApp request) handleAction (SessionStop sessionId) = - liftWS $ - Right [WSUpdate $ endSession (SessionID clientId sessionId)] + liftWS + $ Right [WSUpdate $ endSession (SessionID clientId sessionId)] liftWS :: - Applicative m => + (Applicative m) => Either ByteString [WSOutputEvent e m] -> Output SUB e m liftWS = SubOutput . const . pure diff --git a/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/WebSockets.hs b/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/WebSockets.hs index 2d783c883f..2ae5d68ad0 100644 --- a/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/WebSockets.hs +++ b/morpheus-graphql-subscriptions/src/Data/Morpheus/Subscriptions/WebSockets.hs @@ -43,7 +43,7 @@ pingThread connection = WS.withPingThread connection 30 (return ()) pingThread connection = (WS.forkPingThread connection 30 >>) #endif -defaultWSScope :: MonadIO m => Store e m -> Connection -> ApiContext SUB e m +defaultWSScope :: (MonadIO m) => Store e m -> Connection -> ApiContext SUB e m defaultWSScope Store {writeStore} connection = SubContext { listener = liftIO (receiveData connection), @@ -57,10 +57,10 @@ webSocketsWrapper :: (ApiContext SUB e m -> m ()) -> m ServerApp webSocketsWrapper store handler = - withRunInIO $ - \runIO -> - pure $ - \pending -> do + withRunInIO + $ \runIO -> + pure + $ \pending -> do conn <- acceptApolloRequest pending pingThread conn diff --git a/morpheus-graphql-tests/src/Test/Morpheus.hs b/morpheus-graphql-tests/src/Test/Morpheus.hs index 5fc71565a0..fa3de04188 100644 --- a/morpheus-graphql-tests/src/Test/Morpheus.hs +++ b/morpheus-graphql-tests/src/Test/Morpheus.hs @@ -46,8 +46,8 @@ import Test.Tasty.HUnit mainTest :: String -> [IO TestTree] -> IO () mainTest name xs = do tests <- sequence xs - defaultMain $ - testGroup + defaultMain + $ testGroup name tests diff --git a/morpheus-graphql-tests/src/Test/Morpheus/File.hs b/morpheus-graphql-tests/src/Test/Morpheus/File.hs index 2ef4cf3073..cb271697ef 100644 --- a/morpheus-graphql-tests/src/Test/Morpheus/File.hs +++ b/morpheus-graphql-tests/src/Test/Morpheus/File.hs @@ -26,7 +26,7 @@ import Relude hiding (ByteString) import System.Directory (doesDirectoryExist, listDirectory) class ReadSource t where - readSource :: ToString name => name -> IO t + readSource :: (ToString name) => name -> IO t instance ReadSource Text where readSource = T.readFile . toString @@ -34,15 +34,15 @@ instance ReadSource Text where instance ReadSource ByteString where readSource = L.readFile . toString -withSource :: ReadSource t => (String, String) -> FileUrl -> IO t +withSource :: (ReadSource t) => (String, String) -> FileUrl -> IO t withSource (name, format) url | isDir url = readSource $ toString url <> "/" <> name <> "." <> format | otherwise = readSource $ toString url <> "." <> format -readGQL :: ReadSource t => String -> FileUrl -> IO t +readGQL :: (ReadSource t) => String -> FileUrl -> IO t readGQL x = withSource (x, "gql") -readJSON :: ReadSource t => String -> FileUrl -> IO t +readJSON :: (ReadSource t) => String -> FileUrl -> IO t readJSON x = withSource (x, "json") data FileUrl = FileUrl diff --git a/morpheus-graphql-tests/src/Test/Morpheus/JSONDiff.hs b/morpheus-graphql-tests/src/Test/Morpheus/JSONDiff.hs index 2f290cb000..0c64f52211 100644 --- a/morpheus-graphql-tests/src/Test/Morpheus/JSONDiff.hs +++ b/morpheus-graphql-tests/src/Test/Morpheus/JSONDiff.hs @@ -36,7 +36,7 @@ instance Show Diff where <> "but it is:" <> showLeaf y -showLeaf :: ToJSON a => a -> [Char] +showLeaf :: (ToJSON a) => a -> [Char] showLeaf x = " " <> unpack (encode x) <> "\n" unescape :: String -> String @@ -79,7 +79,7 @@ uniq (x : xs) | isJust (find (== x) xs) = uniq xs | otherwise = x : uniq xs -jsonEQ :: ToJSON a => a -> a -> IO () +jsonEQ :: (ToJSON a) => a -> a -> IO () jsonEQ expected actual = case diff (toJSON expected, toJSON actual) of Just x -> assertFailure $ indent $ "\n" <> show x <> "\n" Nothing -> pure () diff --git a/morpheus-graphql-tests/src/Test/Morpheus/Response.hs b/morpheus-graphql-tests/src/Test/Morpheus/Response.hs index c3c9a287c9..376bcb5b5e 100644 --- a/morpheus-graphql-tests/src/Test/Morpheus/Response.hs +++ b/morpheus-graphql-tests/src/Test/Morpheus/Response.hs @@ -37,15 +37,15 @@ data CaseAssertion a | Expected a deriving (Generic, Eq) -instance FromJSON a => FromJSON (CaseAssertion a) where +instance (FromJSON a) => FromJSON (CaseAssertion a) where parseJSON (String "OK") = pure OK parseJSON v = Expected <$> parseJSON v -instance ToJSON a => ToJSON (CaseAssertion a) where +instance (ToJSON a) => ToJSON (CaseAssertion a) where toJSON OK = String "OK" toJSON (Expected v) = toJSON v -getResponse :: FromJSON a => FileUrl -> IO (CaseAssertion a) +getResponse :: (FromJSON a) => FileUrl -> IO (CaseAssertion a) getResponse = readJSON "response" >=> either fail pure . eitherDecode assertResponse :: @@ -70,16 +70,16 @@ getQuery url = do mkQuery :: (FromJSON a) => Value -> Maybe Value -> IO a mkQuery query variables = - runResult $ - fromJSON $ - object - [ "query" .= query, - "variables" .= variables - ] + runResult + $ fromJSON + $ object + [ "query" .= query, + "variables" .= variables + ] -fromEither :: ToJSON err => Either err a -> CaseAssertion err +fromEither :: (ToJSON err) => Either err a -> CaseAssertion err fromEither (Left err) = Expected err fromEither Right {} = OK -expects :: ToJSON a => a -> CaseAssertion Value +expects :: (ToJSON a) => a -> CaseAssertion Value expects = Expected . toJSON diff --git a/morpheus-graphql-tests/src/Test/Morpheus/Utils.hs b/morpheus-graphql-tests/src/Test/Morpheus/Utils.hs index c4129f130f..07610cec62 100644 --- a/morpheus-graphql-tests/src/Test/Morpheus/Utils.hs +++ b/morpheus-graphql-tests/src/Test/Morpheus/Utils.hs @@ -88,17 +88,18 @@ requireEq f expected actual eqFailureMessage :: ByteString -> ByteString -> IO a3 eqFailureMessage expected actual = - assertFailure $ - L.unpack $ - "expected: \n\n " - <> expected - <> " \n\n but got: \n\n " - <> actual + assertFailure + $ L.unpack + $ "expected: \n\n " + <> expected + <> " \n\n but got: \n\n " + <> actual getSchema :: (ReadSource a, Show err) => (a -> Either err b) -> FileUrl -> IO b getSchema f url = readSchemaFile url - >>= assertValidSchema . f + >>= assertValidSchema + . f assertValidSchema :: (Show err) => Either err a -> IO a assertValidSchema = diff --git a/morpheus-graphql/src/Data/Morpheus/Types.hs b/morpheus-graphql/src/Data/Morpheus/Types.hs index f0be561578..8e6d5b349f 100644 --- a/morpheus-graphql/src/Data/Morpheus/Types.hs +++ b/morpheus-graphql/src/Data/Morpheus/Types.hs @@ -113,5 +113,5 @@ import Data.Morpheus.Server.Types import Data.Morpheus.Types.Internal.AST (GQLError) import Relude hiding (Undefined) -liftEither :: (MonadTrans t, Monad (t m), MonadError GQLError (t m)) => Monad m => m (Either String a) -> t m a +liftEither :: (MonadTrans t, Monad (t m), MonadError GQLError (t m)) => (Monad m) => m (Either String a) -> t m a liftEither x = lift x >>= either (throwError . fromString) pure diff --git a/morpheus-graphql/test/Feature/Holistic/API.hs b/morpheus-graphql/test/Feature/Holistic/API.hs index abed72b712..2bad9f71a8 100644 --- a/morpheus-graphql/test/Feature/Holistic/API.hs +++ b/morpheus-graphql/test/Feature/Holistic/API.hs @@ -127,7 +127,7 @@ root = } } where - queryUser :: Applicative m => m (User m) + queryUser :: (Applicative m) => m (User m) queryUser = pure User @@ -138,7 +138,7 @@ root = userFriend = pure Nothing } ----------------------------------------------------- - resolveAddress :: Applicative m => a -> m (Address m) + resolveAddress :: (Applicative m) => a -> m (Address m) resolveAddress _ = pure Address diff --git a/morpheus-graphql/test/Feature/Input/DefaultValues.hs b/morpheus-graphql/test/Feature/Input/DefaultValues.hs index 14554feed5..7951470781 100644 --- a/morpheus-graphql/test/Feature/Input/DefaultValues.hs +++ b/morpheus-graphql/test/Feature/Input/DefaultValues.hs @@ -37,13 +37,13 @@ rootResolver = { queryResolver = Query {user, testSimple} } where - user :: Applicative m => m (Maybe (User m)) + user :: (Applicative m) => m (Maybe (User m)) user = - pure $ - Just $ - User - { inputs = pure . pack . show - } + pure + $ Just + $ User + { inputs = pure . pack . show + } testSimple = pure . pack . show ----------------------------------- diff --git a/morpheus-graphql/test/Subscription/API.hs b/morpheus-graphql/test/Subscription/API.hs index 4b93b01da5..ed488ae56f 100644 --- a/morpheus-graphql/test/Subscription/API.hs +++ b/morpheus-graphql/test/Subscription/API.hs @@ -47,7 +47,7 @@ importGQLDocument "test/Subscription/schema.gql" type EVENT = Event Channel Info -character :: Applicative m => m (Character m) +character :: (Applicative m) => m (Character m) character = pure Character @@ -55,7 +55,7 @@ character = age = pure 1 } -characterSub :: Applicative m => EVENT -> m (Character m) +characterSub :: (Applicative m) => EVENT -> m (Character m) characterSub (Event _ Info {name, age}) = pure Character diff --git a/morpheus-graphql/test/Subscription/Case/Publishing.hs b/morpheus-graphql/test/Subscription/Case/Publishing.hs index af8747e1cb..f0afa4bb74 100644 --- a/morpheus-graphql/test/Subscription/Case/Publishing.hs +++ b/morpheus-graphql/test/Subscription/Case/Publishing.hs @@ -78,8 +78,8 @@ triggerSubscription = do SimulationState {inputs, outputs, store} <- simulatePublish (Event [DEITY] Info {name = "Zeus", age = 1200}) state >>= simulatePublish (Event [HUMAN] Info {name = "Hercules", age = 18}) - pure $ - testGroup + pure + $ testGroup "publish event" [ inputsAreConsumed inputs, testResponse diff --git a/morpheus-graphql/test/Subscription/Utils.hs b/morpheus-graphql/test/Subscription/Utils.hs index a4255b1876..296e218b45 100644 --- a/morpheus-graphql/test/Subscription/Utils.hs +++ b/morpheus-graphql/test/Subscription/Utils.hs @@ -150,35 +150,35 @@ storeIsEmpty cStore | null (toList cStore) = testCase "connectionStore: is empty" $ pure () | otherwise = - testCase "connectionStore: is empty" $ - assertFailure $ - " must be empty but " - <> show - cStore + testCase "connectionStore: is empty" + $ assertFailure + $ " must be empty but " + <> show + cStore storedSingle :: (Show ch) => Store (Event ch con) -> TestTree storedSingle cStore | length (toList cStore) == 1 = testCase "stored single connection" $ pure () | otherwise = - testCase "stored single connection" $ - assertFailure $ - "connectionStore must store single connection, but stored: " - <> show - cStore + testCase "stored single connection" + $ assertFailure + $ "connectionStore must store single connection, but stored: " + <> show + cStore stored :: (Show ch) => Input SUB -> Store (Event ch con) -> TestTree stored (InitConnection uuid) cStore | isJust (lookup uuid (toList cStore)) = testCase "stored connection" $ pure () | otherwise = - testCase "stored connection" $ - assertFailure $ - " must store connection \"" - <> show uuid - <> "\" but stored: " - <> show - cStore + testCase "stored connection" + $ assertFailure + $ " must store connection \"" + <> show uuid + <> "\" but stored: " + <> show + cStore storeSubscriptions :: (Show ch) => @@ -196,21 +196,21 @@ storeSubscriptions | sort sids == sort (connectionSessionIds conn) = testCase "stored subscriptions" $ pure () | otherwise = - testCase "stored subscriptions" $ - assertFailure $ - " must store subscriptions with id \"" - <> show sids - <> "\" but stored: " - <> show - (connectionSessionIds conn) - checkSession _ = - testCase "stored connection" $ - assertFailure $ - " must store connection \"" - <> show uuid - <> "\" but: " + testCase "stored subscriptions" + $ assertFailure + $ " must store subscriptions with id \"" + <> show sids + <> "\" but stored: " <> show - cStore + (connectionSessionIds conn) + checkSession _ = + testCase "stored connection" + $ assertFailure + $ " must store connection \"" + <> show uuid + <> "\" but: " + <> show + cStore apolloStart :: ByteString -> ByteString -> ByteString apolloStart query sid = diff --git a/package-lock.json b/package-lock.json index 757fb9a119..bd14653e0b 100644 --- a/package-lock.json +++ b/package-lock.json @@ -9,13 +9,9 @@ "version": "1.0.0", "license": "MIT", "dependencies": { - "@actions/core": "^1.9.1", - "axios": "^0.26.1", "commander": "^9.1.0", "gh-rel-easy": "^0.3.0", "glob": "^8.0.3", - "js-yaml": "^4.1.0", - "ramda": "^0.28.0", "ts-node": "^10.7.0", "typescript": "^4.6.2" }, @@ -26,23 +22,6 @@ "cspell": "^6.31.1" } }, - "node_modules/@actions/core": { - "version": "1.9.1", - "resolved": "https://registry.npmjs.org/@actions/core/-/core-1.9.1.tgz", - "integrity": "sha512-5ad+U2YGrmmiw6du20AQW5XuWo7UKN2052FjSV7MX+Wfjf8sCqcsZe62NfgHys4QI4/Y+vQvLKYL8jWtA1ZBTA==", - "dependencies": { - "@actions/http-client": "^2.0.1", - "uuid": "^8.3.2" - } - }, - "node_modules/@actions/http-client": { - "version": "2.0.1", - "resolved": "https://registry.npmjs.org/@actions/http-client/-/http-client-2.0.1.tgz", - "integrity": "sha512-PIXiMVtz6VvyaRsGY268qvj57hXQEpsYogYOu2nrQhlf+XCGmZstmuZBbAybUl1nQGnvS1k1eEsQ69ZoD7xlSw==", - "dependencies": { - "tunnel": "^0.0.6" - } - }, "node_modules/@babel/code-frame": { "version": "7.21.4", "resolved": "https://registry.npmjs.org/@babel/code-frame/-/code-frame-7.21.4.tgz", @@ -1922,14 +1901,6 @@ "integrity": "sha512-FZIXf1ksVyLcfr7M317jbB67XFJhOO1YqdTcuGaq9q5jLUoTikukZ+98TPjKiP2jC5CgmYdWWYs0s2nLSU0/1A==", "dev": true }, - "node_modules/tunnel": { - "version": "0.0.6", - "resolved": "https://registry.npmjs.org/tunnel/-/tunnel-0.0.6.tgz", - "integrity": "sha512-1h/Lnq9yajKY2PEbBadPXj3VxsDDu844OnaAo52UVmIzIvwwtBPIuNvkjuzBlTWpfJyUbG3ez0KSBibQkj4ojg==", - "engines": { - "node": ">=0.6.11 <=0.7.0 || >=0.7.3" - } - }, "node_modules/typedarray-to-buffer": { "version": "3.1.5", "resolved": "https://registry.npmjs.org/typedarray-to-buffer/-/typedarray-to-buffer-3.1.5.tgz", @@ -1963,14 +1934,6 @@ "node": ">=8" } }, - "node_modules/uuid": { - "version": "8.3.2", - "resolved": "https://registry.npmjs.org/uuid/-/uuid-8.3.2.tgz", - "integrity": "sha512-+NYs2QeMWy+GWFOEm9xnn6HCDp0l7QBD7ml8zLUmJ+93Q5NF0NocErnwkTkXVFNiX3/fpC6afS8Dhb/gz7R7eg==", - "bin": { - "uuid": "dist/bin/uuid" - } - }, "node_modules/v8-compile-cache-lib": { "version": "3.0.0", "resolved": "https://registry.npmjs.org/v8-compile-cache-lib/-/v8-compile-cache-lib-3.0.0.tgz", @@ -2058,23 +2021,6 @@ } }, "dependencies": { - "@actions/core": { - "version": "1.9.1", - "resolved": "https://registry.npmjs.org/@actions/core/-/core-1.9.1.tgz", - "integrity": "sha512-5ad+U2YGrmmiw6du20AQW5XuWo7UKN2052FjSV7MX+Wfjf8sCqcsZe62NfgHys4QI4/Y+vQvLKYL8jWtA1ZBTA==", - "requires": { - "@actions/http-client": "^2.0.1", - "uuid": "^8.3.2" - } - }, - "@actions/http-client": { - "version": "2.0.1", - "resolved": "https://registry.npmjs.org/@actions/http-client/-/http-client-2.0.1.tgz", - "integrity": "sha512-PIXiMVtz6VvyaRsGY268qvj57hXQEpsYogYOu2nrQhlf+XCGmZstmuZBbAybUl1nQGnvS1k1eEsQ69ZoD7xlSw==", - "requires": { - "tunnel": "^0.0.6" - } - }, "@babel/code-frame": { "version": "7.21.4", "resolved": "https://registry.npmjs.org/@babel/code-frame/-/code-frame-7.21.4.tgz", @@ -3536,11 +3482,6 @@ "integrity": "sha512-FZIXf1ksVyLcfr7M317jbB67XFJhOO1YqdTcuGaq9q5jLUoTikukZ+98TPjKiP2jC5CgmYdWWYs0s2nLSU0/1A==", "dev": true }, - "tunnel": { - "version": "0.0.6", - "resolved": "https://registry.npmjs.org/tunnel/-/tunnel-0.0.6.tgz", - "integrity": "sha512-1h/Lnq9yajKY2PEbBadPXj3VxsDDu844OnaAo52UVmIzIvwwtBPIuNvkjuzBlTWpfJyUbG3ez0KSBibQkj4ojg==" - }, "typedarray-to-buffer": { "version": "3.1.5", "resolved": "https://registry.npmjs.org/typedarray-to-buffer/-/typedarray-to-buffer-3.1.5.tgz", @@ -3564,11 +3505,6 @@ "crypto-random-string": "^2.0.0" } }, - "uuid": { - "version": "8.3.2", - "resolved": "https://registry.npmjs.org/uuid/-/uuid-8.3.2.tgz", - "integrity": "sha512-+NYs2QeMWy+GWFOEm9xnn6HCDp0l7QBD7ml8zLUmJ+93Q5NF0NocErnwkTkXVFNiX3/fpC6afS8Dhb/gz7R7eg==" - }, "v8-compile-cache-lib": { "version": "3.0.0", "resolved": "https://registry.npmjs.org/v8-compile-cache-lib/-/v8-compile-cache-lib-3.0.0.tgz", diff --git a/package.json b/package.json index 0f3f5af10e..1d617ac8fd 100644 --- a/package.json +++ b/package.json @@ -8,10 +8,7 @@ "private": true, "scripts": { "check:spelling": "cspell --cache --no-progress '**/*.hs'", - "changelog": "npm run release changelog", - "release": "ts-node scripts/cli.ts release", - "format": "ts-node scripts/cli.ts format", - "format:fix": "ts-node scripts/cli.ts format --fix=true", + "release": "ts-node scripts/release.ts", "code-gen": "morpheus build morpheus-graphql-server/test examples/code-gen examples/code-gen-docs", "code-gen:check": "morpheus check morpheus-graphql-server/test examples/code-gen examples/code-gen-docs", "lint": "curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s .", @@ -24,13 +21,9 @@ "cspell": "^6.31.1" }, "dependencies": { - "@actions/core": "^1.9.1", - "axios": "^0.26.1", "commander": "^9.1.0", "gh-rel-easy": "^0.3.0", "glob": "^8.0.3", - "js-yaml": "^4.1.0", - "ramda": "^0.28.0", "ts-node": "^10.7.0", "typescript": "^4.6.2" } diff --git a/scripts/cli.ts b/scripts/cli.ts deleted file mode 100644 index 78d5290373..0000000000 --- a/scripts/cli.ts +++ /dev/null @@ -1,71 +0,0 @@ -import { exit, hconf, write } from "./utils"; - -import { Command } from "commander"; -import { format } from "./format"; -import { GHRelEasy } from "gh-rel-easy"; - -const cli = new Command(); - -cli.name("cli").description("cli").version("0.0.0"); - -const scope: Record = { - server: "morpheus-graphql", - client: "morpheus-graphql-client", - core: "morpheus-graphql-core", - subscriptions: "morpheus-graphql-subscriptions", - tests: "morpheus-graphql-tests", - app: "morpheus-graphql-app", -}; - -const relEasy = new GHRelEasy({ - pkg: (name) => `https://hackage.haskell.org/package/${scope[name]}`, - gh: { - org: "morpheusgraphql", - repo: "morpheus-graphql", - }, - scope, - pr: { - major: "Major Change", - breaking: "Breaking Change", - feature: "New features", - fix: "Bug Fixes", - chore: "Minor Changes", - }, - version: () => hconf("version"), - next: async (isBreaking) => { - await hconf("next", ...(isBreaking ? ["-b"] : [])); - - return hconf("version"); - }, -}); - -cli - .command("format") - .description("format") - .option("--fix ", "fix", false) - .option("--path ", "path", "./morpheus-graphql*/**/*.hs") - .action(format); - -const release = cli.command("release"); - -release - .command("open") - .option("-p, --preview", "preview", false) - .action(({ preview }: { preview: string }) => - relEasy - .changelog() - .then(async (body) => { - await hconf("setup"); - - if (preview) return; - - await relEasy.open(body); - }) - .catch(exit) - ); - -release - .command("changelog") - .action(() => relEasy.changelog().then(write("changelog.md")).catch(exit)); - -cli.parse(); diff --git a/scripts/format.ts b/scripts/format.ts deleted file mode 100644 index e77b2d26c5..0000000000 --- a/scripts/format.ts +++ /dev/null @@ -1,62 +0,0 @@ -import glob from "glob"; -import { exit } from "process"; -import { promisify } from "util"; -import { exec, log } from "./utils"; - -const config: Record = { - linux: "/ormolu-Linux.zip", - win32: "/ormolu-Windows.zip", - darwin: "/ormolu-macOS.zip", -}; - -export const platform = process.platform ?? config.linux; - -type Ops = { fileName: string; url: string }; - -export const run = async ( - f: (bin: string) => Promise, - { fileName, url }: Ops -) => { - const dir = `__${fileName}__`; - const bin = `./${dir}/${fileName}`; - - try { - exec(`mkdir ${dir}`); - } catch {} - - try { - log(`setup ${fileName} ... \n`); - exec(`curl -o ${bin}.zip -LO ${url}`, "pipe"); - exec(`cd ${dir} && unzip ${fileName}.zip`, "pipe"); - exec(`chmod +x ${bin}`, "pipe"); - await f(bin); - log("OK\n", "success"); - } catch (e) { - log(e.message + "\n", "error"); - exec(`rm -rf ${dir}`); - exit(1); - } - exec(`rm -rf ${dir}`); -}; - -export const format = async ({ fix, path }: { fix: boolean; path: string }) => - run( - async (bin) => { - const files = await promisify(glob)(path); - log(`formatting(${files.length} files): ${path} \n\n`); - - if (fix) { - exec(`${bin} --color=always --mode=inplace ${files.join(" ")}`); - } else { - exec( - `${bin} --color=always --check-idempotence --mode=check ${files.join( - " " - )}` - ); - } - }, - { - fileName: "ormolu", - url: `https://github.com/tweag/ormolu/releases/download/0.5.0.1/${config[platform]}`, - } - ); diff --git a/scripts/release.ts b/scripts/release.ts new file mode 100644 index 0000000000..93b5114c80 --- /dev/null +++ b/scripts/release.ts @@ -0,0 +1,88 @@ +import { writeFile } from "fs/promises"; +import { GHRelEasy } from "gh-rel-easy"; +import { exec } from "child_process"; +import { promisify } from "node:util"; +import { Command } from "commander"; + +export const exit = (error: Error) => { + console.error(error.message); + process.exit(1); +}; + +const BUFFER = 10 * 1024 * 1024; + +// HCONF +const hconf = async (cmd: "version" | "next" | "setup", ...ops: string[]) => { + const { stdout } = await promisify(exec)( + ["hconf", cmd, ops].flat().join(" "), + { maxBuffer: BUFFER, encoding: "utf-8" } + ); + + if (cmd !== "version") { + console.log(stdout); + } + + return stdout.trim(); +}; + +// GHRelEasy +const version = () => hconf("version"); + +const next = (isBreaking: boolean) => + hconf("next", ...(isBreaking ? ["-b"] : [])).then(version); + +const pkg = (name: string) => + `https://hackage.haskell.org/package/${scope[name]}`; + +const scope: Record = { + server: "morpheus-graphql", + client: "morpheus-graphql-client", + core: "morpheus-graphql-core", + subscriptions: "morpheus-graphql-subscriptions", + tests: "morpheus-graphql-tests", + app: "morpheus-graphql-app", +}; + +const release = new GHRelEasy({ + gh: { + org: "morpheusgraphql", + repo: "morpheus-graphql", + }, + pr: { + major: "Major Change", + breaking: "Breaking Change", + feature: "New features", + fix: "Bug Fixes", + chore: "Minor Changes", + }, + scope, + version, + next, + pkg, +}); + +// CLI +const cli = new Command(); + +cli.name("release-cli").description("Automated Releases").version("1.0"); + +cli + .command("open") + .option("-p, --preview", "preview", false) + .action(({ preview }: { preview: boolean }) => + release + .changelog() + .then((body) => + hconf("setup").then(() => (preview ? undefined : release.open(body))) + ) + .catch(exit) + ); + +cli.command("changelog").action(() => + release + .changelog() + .then((body: string) => writeFile("./changelog.md", body, "utf8")) + .catch(exit) +); + +cli.parse(); diff --git a/scripts/utils.ts b/scripts/utils.ts deleted file mode 100644 index 14970aba1c..0000000000 --- a/scripts/utils.ts +++ /dev/null @@ -1,43 +0,0 @@ -import { execSync, StdioOptions } from "child_process"; -import { writeFile } from "fs/promises"; -import { dirname, join } from "path"; -import * as core from "@actions/core"; - -export const exit = (error: Error) => { - core.setFailed(error); - console.error(error); - process.exit(1); -}; - -export const exec = (command: string, stdio?: StdioOptions) => - execSync(command, { - maxBuffer: 10 * 1024 * 1024, // 10MB - encoding: "utf-8", - stdio, - })?.trimEnd(); - -const colors = { - error: "\x1b[31m", - success: "\x1b[32m", - warning: "\x1b[33m", - none: "\x1b[0m", -}; - -export const log = (t: string, type?: "success" | "warning" | "error") => - process.stdout.write(colors[type ?? "none"] + t + colors.none); - -export const hconf = async ( - cmd: "version" | "setup" | "next", - ...ops: string[] -): Promise => { - const result = exec(["hconf", [cmd, ops].flat().join(" ")].join(" ")); - - if (cmd !== "version") { - console.log(result); - } - - return Promise.resolve(result); -}; - -export const write = (p: string) => (f: string) => - writeFile(join(dirname(require.main?.filename ?? ""), "../", p), f, "utf8");