{-# 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