{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Test.Morpheus
( FileUrl,
mkUrl,
cd,
file,
deepScan,
scan,
getAppsBy,
testApi,
testSchema,
testQueryRendering,
renderingAssertion,
testQuery,
testQueryValidation,
mainTest,
)
where
import Data.Aeson
( FromJSON (..),
ToJSON (..),
encode,
)
import Data.ByteString.Lazy.Char8 (ByteString)
import Relude hiding (ByteString)
import Test.Morpheus.File
import Test.Morpheus.Response
import Test.Morpheus.Utils
import Test.Tasty
( TestTree,
defaultMain,
testGroup,
)
import Test.Tasty.HUnit
( assertFailure,
testCase,
)
mainTest :: String -> [IO TestTree] -> IO ()
mainTest :: String -> [IO TestTree] -> IO ()
mainTest String
name [IO TestTree]
xs = do
[TestTree]
tests <- [IO TestTree] -> IO [TestTree]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [IO TestTree]
xs
TestTree -> IO ()
defaultMain (TestTree -> IO ()) -> TestTree -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> [TestTree] -> TestTree
testGroup
String
name
[TestTree]
tests
testApi ::
(FromJSON req, ToJSON res) =>
(req -> IO res) ->
FileUrl ->
TestTree
testApi :: (req -> IO res) -> FileUrl -> TestTree
testApi req -> IO res
api =
(FileUrl -> IO (CaseAssertion Value)) -> FileUrl -> TestTree
forall a.
(FromJSON a, Eq a, ToJSON a) =>
(FileUrl -> IO (CaseAssertion a)) -> FileUrl -> TestTree
assertResponse
((res -> CaseAssertion Value) -> IO res -> IO (CaseAssertion Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap res -> CaseAssertion Value
forall a. ToJSON a => a -> CaseAssertion Value
expects (IO res -> IO (CaseAssertion Value))
-> (req -> IO res) -> req -> IO (CaseAssertion Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. req -> IO res
api (req -> IO (CaseAssertion Value))
-> (FileUrl -> IO req) -> FileUrl -> IO (CaseAssertion Value)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< FileUrl -> IO req
forall req. FromJSON req => FileUrl -> IO req
getQuery)
testQuery ::
(FromJSON req, ToJSON err, Eq err, FromJSON err) =>
(req -> Either err a) ->
FileUrl ->
TestTree
testQuery :: (req -> Either err a) -> FileUrl -> TestTree
testQuery req -> Either err a
f =
(FileUrl -> IO (CaseAssertion err)) -> FileUrl -> TestTree
forall a.
(FromJSON a, Eq a, ToJSON a) =>
(FileUrl -> IO (CaseAssertion a)) -> FileUrl -> TestTree
assertResponse
((req -> CaseAssertion err) -> IO req -> IO (CaseAssertion err)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either err a -> CaseAssertion err
forall err a. ToJSON err => Either err a -> CaseAssertion err
fromEither (Either err a -> CaseAssertion err)
-> (req -> Either err a) -> req -> CaseAssertion err
forall b c a. (b -> c) -> (a -> b) -> a -> c
. req -> Either err a
f) (IO req -> IO (CaseAssertion err))
-> (FileUrl -> IO req) -> FileUrl -> IO (CaseAssertion err)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileUrl -> IO req
forall req. FromJSON req => FileUrl -> IO req
getQuery)
testSchema ::
(ToJSON err, Eq err, FromJSON err) =>
(ByteString -> Either err a) ->
FileUrl ->
TestTree
testSchema :: (ByteString -> Either err a) -> FileUrl -> TestTree
testSchema ByteString -> Either err a
f =
(FileUrl -> IO (CaseAssertion err)) -> FileUrl -> TestTree
forall a.
(FromJSON a, Eq a, ToJSON a) =>
(FileUrl -> IO (CaseAssertion a)) -> FileUrl -> TestTree
assertResponse
((ByteString -> CaseAssertion err)
-> IO ByteString -> IO (CaseAssertion err)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either err a -> CaseAssertion err
forall err a. ToJSON err => Either err a -> CaseAssertion err
fromEither (Either err a -> CaseAssertion err)
-> (ByteString -> Either err a) -> ByteString -> CaseAssertion err
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either err a
f) (IO ByteString -> IO (CaseAssertion err))
-> (FileUrl -> IO ByteString) -> FileUrl -> IO (CaseAssertion err)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileUrl -> IO ByteString
forall t. ReadSource t => FileUrl -> IO t
readSchemaFile)
renderingAssertion ::
(ToJSON e) =>
(FileUrl -> IO (Either e ByteString)) ->
FileUrl ->
TestTree
renderingAssertion :: (FileUrl -> IO (Either e ByteString)) -> FileUrl -> TestTree
renderingAssertion FileUrl -> IO (Either e ByteString)
api FileUrl
url = String -> IO () -> TestTree
testCase (FileUrl -> String
fileName FileUrl
url) (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ do
Either e ByteString
actual <- FileUrl -> IO (Either e ByteString)
api FileUrl
url
ByteString
expected <- String -> FileUrl -> IO ByteString
forall t. ReadSource t => String -> FileUrl -> IO t
readGQL String
"rendering" FileUrl
url
(e -> IO ())
-> (ByteString -> IO ()) -> Either e ByteString -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(String -> IO ()
forall a. HasCallStack => String -> IO a
assertFailure (String -> IO ()) -> (e -> String) -> e -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String) -> (e -> String) -> e -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
forall b a. (Show a, IsString b) => a -> b
show (ByteString -> String) -> (e -> ByteString) -> e -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ByteString
forall a. ToJSON a => a -> ByteString
encode)
((ByteString -> ByteString) -> ByteString -> ByteString -> IO ()
forall t. Eq t => (t -> ByteString) -> t -> t -> IO ()
requireEq ByteString -> ByteString
forall a. a -> a
id ByteString
expected)
Either e ByteString
actual
getAppBy ::
(Show err, FromJSON resolvers) =>
( ByteString -> Either err schema,
schema -> resolvers -> app
) ->
FileUrl ->
IO app
getAppBy :: (ByteString -> Either err schema, schema -> resolvers -> app)
-> FileUrl -> IO app
getAppBy (ByteString -> Either err schema
parseSchema, schema -> resolvers -> app
mkApp) FileUrl
url =
schema -> resolvers -> app
mkApp
(schema -> resolvers -> app) -> IO schema -> IO (resolvers -> app)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Either err schema) -> FileUrl -> IO schema
forall a err b.
(ReadSource a, Show err) =>
(a -> Either err b) -> FileUrl -> IO b
getSchema ByteString -> Either err schema
parseSchema FileUrl
url
IO (resolvers -> app) -> IO resolvers -> IO app
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FileUrl -> IO resolvers
forall req. FromJSON req => FileUrl -> IO req
getResolver FileUrl
url
testQueryValidation ::
( ToJSON errors,
Show errors,
FromJSON request,
FromJSON errors,
Eq errors
) =>
( schema -> request -> Either errors a,
ByteString -> Either errors schema
) ->
FileUrl ->
FileUrl ->
TestTree
testQueryValidation :: (schema -> request -> Either errors a,
ByteString -> Either errors schema)
-> FileUrl -> FileUrl -> TestTree
testQueryValidation (schema -> request -> Either errors a
parseRequest, ByteString -> Either errors schema
parseSchema) FileUrl
schemaUrl =
(FileUrl -> IO (CaseAssertion errors)) -> FileUrl -> TestTree
forall a.
(FromJSON a, Eq a, ToJSON a) =>
(FileUrl -> IO (CaseAssertion a)) -> FileUrl -> TestTree
assertResponse
( \FileUrl
url -> do
schema
schema <- (ByteString -> Either errors schema) -> FileUrl -> IO schema
forall a err b.
(ReadSource a, Show err) =>
(a -> Either err b) -> FileUrl -> IO b
getSchema ByteString -> Either errors schema
parseSchema FileUrl
schemaUrl
request
query <- FileUrl -> IO request
forall req. FromJSON req => FileUrl -> IO req
getQuery FileUrl
url
CaseAssertion errors -> IO (CaseAssertion errors)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CaseAssertion errors -> IO (CaseAssertion errors))
-> CaseAssertion errors -> IO (CaseAssertion errors)
forall a b. (a -> b) -> a -> b
$ Either errors a -> CaseAssertion errors
forall err a. ToJSON err => Either err a -> CaseAssertion err
fromEither (schema -> request -> Either errors a
parseRequest schema
schema request
query)
)
testQueryRendering ::
( ToJSON errors,
Show errors,
FromJSON request
) =>
( schema -> request -> Either errors ByteString,
ByteString -> Either errors schema
) ->
FileUrl ->
FileUrl ->
TestTree
testQueryRendering :: (schema -> request -> Either errors ByteString,
ByteString -> Either errors schema)
-> FileUrl -> FileUrl -> TestTree
testQueryRendering (schema -> request -> Either errors ByteString
parseRequest, ByteString -> Either errors schema
parseSchema) FileUrl
schemaUrl =
(FileUrl -> IO (Either errors ByteString)) -> FileUrl -> TestTree
forall e.
ToJSON e =>
(FileUrl -> IO (Either e ByteString)) -> FileUrl -> TestTree
renderingAssertion
( \FileUrl
requestUrl -> do
request
request <- FileUrl -> IO request
forall req. FromJSON req => FileUrl -> IO req
getQuery FileUrl
requestUrl
schema
schema <- (ByteString -> Either errors schema) -> FileUrl -> IO schema
forall a err b.
(ReadSource a, Show err) =>
(a -> Either err b) -> FileUrl -> IO b
getSchema ByteString -> Either errors schema
parseSchema FileUrl
schemaUrl
Either errors ByteString -> IO (Either errors ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either errors ByteString -> IO (Either errors ByteString))
-> Either errors ByteString -> IO (Either errors ByteString)
forall a b. (a -> b) -> a -> b
$ schema -> request -> Either errors ByteString
parseRequest schema
schema request
request
)
getAppsWIth ::
(Semigroup b, Show err, FromJSON resolvers) =>
( ByteString -> Either err schema,
schema -> resolvers -> b
) ->
FileUrl ->
[FilePath] ->
IO b
getAppsWIth :: (ByteString -> Either err schema, schema -> resolvers -> b)
-> FileUrl -> [String] -> IO b
getAppsWIth (ByteString -> Either err schema, schema -> resolvers -> b)
f FileUrl
url [] = (ByteString -> Either err schema, schema -> resolvers -> b)
-> FileUrl -> IO b
forall err resolvers schema app.
(Show err, FromJSON resolvers) =>
(ByteString -> Either err schema, schema -> resolvers -> app)
-> FileUrl -> IO app
getAppBy (ByteString -> Either err schema, schema -> resolvers -> b)
f FileUrl
url
getAppsWIth (ByteString -> Either err schema, schema -> resolvers -> b)
f FileUrl
url (String
x : [String]
xs) = NonEmpty b -> b
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty b -> b) -> IO (NonEmpty b) -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileUrl -> IO b) -> NonEmpty FileUrl -> IO (NonEmpty b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((ByteString -> Either err schema, schema -> resolvers -> b)
-> FileUrl -> IO b
forall err resolvers schema app.
(Show err, FromJSON resolvers) =>
(ByteString -> Either err schema, schema -> resolvers -> app)
-> FileUrl -> IO app
getAppBy (ByteString -> Either err schema, schema -> resolvers -> b)
f) (FileUrl -> String -> FileUrl
file FileUrl
url (String -> FileUrl) -> NonEmpty String -> NonEmpty FileUrl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String
x String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| [String]
xs))
getAppsBy ::
(Semigroup b, Show err, FromJSON resolvers) =>
( ByteString -> Either err schema,
schema -> resolvers -> b
) ->
FileUrl ->
IO b
getAppsBy :: (ByteString -> Either err schema, schema -> resolvers -> b)
-> FileUrl -> IO b
getAppsBy (ByteString -> Either err schema, schema -> resolvers -> b)
f FileUrl
url = do
[String]
files <- FileUrl -> IO [String]
searchAppFiles FileUrl
url
(ByteString -> Either err schema, schema -> resolvers -> b)
-> FileUrl -> [String] -> IO b
forall b err resolvers schema.
(Semigroup b, Show err, FromJSON resolvers) =>
(ByteString -> Either err schema, schema -> resolvers -> b)
-> FileUrl -> [String] -> IO b
getAppsWIth (ByteString -> Either err schema, schema -> resolvers -> b)
f FileUrl
url ([String] -> [String]
forall a. Ord a => [a] -> [a]
sort [String]
files)