mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-20 22:11:45 +03:00
aa18f65217
It's about time. To do this I had to check a few more boxes. * I copied the flags from `graphql-engine.cabal` to the libraries in `server/lib`. * I moved `Cacheable` instances of schema parser types beside the typeclass declaration. * I removed imports of `Hasura.Prelude` from the tests, and rewrote them accordingly. * I copied the `TestMonad` parse monad into `server/src-test/Hasura/GraphQL/Schema/RemoteTest.hs`, which was using it. I think this could be done with the real thing, but I tried replacing it with constraints and it messed with my head somewhat. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5311 GitOrigin-RevId: ebebcc50a16f2d517b7f730fe72410827ca3e86c
56 lines
1.8 KiB
Haskell
56 lines
1.8 KiB
Haskell
module Hasura.GraphQL.Parser.TestUtils
|
|
( TestMonad (..),
|
|
fakeScalar,
|
|
fakeInputFieldValue,
|
|
fakeDirective,
|
|
)
|
|
where
|
|
|
|
import Data.Functor ((<&>))
|
|
import Data.HashMap.Strict qualified as M
|
|
import Data.List.NonEmpty qualified as NE
|
|
import Hasura.Base.ErrorMessage (ErrorMessage)
|
|
import Hasura.GraphQL.Parser
|
|
import Hasura.GraphQL.Parser.Name qualified as GName
|
|
import Language.GraphQL.Draft.Syntax qualified as G
|
|
|
|
-- test monad
|
|
|
|
newtype TestMonad a = TestMonad {runTest :: Either ErrorMessage a}
|
|
deriving newtype (Functor, Applicative, Monad)
|
|
|
|
instance MonadParse TestMonad where
|
|
withKey = const id
|
|
parseErrorWith = const $ TestMonad . Left
|
|
|
|
-- values generation
|
|
|
|
fakeScalar :: G.Name -> G.Value Variable
|
|
fakeScalar name =
|
|
if
|
|
| name == GName._Int -> G.VInt 4242
|
|
| name == GName._Boolean -> G.VBoolean False
|
|
| otherwise -> error $ "no test value implemented for scalar " <> show name
|
|
|
|
fakeInputFieldValue :: forall origin. InputFieldInfo origin -> G.Value Variable
|
|
fakeInputFieldValue (InputFieldInfo t _) = go t
|
|
where
|
|
go :: forall k. ('Input <: k) => Type origin k -> G.Value Variable
|
|
go = \case
|
|
TList _ t' -> G.VList [go t', go t']
|
|
TNamed _ (Definition name _ _ _ info) -> case (info, subKind @'Input @k) of
|
|
(TIScalar, _) -> fakeScalar name
|
|
(TIEnum ei, _) -> G.VEnum $ G.EnumValue $ dName $ NE.head ei
|
|
(TIInputObject (InputObjectInfo oi), _) -> G.VObject $
|
|
M.fromList $ do
|
|
Definition fieldName _ _ _ fieldInfo <- oi
|
|
pure (fieldName, fakeInputFieldValue fieldInfo)
|
|
_ -> error "fakeInputFieldValue: non-exhaustive. FIXME"
|
|
|
|
fakeDirective :: DirectiveInfo origin -> G.Directive Variable
|
|
fakeDirective DirectiveInfo {..} =
|
|
G.Directive diName $
|
|
M.fromList $
|
|
diArguments <&> \(Definition argName _ _ _ argInfo) ->
|
|
(argName, fakeInputFieldValue argInfo)
|