{-# OPTIONS_HADDOCK hide #-}
module Polysemy.Test.Run where
import Control.Exception (catch)
import qualified Control.Monad.Trans.Writer.Lazy as MTL
import qualified Data.Text as Text
import GHC.Stack.Types (SrcLoc(SrcLoc, srcLocModule, srcLocFile))
import Hedgehog.Internal.Property (Failure, Journal, TestT(TestT), failWith)
import Path (Abs, Dir, Path, parseAbsDir, parseRelDir, (</>))
import Path.IO (canonicalizePath, createTempDir, getCurrentDir, getTempDir, removeDirRecur)
import Polysemy.Resource (Resource, bracket, resourceToIOFinal)
import Polysemy.Writer (runLazyWriter)
import System.IO.Error (IOError)
import Polysemy.Test.Data.Hedgehog (Hedgehog, liftH)
import qualified Polysemy.Test.Data.Test as Test
import Polysemy.Test.Data.Test (Test)
import Polysemy.Test.Data.TestError (TestError(TestError))
import qualified Polysemy.Test.Files as Files
import Polysemy.Test.Hedgehog (rewriteHedgehog)
ignoringIOErrors ::
IO () ->
IO ()
ignoringIOErrors :: IO () -> IO ()
ignoringIOErrors ioe :: IO ()
ioe =
IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO ()
ioe IOError -> IO ()
forall (m :: * -> *). Monad m => IOError -> m ()
handler
where
handler :: Monad m => IOError -> m ()
handler :: IOError -> m ()
handler =
m () -> IOError -> m ()
forall a b. a -> b -> a
const m ()
forall (f :: * -> *). Applicative f => f ()
unit
interpretTestIn' ::
Member (Embed IO) r =>
Path Abs Dir ->
Path Abs Dir ->
InterpreterFor Test r
interpretTestIn' :: Path Abs Dir -> Path Abs Dir -> InterpreterFor Test r
interpretTestIn' base :: Path Abs Dir
base tempBase :: Path Abs Dir
tempBase =
(forall x (rInitial :: EffectRow).
Test (Sem rInitial) x -> Sem r x)
-> Sem (Test : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall x (rInitial :: EffectRow). e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
Test.TestDir ->
Path Abs Dir -> Sem r (Path Abs Dir)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs Dir
base
Test.TempDir path ->
Path Abs Dir -> Path Rel Dir -> Sem r (Path Abs Dir)
forall (r :: EffectRow).
Member (Embed IO) r =>
Path Abs Dir -> Path Rel Dir -> Sem r (Path Abs Dir)
Files.tempDir Path Abs Dir
tempBase Path Rel Dir
path
Test.TempFile content path ->
Path Abs Dir -> [Text] -> Path Rel File -> Sem r (Path Abs File)
forall (r :: EffectRow).
Member (Embed IO) r =>
Path Abs Dir -> [Text] -> Path Rel File -> Sem r (Path Abs File)
Files.tempFile Path Abs Dir
tempBase [Text]
content Path Rel File
path
Test.TempFileContent path ->
Path Abs Dir -> Path Rel File -> Sem r Text
forall (r :: EffectRow).
Member (Embed IO) r =>
Path Abs Dir -> Path Rel File -> Sem r Text
Files.tempFileContent Path Abs Dir
tempBase Path Rel File
path
Test.FixturePath path ->
Path Abs Dir -> Path Rel p -> Sem r (Path Abs p)
forall p (r :: EffectRow).
Path Abs Dir -> Path Rel p -> Sem r (Path Abs p)
Files.fixturePath Path Abs Dir
base Path Rel p
path
Test.Fixture path ->
Path Abs Dir -> Path Rel File -> Sem r Text
forall (r :: EffectRow).
Member (Embed IO) r =>
Path Abs Dir -> Path Rel File -> Sem r Text
Files.fixture Path Abs Dir
base Path Rel File
path
createTemp ::
Members [Error TestError, Embed IO] r =>
Sem r (Path Abs Dir)
createTemp :: Sem r (Path Abs Dir)
createTemp =
Either TestError (Path Abs Dir) -> Sem r (Path Abs Dir)
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either TestError (Path Abs Dir) -> Sem r (Path Abs Dir))
-> Sem r (Either TestError (Path Abs Dir)) -> Sem r (Path Abs Dir)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IO (Either TestError (Path Abs Dir))
-> Sem r (Either TestError (Path Abs Dir))
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either TestError (Path Abs Dir))
-> Sem r (Either TestError (Path Abs Dir)))
-> (ExceptT TestError IO (Path Abs Dir)
-> IO (Either TestError (Path Abs Dir)))
-> ExceptT TestError IO (Path Abs Dir)
-> Sem r (Either TestError (Path Abs Dir))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT TestError IO (Path Abs Dir)
-> IO (Either TestError (Path Abs Dir))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT) do
Path Abs Dir
systemTmp <- ExceptT TestError IO (Path Abs Dir)
forall (m :: * -> *). (MonadIO m, MonadThrow m) => m (Path Abs Dir)
getTempDir
Path Abs Dir -> String -> ExceptT TestError IO (Path Abs Dir)
forall (m :: * -> *) b.
(MonadIO m, MonadThrow m) =>
Path b Dir -> String -> m (Path Abs Dir)
createTempDir Path Abs Dir
systemTmp "polysemy-test-"
interpretTestKeepTemp ::
Members [Error TestError, Embed IO] r =>
Path Abs Dir ->
InterpreterFor Test r
interpretTestKeepTemp :: Path Abs Dir -> InterpreterFor Test r
interpretTestKeepTemp base :: Path Abs Dir
base sem :: Sem (Test : r) a
sem = do
Path Abs Dir
tempBase <- Sem r (Path Abs Dir)
forall (r :: EffectRow).
Members '[Error TestError, Embed IO] r =>
Sem r (Path Abs Dir)
createTemp
(Path Abs Dir -> Path Abs Dir -> Sem (Test : r) a -> Sem r a
forall (r :: EffectRow).
Member (Embed IO) r =>
Path Abs Dir -> Path Abs Dir -> InterpreterFor Test r
interpretTestIn' Path Abs Dir
base Path Abs Dir
tempBase) Sem (Test : r) a
sem
interpretTest ::
Members [Error TestError, Resource, Embed IO] r =>
Path Abs Dir ->
InterpreterFor Test r
interpretTest :: Path Abs Dir -> InterpreterFor Test r
interpretTest base :: Path Abs Dir
base sem :: Sem (Test : r) a
sem = do
Sem r (Path Abs Dir)
-> (Path Abs Dir -> Sem r ())
-> (Path Abs Dir -> Sem r a)
-> Sem r a
forall (r :: EffectRow) a c b.
MemberWithError Resource r =>
Sem r a -> (a -> Sem r c) -> (a -> Sem r b) -> Sem r b
bracket Sem r (Path Abs Dir)
forall (r :: EffectRow).
Members '[Error TestError, Embed IO] r =>
Sem r (Path Abs Dir)
createTemp Path Abs Dir -> Sem r ()
forall (r :: EffectRow) b.
(Find (Embed IO) r, LocateEffect (Embed IO) r ~ '()) =>
Path b Dir -> Sem r ()
release Path Abs Dir -> Sem r a
use
where
release :: Path b Dir -> Sem r ()
release tempBase :: Path b Dir
tempBase =
IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> IO ()
ignoringIOErrors (Path b Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
removeDirRecur Path b Dir
tempBase))
use :: Path Abs Dir -> Sem r a
use tempBase :: Path Abs Dir
tempBase =
(Path Abs Dir -> Path Abs Dir -> Sem (Test : r) a -> Sem r a
forall (r :: EffectRow).
Member (Embed IO) r =>
Path Abs Dir -> Path Abs Dir -> InterpreterFor Test r
interpretTestIn' Path Abs Dir
base Path Abs Dir
tempBase) Sem (Test : r) a
sem
interpretTestInSubdir ::
Members [Error TestError, Resource, Embed IO] r =>
Text ->
InterpreterFor Test r
interpretTestInSubdir :: Text -> InterpreterFor Test r
interpretTestInSubdir prefix :: Text
prefix sem :: Sem (Test : r) a
sem = do
Path Rel Dir
prefixPath <- IO (Path Rel Dir) -> Sem r (Path Rel Dir)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (String -> IO (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir @IO (Text -> String
forall a. ToString a => a -> String
toString Text
prefix))
Path Abs Dir
base <- IO (Path Abs Dir) -> Sem r (Path Abs Dir)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (Path Rel Dir -> IO (AbsPath (Path Rel Dir))
forall path (m :: * -> *).
(AnyPath path, MonadIO m, MonadThrow m) =>
path -> m (AbsPath path)
canonicalizePath @_ @IO Path Rel Dir
prefixPath)
(Path Abs Dir -> Sem (Test : r) a -> Sem r a
forall (r :: EffectRow).
Members '[Error TestError, Resource, Embed IO] r =>
Path Abs Dir -> InterpreterFor Test r
interpretTest Path Abs Dir
base) Sem (Test : r) a
sem
type TestEffects =
[
Error TestError,
Hedgehog IO,
Embed IO,
Final IO
]
errorToFailure ::
Monad m =>
Member (Hedgehog m) r =>
Either TestError a ->
Sem r a
errorToFailure :: Either TestError a -> Sem r a
errorToFailure = \case
Right a :: a
a -> a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
Left (TestError e :: Text
e) -> TestT m a -> Sem r a
forall (m :: * -> *) a (r :: EffectRow).
Member (Hedgehog m) r =>
TestT m a -> Sem r a
liftH (Maybe Diff -> String -> TestT m a
forall (m :: * -> *) a.
(MonadTest m, HasCallStack) =>
Maybe Diff -> String -> m a
failWith Maybe Diff
forall a. Maybe a
Nothing (Text -> String
forall a. ToString a => a -> String
toString Text
e))
unwrapLiftedTestT ::
Monad m =>
Member (Embed m) r =>
Sem (Error TestError : Hedgehog m : r) a ->
Sem r (Journal, Either Failure a)
unwrapLiftedTestT :: Sem (Error TestError : Hedgehog m : r) a
-> Sem r (Journal, Either Failure a)
unwrapLiftedTestT =
Sem (Writer Journal : r) (Either Failure a)
-> Sem r (Journal, Either Failure a)
forall o (r :: EffectRow) a.
Monoid o =>
Sem (Writer o : r) a -> Sem r (o, a)
runLazyWriter (Sem (Writer Journal : r) (Either Failure a)
-> Sem r (Journal, Either Failure a))
-> (Sem (Error TestError : Hedgehog m : r) a
-> Sem (Writer Journal : r) (Either Failure a))
-> Sem (Error TestError : Hedgehog m : r) a
-> Sem r (Journal, Either Failure a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Error Failure : Writer Journal : r) a
-> Sem (Writer Journal : r) (Either Failure a)
forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError (Sem (Error Failure : Writer Journal : r) a
-> Sem (Writer Journal : r) (Either Failure a))
-> (Sem (Error TestError : Hedgehog m : r) a
-> Sem (Error Failure : Writer Journal : r) a)
-> Sem (Error TestError : Hedgehog m : r) a
-> Sem (Writer Journal : r) (Either Failure a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Hedgehog m : Error Failure : Writer Journal : r) a
-> Sem (Error Failure : Writer Journal : r) a
forall (m :: * -> *) (r :: EffectRow).
Members '[Error Failure, Writer Journal, Embed m] r =>
InterpreterFor (Hedgehog m) r
rewriteHedgehog (Sem (Hedgehog m : Error Failure : Writer Journal : r) a
-> Sem (Error Failure : Writer Journal : r) a)
-> (Sem (Error TestError : Hedgehog m : r) a
-> Sem (Hedgehog m : Error Failure : Writer Journal : r) a)
-> Sem (Error TestError : Hedgehog m : r) a
-> Sem (Error Failure : Writer Journal : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Hedgehog m : r) a
-> Sem (Hedgehog m : Error Failure : Writer Journal : r) a
forall (e2 :: Effect) (e3 :: Effect) (e1 :: Effect)
(r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : e3 : r) a
raiseUnder2 (Sem (Hedgehog m : r) a
-> Sem (Hedgehog m : Error Failure : Writer Journal : r) a)
-> (Sem (Error TestError : Hedgehog m : r) a
-> Sem (Hedgehog m : r) a)
-> Sem (Error TestError : Hedgehog m : r) a
-> Sem (Hedgehog m : Error Failure : Writer Journal : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Sem (Hedgehog m : r) (Either TestError a)
-> (Either TestError a -> Sem (Hedgehog m : r) a)
-> Sem (Hedgehog m : r) a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either TestError a -> Sem (Hedgehog m : r) a
forall (m :: * -> *) (r :: EffectRow) a.
(Monad m, Member (Hedgehog m) r) =>
Either TestError a -> Sem r a
errorToFailure) (Sem (Hedgehog m : r) (Either TestError a)
-> Sem (Hedgehog m : r) a)
-> (Sem (Error TestError : Hedgehog m : r) a
-> Sem (Hedgehog m : r) (Either TestError a))
-> Sem (Error TestError : Hedgehog m : r) a
-> Sem (Hedgehog m : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Error TestError : Hedgehog m : r) a
-> Sem (Hedgehog m : r) (Either TestError a)
forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError
semToTestT ::
Monad m =>
Member (Embed m) r =>
(∀ x . Sem r x -> m x) ->
Sem (Error TestError : Hedgehog m : r) a ->
TestT m a
semToTestT :: (forall x. Sem r x -> m x)
-> Sem (Error TestError : Hedgehog m : r) a -> TestT m a
semToTestT run :: forall x. Sem r x -> m x
run sem :: Sem (Error TestError : Hedgehog m : r) a
sem = do
(journal :: Journal
journal, result :: Either Failure a
result) <- m (Journal, Either Failure a)
-> TestT m (Journal, Either Failure a)
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Sem r (Journal, Either Failure a) -> m (Journal, Either Failure a)
forall x. Sem r x -> m x
run (Sem (Error TestError : Hedgehog m : r) a
-> Sem r (Journal, Either Failure a)
forall (m :: * -> *) (r :: EffectRow) a.
(Monad m, Member (Embed m) r) =>
Sem (Error TestError : Hedgehog m : r) a
-> Sem r (Journal, Either Failure a)
unwrapLiftedTestT Sem (Error TestError : Hedgehog m : r) a
sem))
ExceptT Failure (WriterT Journal m) a -> TestT m a
forall (m :: * -> *) a.
ExceptT Failure (WriterT Journal m) a -> TestT m a
TestT (WriterT Journal m (Either Failure a)
-> ExceptT Failure (WriterT Journal m) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Either Failure a
result Either Failure a
-> WriterT Journal m () -> WriterT Journal m (Either Failure a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Journal -> WriterT Journal m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
MTL.tell Journal
journal))
semToTestTFinal ::
Monad m =>
Sem [Error TestError, Hedgehog m, Embed m, Final m] a ->
TestT m a
semToTestTFinal :: Sem '[Error TestError, Hedgehog m, Embed m, Final m] a -> TestT m a
semToTestTFinal =
(forall x. Sem '[Embed m, Final m] x -> m x)
-> Sem '[Error TestError, Hedgehog m, Embed m, Final m] a
-> TestT m a
forall (m :: * -> *) (r :: EffectRow) a.
(Monad m, Member (Embed m) r) =>
(forall x. Sem r x -> m x)
-> Sem (Error TestError : Hedgehog m : r) a -> TestT m a
semToTestT (Sem '[Final m] x -> m x
forall (m :: * -> *) a. Monad m => Sem '[Final m] a -> m a
runFinal (Sem '[Final m] x -> m x)
-> (Sem '[Embed m, Final m] x -> Sem '[Final m] x)
-> Sem '[Embed m, Final m] x
-> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem '[Embed m, Final m] x -> Sem '[Final m] x
forall (m :: * -> *) (r :: EffectRow) a.
(Member (Final m) r, Functor m) =>
Sem (Embed m : r) a -> Sem r a
embedToFinal)
runTest ::
Path Abs Dir ->
Sem [Test, Resource, Error TestError, Hedgehog IO, Embed IO, Final IO] a ->
TestT IO a
runTest :: Path Abs Dir
-> Sem
'[Test, Resource, Error TestError, Hedgehog IO, Embed IO, Final IO]
a
-> TestT IO a
runTest dir :: Path Abs Dir
dir =
Sem '[Error TestError, Hedgehog IO, Embed IO, Final IO] a
-> TestT IO a
forall (m :: * -> *) a.
Monad m =>
Sem '[Error TestError, Hedgehog m, Embed m, Final m] a -> TestT m a
semToTestTFinal (Sem '[Error TestError, Hedgehog IO, Embed IO, Final IO] a
-> TestT IO a)
-> (Sem
'[Test, Resource, Error TestError, Hedgehog IO, Embed IO, Final IO]
a
-> Sem '[Error TestError, Hedgehog IO, Embed IO, Final IO] a)
-> Sem
'[Test, Resource, Error TestError, Hedgehog IO, Embed IO, Final IO]
a
-> TestT IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem '[Resource, Error TestError, Hedgehog IO, Embed IO, Final IO] a
-> Sem '[Error TestError, Hedgehog IO, Embed IO, Final IO] a
forall (r :: EffectRow) a.
Member (Final IO) r =>
Sem (Resource : r) a -> Sem r a
resourceToIOFinal (Sem
'[Resource, Error TestError, Hedgehog IO, Embed IO, Final IO] a
-> Sem '[Error TestError, Hedgehog IO, Embed IO, Final IO] a)
-> (Sem
'[Test, Resource, Error TestError, Hedgehog IO, Embed IO, Final IO]
a
-> Sem
'[Resource, Error TestError, Hedgehog IO, Embed IO, Final IO] a)
-> Sem
'[Test, Resource, Error TestError, Hedgehog IO, Embed IO, Final IO]
a
-> Sem '[Error TestError, Hedgehog IO, Embed IO, Final IO] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Path Abs Dir
-> InterpreterFor
Test '[Resource, Error TestError, Hedgehog IO, Embed IO, Final IO]
forall (r :: EffectRow).
Members '[Error TestError, Resource, Embed IO] r =>
Path Abs Dir -> InterpreterFor Test r
interpretTest Path Abs Dir
dir
runTestInSubdir ::
Text ->
Sem (Test : Resource : TestEffects) a ->
TestT IO a
runTestInSubdir :: Text
-> Sem
'[Test, Resource, Error TestError, Hedgehog IO, Embed IO, Final IO]
a
-> TestT IO a
runTestInSubdir prefix :: Text
prefix =
Sem '[Error TestError, Hedgehog IO, Embed IO, Final IO] a
-> TestT IO a
forall (m :: * -> *) a.
Monad m =>
Sem '[Error TestError, Hedgehog m, Embed m, Final m] a -> TestT m a
semToTestTFinal (Sem '[Error TestError, Hedgehog IO, Embed IO, Final IO] a
-> TestT IO a)
-> (Sem
'[Test, Resource, Error TestError, Hedgehog IO, Embed IO, Final IO]
a
-> Sem '[Error TestError, Hedgehog IO, Embed IO, Final IO] a)
-> Sem
'[Test, Resource, Error TestError, Hedgehog IO, Embed IO, Final IO]
a
-> TestT IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem '[Resource, Error TestError, Hedgehog IO, Embed IO, Final IO] a
-> Sem '[Error TestError, Hedgehog IO, Embed IO, Final IO] a
forall (r :: EffectRow) a.
Member (Final IO) r =>
Sem (Resource : r) a -> Sem r a
resourceToIOFinal (Sem
'[Resource, Error TestError, Hedgehog IO, Embed IO, Final IO] a
-> Sem '[Error TestError, Hedgehog IO, Embed IO, Final IO] a)
-> (Sem
'[Test, Resource, Error TestError, Hedgehog IO, Embed IO, Final IO]
a
-> Sem
'[Resource, Error TestError, Hedgehog IO, Embed IO, Final IO] a)
-> Sem
'[Test, Resource, Error TestError, Hedgehog IO, Embed IO, Final IO]
a
-> Sem '[Error TestError, Hedgehog IO, Embed IO, Final IO] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text
-> InterpreterFor
Test '[Resource, Error TestError, Hedgehog IO, Embed IO, Final IO]
forall (r :: EffectRow).
Members '[Error TestError, Resource, Embed IO] r =>
Text -> InterpreterFor Test r
interpretTestInSubdir Text
prefix
callingTestDir ::
Members [Error TestError, Embed IO] r =>
HasCallStack =>
Sem r (Path Abs Dir)
callingTestDir :: Sem r (Path Abs Dir)
callingTestDir = do
SrcLoc { srcLocFile :: SrcLoc -> String
srcLocFile = String -> Text
forall a. ToText a => a -> Text
toText -> Text
file, srcLocModule :: SrcLoc -> String
srcLocModule = String -> Text
forall a. ToText a => a -> Text
toText -> Text
modl } <- TestError -> Maybe SrcLoc -> Sem r SrcLoc
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note TestError
emptyCallStack Maybe SrcLoc
deepestSrcLoc
Text
dirPrefix <- TestError -> Maybe Text -> Sem r Text
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note TestError
badSrcLoc (Text -> Text -> Maybe Text
Text.stripSuffix (Text -> Text -> Text -> Text
Text.replace "." "/" Text
modl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ".hs") Text
file)
Path Abs Dir
cwd <- IO (Path Abs Dir) -> Sem r (Path Abs Dir)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed IO (Path Abs Dir)
forall (m :: * -> *). (MonadIO m, MonadThrow m) => m (Path Abs Dir)
getCurrentDir
TestError -> Maybe (Path Abs Dir) -> Sem r (Path Abs Dir)
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note TestError
badSrcLoc (Path Abs Dir -> String -> Maybe (Path Abs Dir)
forall (f :: * -> *).
(Alternative f, MonadThrow f) =>
Path Abs Dir -> String -> f (Path Abs Dir)
parseDir Path Abs Dir
cwd (Text -> String
forall a. ToString a => a -> String
toString Text
dirPrefix))
where
emptyCallStack :: TestError
emptyCallStack =
Text -> TestError
TestError "empty call stack"
deepestSrcLoc :: Maybe SrcLoc
deepestSrcLoc =
(String, SrcLoc) -> SrcLoc
forall a b. (a, b) -> b
snd ((String, SrcLoc) -> SrcLoc)
-> Maybe (String, SrcLoc) -> Maybe SrcLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, SrcLoc)] -> Maybe (String, SrcLoc)
forall a. [a] -> Maybe a
listToMaybe ([(String, SrcLoc)] -> [(String, SrcLoc)]
forall a. [a] -> [a]
reverse (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack))
badSrcLoc :: TestError
badSrcLoc =
Text -> TestError
TestError "call stack couldn't be processed"
parseDir :: Path Abs Dir -> String -> f (Path Abs Dir)
parseDir cwd :: Path Abs Dir
cwd dirPrefix :: String
dirPrefix =
String -> f (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parseAbsDir String
dirPrefix f (Path Abs Dir) -> f (Path Abs Dir) -> f (Path Abs Dir)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Path Abs Dir
cwd Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</>) (Path Rel Dir -> Path Abs Dir)
-> f (Path Rel Dir) -> f (Path Abs Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir String
dirPrefix
runTestAutoWith ::
HasCallStack =>
Members [Resource, Embed IO] r =>
(∀ x . Sem r x -> IO x) ->
Sem (Test : Error TestError : Hedgehog IO : r) a ->
TestT IO a
runTestAutoWith :: (forall x. Sem r x -> IO x)
-> Sem (Test : Error TestError : Hedgehog IO : r) a -> TestT IO a
runTestAutoWith run :: forall x. Sem r x -> IO x
run sem :: Sem (Test : Error TestError : Hedgehog IO : r) a
sem =
(forall x. Sem r x -> IO x)
-> Sem (Error TestError : Hedgehog IO : r) a -> TestT IO a
forall (m :: * -> *) (r :: EffectRow) a.
(Monad m, Member (Embed m) r) =>
(forall x. Sem r x -> m x)
-> Sem (Error TestError : Hedgehog m : r) a -> TestT m a
semToTestT forall x. Sem r x -> IO x
run do
Path Abs Dir
base <- Sem (Error TestError : Hedgehog IO : r) (Path Abs Dir)
forall (r :: EffectRow).
(Members '[Error TestError, Embed IO] r, HasCallStack) =>
Sem r (Path Abs Dir)
callingTestDir
Path Abs Dir
-> Sem (Test : Error TestError : Hedgehog IO : r) a
-> Sem (Error TestError : Hedgehog IO : r) a
forall (r :: EffectRow).
Members '[Error TestError, Resource, Embed IO] r =>
Path Abs Dir -> InterpreterFor Test r
interpretTest Path Abs Dir
base Sem (Test : Error TestError : Hedgehog IO : r) a
sem
runTestAuto ::
HasCallStack =>
Sem [Test, Error TestError, Hedgehog IO, Embed IO, Resource, Final IO] a ->
TestT IO a
runTestAuto :: Sem
'[Test, Error TestError, Hedgehog IO, Embed IO, Resource, Final IO]
a
-> TestT IO a
runTestAuto =
(forall x. Sem '[Embed IO, Resource, Final IO] x -> IO x)
-> Sem
'[Test, Error TestError, Hedgehog IO, Embed IO, Resource, Final IO]
a
-> TestT IO a
forall (r :: EffectRow) a.
(HasCallStack, Members '[Resource, Embed IO] r) =>
(forall x. Sem r x -> IO x)
-> Sem (Test : Error TestError : Hedgehog IO : r) a -> TestT IO a
runTestAutoWith (Sem '[Final IO] x -> IO x
forall (m :: * -> *) a. Monad m => Sem '[Final m] a -> m a
runFinal (Sem '[Final IO] x -> IO x)
-> (Sem '[Embed IO, Resource, Final IO] x -> Sem '[Final IO] x)
-> Sem '[Embed IO, Resource, Final IO] x
-> IO x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem '[Resource, Final IO] x -> Sem '[Final IO] x
forall (r :: EffectRow) a.
Member (Final IO) r =>
Sem (Resource : r) a -> Sem r a
resourceToIOFinal (Sem '[Resource, Final IO] x -> Sem '[Final IO] x)
-> (Sem '[Embed IO, Resource, Final IO] x
-> Sem '[Resource, Final IO] x)
-> Sem '[Embed IO, Resource, Final IO] x
-> Sem '[Final IO] x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem '[Embed IO, Resource, Final IO] x
-> Sem '[Resource, Final IO] x
forall (m :: * -> *) (r :: EffectRow) a.
(Member (Final m) r, Functor m) =>
Sem (Embed m : r) a -> Sem r a
embedToFinal)