module HaskellWorks.Polysemy.Hedgehog.Assert
  ( Hedgehog,
    leftFail,
    leftFailM,
    leftFailJson,
    leftFailJsonM,
    nothingFail,
    nothingFailM,
    requireHead,
    catchFail,
    trapFail,
    trapFailJson,
    trapFailJsonPretty,
    trapFailYaml,
    evalIO,
    failure,
    failMessage,
    byDeadlineIO,
    byDeadlineM,
    byDurationIO,
    byDurationM,

    (===),

    assertPidOk,
    assertIsJsonFile_,
    assertIsYamlFile,
    assertFileExists,
    assertFilesExist,
    assertFileMissing,
    assertFilesMissing,
    assertFileOccurences,
    assertFileLines,
    assertEndsWithSingleNewline,
    assertDirectoryExists,
    assertDirectoryMissing,
  ) where


import qualified Control.Concurrent                             as IO
import           Control.Lens                                   ((^.))
import           Data.Aeson                                     (ToJSON, Value)
import qualified Data.Aeson                                     as J
import qualified Data.Aeson.Encode.Pretty                       as J
import           Data.Generics.Product.Any
import qualified Data.List                                      as L
import qualified Data.Text                                      as T
import qualified Data.Text.Encoding                             as T
import qualified Data.Text.Lazy                                 as LT
import qualified Data.Text.Lazy.Encoding                        as LT
import           Data.Time.Clock                                (NominalDiffTime,
                                                                 UTCTime)
import qualified Data.Time.Clock                                as DTC
import qualified Data.Yaml                                      as Y
import qualified GHC.Stack                                      as GHC
import           HaskellWorks.Polysemy.Error
import           HaskellWorks.Polysemy.File
import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog
import           HaskellWorks.Polysemy.Hedgehog.Jot
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

-- | Fail when the result is Left.
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)

-- | Fail when the result is Left with the error message as JSON.
leftFailJson :: ()
  => Member Hedgehog r
  => ToJSON e
  => HasCallStack
  => Either e a
  -> Sem r a
leftFailJson :: forall (r :: EffectRow) e a.
(Member Hedgehog r, ToJSON e, HasCallStack) =>
Either e a -> Sem r a
leftFailJson 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  -> do
    let msg :: String
msg = Text -> String
LT.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
LT.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ e -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode 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
<> String
msg)

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

leftFailJsonM :: forall e r a. ()
  => Member Hedgehog r
  => ToJSON e
  => HasCallStack
  => Sem r (Either e a)
  -> Sem r a
leftFailJsonM :: forall e (r :: EffectRow) a.
(Member Hedgehog r, ToJSON e, HasCallStack) =>
Sem r (Either e a) -> Sem r a
leftFailJsonM 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, ToJSON e, HasCallStack) =>
Either e a -> Sem r a
leftFailJson

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 = do
  Either e a
r <- (HasCallStack => Sem r (Either e a)) -> Sem r (Either e a)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r (Either e a)) -> Sem r (Either e a))
-> (HasCallStack => Sem r (Either e a)) -> Sem r (Either e 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
  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 -> Sem r a) -> String -> Sem r a
forall a b. (a -> b) -> a -> b
$ e -> String
forall a. Show a => a -> String
show e
e

