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