{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Test.Morpheus
  ( FileUrl,
    mkUrl,
    cd,
    file,
    deepScan,
    scan,
    -- get app
    getAppsBy,
    -- tests
    testApi,
    testSchema,
    testQueryRendering,
    renderingAssertion,
    testQuery,
    testQueryValidation,
    -- main
    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)