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