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