module HaskellWorks.Polysemy.Hedgehog.Assert
( Hedgehog,
leftFail,
leftFailM,
nothingFail,
nothingFailM,
requireHead,
catchFail,
trapFail,
evalIO,
failure,
failMessage,
(===),
assertPidOk,
assertIsJsonFile_,
assertIsYamlFile,
assertFileExists,
assertFilesExist,
assertFileMissing,
assertFilesMissing,
assertFileOccurences,
assertFileLines,
assertEndsWithSingleNewline,
assertDirectoryExists,
assertDirectoryMissing,
) where
import Control.Lens ((^.))
import Data.Aeson (Value)
import Data.Generics.Product.Any
import qualified Data.List as L
import qualified GHC.Stack as GHC
import HaskellWorks.Polysemy.Error
import HaskellWorks.Polysemy.File
import HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog
import HaskellWorks.Polysemy.Prelude
import HaskellWorks.Polysemy.System.Directory
import HaskellWorks.Polysemy.System.IO as IO
import HaskellWorks.Polysemy.System.Process
import Polysemy
import Polysemy.Error
import Polysemy.Log
(===) :: ()
=> Member Hedgehog r
=> Eq a
=> Show a
=> HasCallStack
=> a
-> a
-> Sem r ()
=== :: forall (r :: EffectRow) a.
(Member Hedgehog r, Eq a, Show a, HasCallStack) =>
a -> a -> Sem r ()
(===) a
a a
b = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ a -> a -> Sem r ()
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack, Eq a, Show a) =>
a -> a -> Sem r ()
assertEquals a
a a
b
leftFail :: ()
=> Member Hedgehog r
=> Show e
=> HasCallStack
=> Either e a
-> Sem r a
leftFail :: forall (r :: EffectRow) e a.
(Member Hedgehog r, Show e, HasCallStack) =>
Either e a -> Sem r a
leftFail Either e a
r = (HasCallStack => Sem r a) -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r a) -> Sem r a)
-> (HasCallStack => Sem r a) -> Sem r a
forall a b. (a -> b) -> a -> b
$ case Either e a
r of
Right a
a -> a -> Sem r a
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
Left e
e -> CallStack -> String -> Sem r a
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack (String
"Expected Right: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> e -> String
forall a. Show a => a -> String
show e
e)
nothingFail :: ()
=> Member Hedgehog r
=> HasCallStack
=> Maybe a
-> Sem r a
nothingFail :: forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
Maybe a -> Sem r a
nothingFail Maybe a
r = (HasCallStack => Sem r a) -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r a) -> Sem r a)
-> (HasCallStack => Sem r a) -> Sem r a
forall a b. (a -> b) -> a -> b
$ case Maybe a
r of
Just a
a -> a -> Sem r a
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Maybe a
Nothing -> CallStack -> String -> Sem r a
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack String
"Expected Just"
failure :: ()
=> Member Hedgehog r
=> HasCallStack
=> Sem r a
failure :: forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
Sem r a
failure =
(HasCallStack => Sem r a) -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r a) -> Sem r a)
-> (HasCallStack => Sem r a) -> Sem r a
forall a b. (a -> b) -> a -> b
$ Maybe Diff -> String -> Sem r a
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
Maybe Diff -> String -> Sem r a
failWith Maybe Diff
forall a. Maybe a
Nothing String
""
failMessage :: ()
=> Member Hedgehog r
=> HasCallStack
=> GHC.CallStack
-> String
-> Sem r a
failMessage :: forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
cs =
(HasCallStack => String -> Sem r a) -> String -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => String -> Sem r a) -> String -> Sem r a)
-> (HasCallStack => String -> Sem r a) -> String -> Sem r a
forall a b. (a -> b) -> a -> b
$ CallStack -> Maybe Diff -> String -> Sem r a
forall (r :: EffectRow) a.
Member Hedgehog r =>
CallStack -> Maybe Diff -> String -> Sem r a
failWithCustom CallStack
cs Maybe Diff
forall a. Maybe a
Nothing
leftFailM :: forall e r a. ()
=> Member Hedgehog r
=> Show e
=> HasCallStack
=> Sem r (Either e a)
-> Sem r a
leftFailM :: forall e (r :: EffectRow) a.
(Member Hedgehog r, Show e, HasCallStack) =>
Sem r (Either e a) -> Sem r a
leftFailM Sem r (Either e a)
f =
(HasCallStack => Sem r a) -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r a) -> Sem r a)
-> (HasCallStack => Sem r a) -> Sem r a
forall a b. (a -> b) -> a -> b
$ Sem r (Either e a)
f Sem r (Either e a) -> (Either e a -> Sem r a) -> Sem r a
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either e a -> Sem r a
forall (r :: EffectRow) e a.
(Member Hedgehog r, Show e, HasCallStack) =>
Either e a -> Sem r a
leftFail
nothingFailM :: forall r a. ()
=> Member Hedgehog r
=> HasCallStack
=> Sem r (Maybe a)
-> Sem r a
nothingFailM :: forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
Sem r (Maybe a) -> Sem r a
nothingFailM Sem r (Maybe a)
f =
(HasCallStack => Sem r a) -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r a) -> Sem r a)
-> (HasCallStack => Sem r a) -> Sem r a
forall a b. (a -> b) -> a -> b
$ Sem r (Maybe a)
f Sem r (Maybe a) -> (Maybe a -> Sem r a) -> Sem r a
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe a -> Sem r a
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
Maybe a -> Sem r a
nothingFail
catchFail :: forall e r a.()
=> Member Hedgehog r
=> HasCallStack
=> Show e
=> Sem (Error e ': r) a
-> Sem r a
catchFail :: forall e (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack, Show e) =>
Sem (Error e : r) a -> Sem r a
catchFail Sem (Error e : r) a
f =
(HasCallStack => Sem r a) -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r a) -> Sem r a)
-> (HasCallStack => Sem r a) -> Sem r a
forall a b. (a -> b) -> a -> b
$ Sem (Error e : r) a
f Sem (Error e : r) a
-> (Sem (Error e : r) a -> Sem r (Either e a))
-> Sem r (Either e a)
forall a b. a -> (a -> b) -> b
& Sem (Error e : r) a -> Sem r (Either e a)
forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError Sem r (Either e a) -> (Sem r (Either e a) -> Sem r a) -> Sem r a
forall a b. a -> (a -> b) -> b
& Sem r (Either e a) -> Sem r a
forall e (r :: EffectRow) a.
(Member Hedgehog r, Show e, HasCallStack) =>
Sem r (Either e a) -> Sem r a
leftFailM
{-# DEPRECATED catchFail "Use trapFail instead" #-}
trapFail :: forall e r a.()
=> Member Hedgehog r
=> HasCallStack
=> Show e
=> Sem (Error e ': r) a
-> Sem r a
trapFail :: forall e (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack, Show e) =>
Sem (Error e : r) a -> Sem r a
trapFail Sem (Error e : r) a
f =
(HasCallStack => Sem r a) -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r a) -> Sem r a)
-> (HasCallStack => Sem r a) -> Sem r a
forall a b. (a -> b) -> a -> b
$ Sem (Error e : r) a
f Sem (Error e : r) a
-> (Sem (Error e : r) a -> Sem r (Either e a))
-> Sem r (Either e a)
forall a b. a -> (a -> b) -> b
& Sem (Error e : r) a -> Sem r (Either e a)
forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError Sem r (Either e a) -> (Sem r (Either e a) -> Sem r a) -> Sem r a
forall a b. a -> (a -> b) -> b
& Sem r (Either e a) -> Sem r a
forall e (r :: EffectRow) a.
(Member Hedgehog r, Show e, HasCallStack) =>
Sem r (Either e a) -> Sem r a
leftFailM
requireHead :: ()
=> Member Hedgehog r
=> HasCallStack
=> [a]
-> Sem r a
requireHead :: forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
[a] -> Sem r a
requireHead = (HasCallStack => [a] -> Sem r a) -> [a] -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => [a] -> Sem r a) -> [a] -> Sem r a)
-> (HasCallStack => [a] -> Sem r a) -> [a] -> Sem r a
forall a b. (a -> b) -> a -> b
$
\case
[] -> CallStack -> String -> Sem r a
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack String
"Cannot take head of empty list"
(a
x:[a]
_) -> a -> Sem r a
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
assertPidOk :: ()
=> HasCallStack
=> Member Hedgehog r
=> Member (Embed IO) r
=> Member (Error IOException) r
=> ProcessHandle
-> Sem r Pid
assertPidOk :: forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Embed IO) r,
Member (Error IOException) r) =>
ProcessHandle -> Sem r Pid
assertPidOk ProcessHandle
hProcess = (HasCallStack => Sem r Pid) -> Sem r Pid
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r Pid) -> Sem r Pid)
-> (HasCallStack => Sem r Pid) -> Sem r Pid
forall a b. (a -> b) -> a -> b
$
Sem r (Maybe Pid) -> Sem r Pid
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
Sem r (Maybe a) -> Sem r a
nothingFailM (Sem r (Maybe Pid) -> Sem r Pid) -> Sem r (Maybe Pid) -> Sem r Pid
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> Sem r (Maybe Pid)
forall (r :: EffectRow).
(Member (Embed IO) r, Member (Error IOException) r) =>
ProcessHandle -> Sem r (Maybe Pid)
getPid ProcessHandle
hProcess
assertIsJsonFile_ :: ()
=> HasCallStack
=> Member Hedgehog r
=> Member (Embed IO) r
=> Member Log r
=> FilePath
-> Sem r ()
assertIsJsonFile_ :: forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Embed IO) r,
Member Log r) =>
String -> Sem r ()
assertIsJsonFile_ String
fp = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
Sem (Error IOException : Error JsonDecodeError : r) Value
-> Sem (Error IOException : Error JsonDecodeError : r) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall a (r :: EffectRow).
(FromJSON a, HasCallStack, Member (Error IOException) r,
Member (Error JsonDecodeError) r, Member (Embed IO) r,
Member Log r) =>
String -> Sem r a
readJsonFile @Value String
fp)
Sem (Error IOException : Error JsonDecodeError : r) ()
-> (Sem (Error IOException : Error JsonDecodeError : r) ()
-> Sem (Error JsonDecodeError : r) ())
-> Sem (Error JsonDecodeError : r) ()
forall a b. a -> (a -> b) -> b
& forall e (r :: EffectRow) a.
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @IOException (CallStack -> String -> Sem (Error JsonDecodeError : r) ()
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack (String -> Sem (Error JsonDecodeError : r) ())
-> (IOException -> String)
-> IOException
-> Sem (Error JsonDecodeError : r) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall a. Show a => a -> String
show)
Sem (Error JsonDecodeError : r) ()
-> (Sem (Error JsonDecodeError : r) () -> Sem r ()) -> Sem r ()
forall a b. a -> (a -> b) -> b
& forall e (r :: EffectRow) a.
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @JsonDecodeError (\JsonDecodeError
e -> CallStack -> String -> Sem r ()
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack (JsonDecodeError
e JsonDecodeError -> Getting String JsonDecodeError String -> String
forall s a. s -> Getting a s a -> a
^. forall {k} (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall (sel :: Symbol) s t a b. HasAny sel s t a b => Lens s t a b
the @"message"))
assertIsYamlFile :: ()
=> HasCallStack
=> Member Hedgehog r
=> Member (Embed IO) r
=> Member Log r
=> FilePath
-> Sem r ()
assertIsYamlFile :: forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Embed IO) r,
Member Log r) =>
String -> Sem r ()
assertIsYamlFile String
fp = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
Sem
(Error IOException
: Error JsonDecodeError : Error YamlDecodeError : r)
Value
-> Sem
(Error IOException
: Error JsonDecodeError : Error YamlDecodeError : r)
()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall a (r :: EffectRow).
(FromJSON a, HasCallStack, Member (Error IOException) r,
Member (Error JsonDecodeError) r, Member (Error YamlDecodeError) r,
Member (Embed IO) r, Member Log r) =>
String -> Sem r a
readYamlFile @Value String
fp)
Sem
(Error IOException
: Error JsonDecodeError : Error YamlDecodeError : r)
()
-> (Sem
(Error IOException
: Error JsonDecodeError : Error YamlDecodeError : r)
()
-> Sem (Error JsonDecodeError : Error YamlDecodeError : r) ())
-> Sem (Error JsonDecodeError : Error YamlDecodeError : r) ()
forall a b. a -> (a -> b) -> b
& forall e (r :: EffectRow) a.
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @IOException (CallStack
-> String
-> Sem (Error JsonDecodeError : Error YamlDecodeError : r) ()
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack (String
-> Sem (Error JsonDecodeError : Error YamlDecodeError : r) ())
-> (IOException -> String)
-> IOException
-> Sem (Error JsonDecodeError : Error YamlDecodeError : r) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall a. Show a => a -> String
show)
Sem (Error JsonDecodeError : Error YamlDecodeError : r) ()
-> (Sem (Error JsonDecodeError : Error YamlDecodeError : r) ()
-> Sem (Error YamlDecodeError : r) ())
-> Sem (Error YamlDecodeError : r) ()
forall a b. a -> (a -> b) -> b
& forall e (r :: EffectRow) a.
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @JsonDecodeError (\JsonDecodeError
e -> CallStack -> String -> Sem (Error YamlDecodeError : r) ()
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack (JsonDecodeError
e JsonDecodeError -> Getting String JsonDecodeError String -> String
forall s a. s -> Getting a s a -> a
^. forall {k} (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall (sel :: Symbol) s t a b. HasAny sel s t a b => Lens s t a b
the @"message"))
Sem (Error YamlDecodeError : r) ()
-> (Sem (Error YamlDecodeError : r) () -> Sem r ()) -> Sem r ()
forall a b. a -> (a -> b) -> b
& forall e (r :: EffectRow) a.
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @YamlDecodeError (\YamlDecodeError
e -> CallStack -> String -> Sem r ()
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack (YamlDecodeError
e YamlDecodeError -> Getting String YamlDecodeError String -> String
forall s a. s -> Getting a s a -> a
^. forall {k} (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall (sel :: Symbol) s t a b. HasAny sel s t a b => Lens s t a b
the @"message"))
assertFileExists :: ()
=> HasCallStack
=> Member Hedgehog r
=> Member (Embed IO) r
=> Member Log r
=> FilePath
-> Sem r ()
assertFileExists :: forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Embed IO) r,
Member Log r) =>
String -> Sem r ()
assertFileExists String
file = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
Bool
exists <- String -> Sem (Error IOException : r) Bool
forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
Member Log r) =>
String -> Sem r Bool
doesFileExist String
file
Sem (Error IOException : r) Bool
-> (Sem (Error IOException : r) Bool -> Sem r Bool) -> Sem r Bool
forall a b. a -> (a -> b) -> b
& forall e (r :: EffectRow) a.
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @IOException (Sem r Bool -> IOException -> Sem r Bool
forall a b. a -> b -> a
const (Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False))
Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ CallStack -> Maybe Diff -> String -> Sem r ()
forall (r :: EffectRow) a.
Member Hedgehog r =>
CallStack -> Maybe Diff -> String -> Sem r a
failWithCustom CallStack
HasCallStack => CallStack
GHC.callStack Maybe Diff
forall a. Maybe a
Nothing (String
file String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" has not been successfully created.")
assertFilesExist :: ()
=> HasCallStack
=> Member Hedgehog r
=> Member (Embed IO) r
=> Member Log r
=> [FilePath]
-> Sem r ()
assertFilesExist :: forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Embed IO) r,
Member Log r) =>
[String] -> Sem r ()
assertFilesExist [String]
files =
(HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ [String] -> (String -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [String]
files String -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Embed IO) r,
Member Log r) =>
String -> Sem r ()
assertFileExists
assertFileMissing :: ()
=> HasCallStack
=> Member Hedgehog r
=> Member (Embed IO) r
=> Member Log r
=> FilePath
-> Sem r ()
assertFileMissing :: forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Embed IO) r,
Member Log r) =>
String -> Sem r ()
assertFileMissing String
file = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
Bool
exists <- String -> Sem (Error IOException : r) Bool
forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
Member Log r) =>
String -> Sem r Bool
doesFileExist String
file
Sem (Error IOException : r) Bool
-> (Sem (Error IOException : r) Bool -> Sem r Bool) -> Sem r Bool
forall a b. a -> (a -> b) -> b
& forall e (r :: EffectRow) a.
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @IOException (Sem r Bool -> IOException -> Sem r Bool
forall a b. a -> b -> a
const (Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False))
Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ CallStack -> Maybe Diff -> String -> Sem r ()
forall (r :: EffectRow) a.
Member Hedgehog r =>
CallStack -> Maybe Diff -> String -> Sem r a
failWithCustom CallStack
HasCallStack => CallStack
GHC.callStack Maybe Diff
forall a. Maybe a
Nothing (String
file String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" should not have been created.")
assertFilesMissing :: ()
=> HasCallStack
=> Member Hedgehog r
=> Member (Embed IO) r
=> Member Log r
=> [FilePath]
-> Sem r ()
assertFilesMissing :: forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Embed IO) r,
Member Log r) =>
[String] -> Sem r ()
assertFilesMissing [String]
files =
(HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ [String] -> (String -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [String]
files String -> Sem r ()
forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Embed IO) r,
Member Log r) =>
String -> Sem r ()
assertFileMissing
assertFileOccurences :: ()
=> HasCallStack
=> Member Hedgehog r
=> Member (Embed IO) r
=> Member Log r
=> Int -> String -> FilePath -> Sem r ()
assertFileOccurences :: forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Embed IO) r,
Member Log r) =>
Int -> String -> String -> Sem r ()
assertFileOccurences Int
n String
s String
fp = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
String
contents <- String -> Sem (Error IOException : r) String
forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
Member Log r) =>
String -> Sem r String
readFile String
fp
Sem (Error IOException : r) String
-> (Sem (Error IOException : r) String -> Sem r String)
-> Sem r String
forall a b. a -> (a -> b) -> b
& forall e (r :: EffectRow) a.
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @IOException (CallStack -> String -> Sem r String
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack (String -> Sem r String)
-> (IOException -> String) -> IOException -> Sem r String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall a. Show a => a -> String
show)
[String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (String
s `L.isInfixOf`) (String -> [String]
L.lines String
contents)) Int -> Int -> Sem r ()
forall (r :: EffectRow) a.
(Member Hedgehog r, Eq a, Show a, HasCallStack) =>
a -> a -> Sem r ()
=== Int
n
assertFileLines :: ()
=> HasCallStack
=> Member Hedgehog r
=> Member (Embed IO) r
=> Member Log r
=> (Int -> Bool)
-> FilePath
-> Sem r ()
assertFileLines :: forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Embed IO) r,
Member Log r) =>
(Int -> Bool) -> String -> Sem r ()
assertFileLines Int -> Bool
p String
fp = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
String
contents <- String -> Sem (Error IOException : r) String
forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
Member Log r) =>
String -> Sem r String
readFile String
fp
Sem (Error IOException : r) String
-> (Sem (Error IOException : r) String -> Sem r String)
-> Sem r String
forall a b. a -> (a -> b) -> b
& forall e (r :: EffectRow) a.
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @IOException (CallStack -> String -> Sem r String
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack (String -> Sem r String)
-> (IOException -> String) -> IOException -> Sem r String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall a. Show a => a -> String
show)
let lines :: [String]
lines = String -> [String]
L.lines String
contents
let len :: Int
len = case [String] -> [String]
forall a. [a] -> [a]
L.reverse [String]
lines of
String
"":[String]
xs -> [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [String]
xs
[String]
xs -> [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [String]
xs
Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Bool
p Int
len) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
CallStack -> Maybe Diff -> String -> Sem r ()
forall (r :: EffectRow) a.
Member Hedgehog r =>
CallStack -> Maybe Diff -> String -> Sem r a
failWithCustom CallStack
HasCallStack => CallStack
GHC.callStack Maybe Diff
forall a. Maybe a
Nothing (String
fp String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" has an unexpected number of lines")
assertEndsWithSingleNewline :: ()
=> HasCallStack
=> Member Hedgehog r
=> Member (Embed IO) r
=> Member Log r
=> FilePath
-> Sem r ()
assertEndsWithSingleNewline :: forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Embed IO) r,
Member Log r) =>
String -> Sem r ()
assertEndsWithSingleNewline String
fp = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
String
contents <- String -> Sem (Error IOException : r) String
forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
Member Log r) =>
String -> Sem r String
readFile String
fp
Sem (Error IOException : r) String
-> (Sem (Error IOException : r) String -> Sem r String)
-> Sem r String
forall a b. a -> (a -> b) -> b
& forall e (r :: EffectRow) a.
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @IOException (CallStack -> String -> Sem r String
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack (String -> Sem r String)
-> (IOException -> String) -> IOException -> Sem r String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall a. Show a => a -> String
show)
case String -> String
forall a. [a] -> [a]
L.reverse String
contents of
Char
'\n':Char
'\n':String
_ -> CallStack -> Maybe Diff -> String -> Sem r ()
forall (r :: EffectRow) a.
Member Hedgehog r =>
CallStack -> Maybe Diff -> String -> Sem r a
failWithCustom CallStack
HasCallStack => CallStack
GHC.callStack Maybe Diff
forall a. Maybe a
Nothing (String
fp String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" ends with too many newlines.")
Char
'\n':String
_ -> () -> Sem r ()
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
String
_ -> CallStack -> Maybe Diff -> String -> Sem r ()
forall (r :: EffectRow) a.
Member Hedgehog r =>
CallStack -> Maybe Diff -> String -> Sem r a
failWithCustom CallStack
HasCallStack => CallStack
GHC.callStack Maybe Diff
forall a. Maybe a
Nothing (String
fp String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" must end with newline.")
assertDirectoryExists :: ()
=> HasCallStack
=> Member Hedgehog r
=> Member (Embed IO) r
=> Member Log r
=> FilePath
-> Sem r ()
assertDirectoryExists :: forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Embed IO) r,
Member Log r) =>
String -> Sem r ()
assertDirectoryExists String
dir = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
Bool
exists <- String -> Sem (Error IOException : r) Bool
forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
Member Log r) =>
String -> Sem r Bool
doesDirectoryExist String
dir
Sem (Error IOException : r) Bool
-> (Sem (Error IOException : r) Bool -> Sem r Bool) -> Sem r Bool
forall a b. a -> (a -> b) -> b
& forall e (r :: EffectRow) a.
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @IOException (Sem r Bool -> IOException -> Sem r Bool
forall a b. a -> b -> a
const (Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False))
Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ CallStack -> Maybe Diff -> String -> Sem r ()
forall (r :: EffectRow) a.
Member Hedgehog r =>
CallStack -> Maybe Diff -> String -> Sem r a
failWithCustom CallStack
HasCallStack => CallStack
GHC.callStack Maybe Diff
forall a. Maybe a
Nothing (String
"Directory '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
dir String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' does not exist on the file system.")
assertDirectoryMissing :: ()
=> HasCallStack
=> Member Hedgehog r
=> Member Log r
=> Member (Embed IO) r
=> FilePath
-> Sem r ()
assertDirectoryMissing :: forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member Log r,
Member (Embed IO) r) =>
String -> Sem r ()
assertDirectoryMissing String
dir = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
Bool
exists <- String -> Sem (Error IOException : r) Bool
forall (r :: EffectRow).
(HasCallStack, Member (Error IOException) r, Member (Embed IO) r,
Member Log r) =>
String -> Sem r Bool
doesDirectoryExist String
dir
Sem (Error IOException : r) Bool
-> (Sem (Error IOException : r) Bool -> Sem r Bool) -> Sem r Bool
forall a b. a -> (a -> b) -> b
& forall e (r :: EffectRow) a.
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @IOException (Sem r Bool -> IOException -> Sem r Bool
forall a b. a -> b -> a
const (Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False))
Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ CallStack -> Maybe Diff -> String -> Sem r ()
forall (r :: EffectRow) a.
Member Hedgehog r =>
CallStack -> Maybe Diff -> String -> Sem r a
failWithCustom CallStack
HasCallStack => CallStack
GHC.callStack Maybe Diff
forall a. Maybe a
Nothing (String
"Directory '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
dir String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"' does exist on the file system.")