trapFailJson :: forall e r a.()
  => Member Hedgehog r
  => HasCallStack
  => ToJSON e
  => Sem (Error e ': r) a
  -> Sem r a
trapFailJson :: forall e (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack, ToJSON e) =>
Sem (Error e : r) a -> Sem r a
trapFailJson Sem (Error e : r) a
f = do
  Either e a
r <- (HasCallStack => Sem r (Either e a)) -> Sem r (Either e a)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r (Either e a)) -> Sem r (Either e a))
-> (HasCallStack => Sem r (Either e a)) -> Sem r (Either e 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
  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  -> do
      let msg :: String
msg = Text -> String
LT.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
LT.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ e -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode 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
msg

trapFailJsonPretty :: forall e r a.()
  => Member Hedgehog r
  => HasCallStack
  => ToJSON e
  => Sem (Error e ': r) a
  -> Sem r a
trapFailJsonPretty :: forall e (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack, ToJSON e) =>
Sem (Error e : r) a -> Sem r a
trapFailJsonPretty Sem (Error e : r) a
f = do
  Either e a
r <- (HasCallStack => Sem r (Either e a)) -> Sem r (Either e a)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r (Either e a)) -> Sem r (Either e a))
-> (HasCallStack => Sem r (Either e a)) -> Sem r (Either e 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
  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  -> do
      let msg :: String
msg = Text -> String
LT.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
LT.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ e -> ByteString
forall a. ToJSON a => a -> ByteString
J.encodePretty 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
msg

trapFailYaml :: forall e r a.()
  => Member Hedgehog r
  => HasCallStack
  => ToJSON e
  => Sem (Error e ': r) a
  -> Sem r a
trapFailYaml :: forall e (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack, ToJSON e) =>
Sem (Error e : r) a -> Sem r a
trapFailYaml Sem (Error e : r) a
f = do
  Either e a
r <- (HasCallStack => Sem r (Either e a)) -> Sem r (Either e a)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r (Either e a)) -> Sem r (Either e a))
-> (HasCallStack => Sem r (Either e a)) -> Sem r (Either e 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
  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  -> do
      let msg :: String
msg = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ e -> ByteString
forall a. ToJSON a => a -> ByteString
Y.encode 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
msg

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

-- | Assert the 'filePath' can be parsed as JSON.
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"))

-- | Assert the 'filePath' can be parsed as YAML.
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"))

-- | Asserts that the given file exists.
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.")

-- | Asserts that all of the given files exist.
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

-- | Asserts that the given file is missing.
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.")

-- | Asserts that all of the given files are missing.
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

-- | Assert the file contains the given number of occurrences of the given string
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 String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`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

-- | Assert the file contains the given number of occurrences of the given string
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")

-- | Assert the file contains the given number of occurrences of the given string
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.")

-- | Asserts that the given directory exists.
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.")

-- | Asserts that the given directory is missing.
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.")

byDeadlineIO :: ()
  => HasCallStack
  => Member (Embed m) r
  => Member (Embed IO) r
  => Member Hedgehog r
  => Member Log r
  => NominalDiffTime
  -> UTCTime
  -> String
  -> m a
  -> Sem r a
byDeadlineIO :: forall (m :: * -> *) (r :: EffectRow) a.
(HasCallStack, Member (Embed m) r, Member (Embed IO) r,
 Member Hedgehog r, Member Log r) =>
NominalDiffTime -> UTCTime -> String -> m a -> Sem r a
byDeadlineIO NominalDiffTime
period UTCTime
deadline String
errorMessage m a
f = (HasCallStack => Sem r a) -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r a) -> Sem r a)
-> (HasCallStack => Sem r a) -> Sem r a
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> UTCTime -> String -> Sem r a -> Sem r a
forall (r :: EffectRow) a.
(HasCallStack, Member Hedgehog r, Member Log r,
 Member (Embed IO) r) =>
NominalDiffTime -> UTCTime -> String -> Sem r a -> Sem r a
byDeadlineM NominalDiffTime
period UTCTime
deadline String
errorMessage (Sem r a -> Sem r a) -> Sem r a -> Sem r a
forall a b. (a -> b) -> a -> b
$ m a -> Sem r a
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed m a
f

-- | Run the operation 'f' once a second until it returns 'True' or the deadline expires.
--
-- Expiration of the deadline results in an assertion failure
byDeadlineM ::  ()
  => HasCallStack
  => Member Hedgehog r
  => Member Log r
  => Member (Embed IO) r
  => NominalDiffTime
  -> UTCTime
  -> String
  -> Sem r a
  -> Sem r a
byDeadlineM :: forall (r :: EffectRow) a.
(HasCallStack, Member Hedgehog r, Member Log r,
 Member (Embed IO) r) =>
NominalDiffTime -> UTCTime -> String -> Sem r a -> Sem r a
byDeadlineM NominalDiffTime
period UTCTime
deadline String
errorMessage Sem r a
f = (HasCallStack => Sem r a) -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r a) -> Sem r a)
-> (HasCallStack => Sem r a) -> Sem r a
forall a b. (a -> b) -> a -> b
$ do
  UTCTime
start <- IO UTCTime -> Sem r UTCTime
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed IO UTCTime
DTC.getCurrentTime
  a
a <- Sem r a
goM
  UTCTime
end <- IO UTCTime -> Sem r UTCTime
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed IO UTCTime
DTC.getCurrentTime
  String -> Sem r ()
forall (r :: EffectRow) s.
(Member Hedgehog r, HasCallStack, ToString s) =>
s -> Sem r ()
jot_ (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ String
"Operation completed in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> String
forall a. Show a => a -> String
show (UTCTime -> UTCTime -> NominalDiffTime
DTC.diffUTCTime UTCTime
end UTCTime
start)
  a -> Sem r a
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  where goM :: Sem r a
goM = Sem r a -> (Failure -> Sem r a) -> Sem r a
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
Sem r a -> (Failure -> Sem r a) -> Sem r a
catchAssertion Sem r a
f ((Failure -> Sem r a) -> Sem r a)
-> (Failure -> Sem r a) -> Sem r a
forall a b. (a -> b) -> a -> b
$ \Failure
e -> do
          UTCTime
currentTime <- IO UTCTime -> Sem r UTCTime
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed IO UTCTime
DTC.getCurrentTime
          if UTCTime
currentTime UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
deadline
            then do
              IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r ()) -> IO () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
IO.threadDelay (Pico -> Int
forall b. Integral b => Pico -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (NominalDiffTime -> Pico
DTC.nominalDiffTimeToSeconds NominalDiffTime
period Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
* Pico
1000000))
              Sem r a
goM
            else do
              UTCTime -> Sem r ()
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack, Show a) =>
a -> Sem r ()
jotShow_ UTCTime
currentTime
              Sem r Any -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r Any -> Sem r ()) -> Sem r Any -> Sem r ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> Sem r Any
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack (String -> Sem r Any) -> String -> Sem r Any
forall a b. (a -> b) -> a -> b
$ String
"Condition not met by deadline: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
errorMessage
              Failure -> Sem r a
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
Failure -> Sem r a
throwAssertion Failure
e

-- | Run the operation 'f' once a second until it returns 'True' or the duration expires.
--
-- Expiration of the duration results in an assertion failure
byDurationIO :: ()
  => HasCallStack
  => Member (Embed m) r
  => Member (Embed IO) r
  => Member Hedgehog r
  => Member Log r
  => NominalDiffTime
  -> NominalDiffTime
  -> String
  -> m b
  -> Sem r b
byDurationIO :: forall (m :: * -> *) (r :: EffectRow) b.
(HasCallStack, Member (Embed m) r, Member (Embed IO) r,
 Member Hedgehog r, Member Log r) =>
NominalDiffTime -> NominalDiffTime -> String -> m b -> Sem r b
byDurationIO NominalDiffTime
period NominalDiffTime
duration String
errorMessage m b
f =
  (HasCallStack => Sem r b) -> Sem r b
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r b) -> Sem r b)
-> (HasCallStack => Sem r b) -> Sem r b
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> NominalDiffTime -> String -> Sem r b -> Sem r b
forall (r :: EffectRow) b.
(HasCallStack, Member (Embed IO) r, Member Hedgehog r,
 Member Log r) =>
NominalDiffTime -> NominalDiffTime -> String -> Sem r b -> Sem r b
byDurationM NominalDiffTime
period NominalDiffTime
duration String
errorMessage (Sem r b -> Sem r b) -> Sem r b -> Sem r b
forall a b. (a -> b) -> a -> b
$ m b -> Sem r b
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed m b
f

-- | Run the operation 'f' once a second until it returns 'True' or the duration expires.
--
-- Expiration of the duration results in an assertion failure
byDurationM :: ()
  => HasCallStack
  => Member (Embed IO) r
  => Member Hedgehog r
  => Member Log r
  => NominalDiffTime
  -> NominalDiffTime
  -> String
  -> Sem r b
  -> Sem r b
byDurationM :: forall (r :: EffectRow) b.
(HasCallStack, Member (Embed IO) r, Member Hedgehog r,
 Member Log r) =>
NominalDiffTime -> NominalDiffTime -> String -> Sem r b -> Sem r b
byDurationM NominalDiffTime
period NominalDiffTime
duration String
errorMessage Sem r b
f = (HasCallStack => Sem r b) -> Sem r b
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r b) -> Sem r b)
-> (HasCallStack => Sem r b) -> Sem r b
forall a b. (a -> b) -> a -> b
$ do
  UTCTime
deadline <- NominalDiffTime -> UTCTime -> UTCTime
DTC.addUTCTime NominalDiffTime
duration (UTCTime -> UTCTime) -> Sem r UTCTime -> Sem r UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime -> Sem r UTCTime
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed IO UTCTime
DTC.getCurrentTime
  NominalDiffTime -> UTCTime -> String -> Sem r b -> Sem r b
forall (r :: EffectRow) a.
(HasCallStack, Member Hedgehog r, Member Log r,
 Member (Embed IO) r) =>
NominalDiffTime -> UTCTime -> String -> Sem r a -> Sem r a
byDeadlineM NominalDiffTime
period UTCTime
deadline String
errorMessage Sem r b
f