{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Test.Morpheus.Utils
( FileUrl,
deepScan,
scan,
getResolver,
getSchema,
requireEq,
readSchemaFile,
)
where
import Data.Aeson
( FromJSON (..),
eitherDecode,
)
import qualified Data.ByteString.Lazy.Char8 as L
import Data.ByteString.Lazy.Char8 (ByteString)
import Relude hiding (ByteString)
import Test.Morpheus.File
import Test.Tasty
( TestTree,
testGroup,
)
import Test.Tasty.HUnit
( assertFailure,
)
readSchemaFile :: ReadSource t => FileUrl -> IO t
readSchemaFile :: FileUrl -> IO t
readSchemaFile = String -> FileUrl -> IO t
forall t. ReadSource t => String -> FileUrl -> IO t
readGQL String
"schema"
runCaseTree :: (FileUrl -> [FileUrl] -> [TestTree]) -> CaseTree [FileUrl] -> TestTree
runCaseTree :: (FileUrl -> [FileUrl] -> [TestTree])
-> CaseTree [FileUrl] -> TestTree
runCaseTree FileUrl -> [FileUrl] -> [TestTree]
f CaseTree {FileUrl
caseUrl :: forall assets. CaseTree assets -> FileUrl
caseUrl :: FileUrl
caseUrl, children :: forall assets. CaseTree assets -> [CaseTree assets]
children = [], [FileUrl]
assets :: forall assets. CaseTree assets -> assets
assets :: [FileUrl]
assets} =
String -> [TestTree] -> TestTree
testGroup (FileUrl -> String
fileName FileUrl
caseUrl) (FileUrl -> [FileUrl] -> [TestTree]
f FileUrl
caseUrl [FileUrl]
assets)
runCaseTree FileUrl -> [FileUrl] -> [TestTree]
f CaseTree {caseUrl :: forall assets. CaseTree assets -> FileUrl
caseUrl = FileUrl {String
fileName :: String
fileName :: FileUrl -> String
fileName}, [CaseTree [FileUrl]]
children :: [CaseTree [FileUrl]]
children :: forall assets. CaseTree assets -> [CaseTree assets]
children} =
String -> [TestTree] -> TestTree
testGroup String
fileName ((CaseTree [FileUrl] -> TestTree)
-> [CaseTree [FileUrl]] -> [TestTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FileUrl -> [FileUrl] -> [TestTree])
-> CaseTree [FileUrl] -> TestTree
runCaseTree FileUrl -> [FileUrl] -> [TestTree]
f) [CaseTree [FileUrl]]
children)
foldCaseTree :: (FileUrl -> TestTree) -> CaseTree () -> TestTree
foldCaseTree :: (FileUrl -> TestTree) -> CaseTree () -> TestTree
foldCaseTree FileUrl -> TestTree
f CaseTree {FileUrl
caseUrl :: FileUrl
caseUrl :: forall assets. CaseTree assets -> FileUrl
caseUrl, children :: forall assets. CaseTree assets -> [CaseTree assets]
children = []} = FileUrl -> TestTree
f FileUrl
caseUrl
foldCaseTree FileUrl -> TestTree
f CaseTree {caseUrl :: forall assets. CaseTree assets -> FileUrl
caseUrl = FileUrl {String
fileName :: String
fileName :: FileUrl -> String
fileName}, [CaseTree ()]
children :: [CaseTree ()]
children :: forall assets. CaseTree assets -> [CaseTree assets]
children} =
String -> [TestTree] -> TestTree
testGroup String
fileName ((CaseTree () -> TestTree) -> [CaseTree ()] -> [TestTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FileUrl -> TestTree) -> CaseTree () -> TestTree
foldCaseTree FileUrl -> TestTree
f) [CaseTree ()]
children)
recursiveScan :: Monoid assets => (FileUrl -> IO assets) -> FileUrl -> IO (CaseTree assets)
recursiveScan :: (FileUrl -> IO assets) -> FileUrl -> IO (CaseTree assets)
recursiveScan FileUrl -> IO assets
scanAssets FileUrl
caseUrl = do
Bool
dir <- FileUrl -> IO Bool
isDirectory FileUrl
caseUrl
[CaseTree assets]
children <-
if Bool
dir
then do
[FileUrl]
list <- FileUrl -> IO [FileUrl]
ls FileUrl
caseUrl
if (FileUrl -> Bool) -> [FileUrl] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all FileUrl -> Bool
isDir [FileUrl]
list
then (FileUrl -> IO (CaseTree assets))
-> [FileUrl] -> IO [CaseTree assets]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((FileUrl -> IO assets) -> FileUrl -> IO (CaseTree assets)
forall assets.
Monoid assets =>
(FileUrl -> IO assets) -> FileUrl -> IO (CaseTree assets)
recursiveScan FileUrl -> IO assets
scanAssets) [FileUrl]
list
else [CaseTree assets] -> IO [CaseTree assets]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
else [CaseTree assets] -> IO [CaseTree assets]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
assets
assets <- if Bool
dir Bool -> Bool -> Bool
&& [CaseTree assets] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CaseTree assets]
children then FileUrl -> IO assets
scanAssets FileUrl
caseUrl else assets -> IO assets
forall (f :: * -> *) a. Applicative f => a -> f a
pure assets
forall a. Monoid a => a
mempty
CaseTree assets -> IO (CaseTree assets)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CaseTree :: forall assets.
FileUrl -> [CaseTree assets] -> assets -> CaseTree assets
CaseTree {assets
[CaseTree assets]
FileUrl
assets :: assets
children :: [CaseTree assets]
caseUrl :: FileUrl
assets :: assets
children :: [CaseTree assets]
caseUrl :: FileUrl
..}
scan :: (FileUrl -> TestTree) -> FileUrl -> IO TestTree
scan :: (FileUrl -> TestTree) -> FileUrl -> IO TestTree
scan FileUrl -> TestTree
f FileUrl
url = (FileUrl -> TestTree) -> CaseTree () -> TestTree
foldCaseTree FileUrl -> TestTree
f (CaseTree () -> TestTree) -> IO (CaseTree ()) -> IO TestTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileUrl -> IO ()) -> FileUrl -> IO (CaseTree ())
forall assets.
Monoid assets =>
(FileUrl -> IO assets) -> FileUrl -> IO (CaseTree assets)
recursiveScan (IO () -> FileUrl -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) FileUrl
url
deepScan :: (FileUrl -> [FileUrl] -> [TestTree]) -> FileUrl -> IO TestTree
deepScan :: (FileUrl -> [FileUrl] -> [TestTree]) -> FileUrl -> IO TestTree
deepScan FileUrl -> [FileUrl] -> [TestTree]
f FileUrl
url = (FileUrl -> [FileUrl] -> [TestTree])
-> CaseTree [FileUrl] -> TestTree
runCaseTree FileUrl -> [FileUrl] -> [TestTree]
f (CaseTree [FileUrl] -> TestTree)
-> IO (CaseTree [FileUrl]) -> IO TestTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FileUrl -> IO [FileUrl]) -> FileUrl -> IO (CaseTree [FileUrl])
forall assets.
Monoid assets =>
(FileUrl -> IO assets) -> FileUrl -> IO (CaseTree assets)
recursiveScan FileUrl -> IO [FileUrl]
scanDirectories FileUrl
url
data CaseTree assets = CaseTree
{ CaseTree assets -> FileUrl
caseUrl :: FileUrl,
CaseTree assets -> [CaseTree assets]
children :: [CaseTree assets],
CaseTree assets -> assets
assets :: assets
}
deriving (Int -> CaseTree assets -> ShowS
[CaseTree assets] -> ShowS
CaseTree assets -> String
(Int -> CaseTree assets -> ShowS)
-> (CaseTree assets -> String)
-> ([CaseTree assets] -> ShowS)
-> Show (CaseTree assets)
forall assets. Show assets => Int -> CaseTree assets -> ShowS
forall assets. Show assets => [CaseTree assets] -> ShowS
forall assets. Show assets => CaseTree assets -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CaseTree assets] -> ShowS
$cshowList :: forall assets. Show assets => [CaseTree assets] -> ShowS
show :: CaseTree assets -> String
$cshow :: forall assets. Show assets => CaseTree assets -> String
showsPrec :: Int -> CaseTree assets -> ShowS
$cshowsPrec :: forall assets. Show assets => Int -> CaseTree assets -> ShowS
Show)
requireEq :: (Eq t) => (t -> ByteString) -> t -> t -> IO ()
requireEq :: (t -> ByteString) -> t -> t -> IO ()
requireEq t -> ByteString
f t
expected t
actual
| t
expected t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
actual = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = ByteString -> ByteString -> IO ()
forall a3. ByteString -> ByteString -> IO a3
eqFailureMessage (t -> ByteString
f t
expected) (t -> ByteString
f t
actual)
eqFailureMessage :: ByteString -> ByteString -> IO a3
eqFailureMessage :: ByteString -> ByteString -> IO a3
eqFailureMessage ByteString
expected ByteString
actual =
String -> IO a3
forall a. HasCallStack => String -> IO a
assertFailure
(String -> IO a3) -> String -> IO a3
forall a b. (a -> b) -> a -> b
$ ByteString -> String
L.unpack
(ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString
"expected: \n\n "
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
expected
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" \n\n but got: \n\n "
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
actual
getSchema :: (ReadSource a, Show err) => (a -> Either err b) -> FileUrl -> IO b
getSchema :: (a -> Either err b) -> FileUrl -> IO b
getSchema a -> Either err b
f FileUrl
url =
FileUrl -> IO a
forall t. ReadSource t => FileUrl -> IO t
readSchemaFile FileUrl
url
IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either err b -> IO b
forall err a. Show err => Either err a -> IO a
assertValidSchema (Either err b -> IO b) -> (a -> Either err b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either err b
f
assertValidSchema :: Show err => Either err a -> IO a
assertValidSchema :: Either err a -> IO a
assertValidSchema =
(err -> IO a) -> (a -> IO a) -> Either err a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
( String -> IO a
forall a. HasCallStack => String -> IO a
assertFailure
(String -> IO a) -> (err -> String) -> err -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( String
"unexpected schema validation error: \n "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
)
ShowS -> (err -> String) -> err -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> String
forall b a. (Show a, IsString b) => a -> b
show
)
a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
getResolver :: FromJSON resolver => FileUrl -> IO resolver
getResolver :: FileUrl -> IO resolver
getResolver FileUrl
url = String -> FileUrl -> IO ByteString
forall t. ReadSource t => String -> FileUrl -> IO t
readJSON String
"resolvers" FileUrl
url IO ByteString -> (ByteString -> IO resolver) -> IO resolver
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO resolver)
-> (resolver -> IO resolver)
-> Either String resolver
-> IO resolver
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO resolver
forall (m :: * -> *) a. MonadFail m => String -> m a
fail resolver -> IO resolver
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String resolver -> IO resolver)
-> (ByteString -> Either String resolver)
-> ByteString
-> IO resolver
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String resolver
forall a. FromJSON a => ByteString -> Either String a
eitherDecode