module HaskellWorks.Polysemy.Hedgehog.Assert
  ( Hedgehog,
    leftFail,
    leftFailM,
    leftFailJson,
    leftFailJsonM,
    leftFailJsonPretty,
    leftFailJsonPrettyM,
    leftFailPretty,
    leftFailPrettyM,
    leftFailYaml,
    leftFailYamlM,
    nothingFail,
    nothingFailM,
    requireHead,
    catchFail,
    trapFail,
    trapFailJson,
    trapFailJsonPretty,
    trapFailYaml,
    evalIO,
    failure,
    failMessage,
    failMessageText,
    byDeadlineIO,
    byDeadlineM,
    byDurationIO,
    byDurationM,

    (===),

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


import qualified Control.Concurrent                             as IO
import           Data.Aeson                                     (ToJSON, Value)
import qualified Data.Aeson                                     as J
import qualified Data.Aeson.Encode.Pretty                       as J
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           Prettyprinter                                  (Pretty)
import qualified Prettyprinter                                  as PP
import qualified Prettyprinter.Render.String                    as PP

import           Control.Monad.IO.Class                         (MonadIO (..))
import           HaskellWorks.Polysemy.System.IO                as IO
import           HaskellWorks.Polysemy.System.Process
import           Polysemy
import           Polysemy.Error
import           Polysemy.Log
import qualified System.IO                                      as IOIO

(===) :: forall a r. ()
  => Member Hedgehog r
  => Eq a
  => Show a
  => HasCallStack
  => a
  -> a
  -> Sem r ()
=== :: forall a (r :: EffectRow).
(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 :: forall e a r. ()
  => Member Hedgehog r
  => Show e
  => HasCallStack
  => Either e a
  -> Sem r a
leftFail :: forall e a (r :: EffectRow).
(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 a (r :: EffectRow).
(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 :: forall a r. ()
  => Member Hedgehog r
  => HasCallStack
  => Maybe a
  -> Sem r a
nothingFail :: forall a (r :: EffectRow).
(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 a (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack String
"Expected Just"

failure :: forall a r. ()
  => Member Hedgehog r
  => HasCallStack
  => Sem r a
failure :: forall a (r :: EffectRow).
(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 :: forall a r. ()
  => Member Hedgehog r
  => HasCallStack
  => GHC.CallStack
  -> String
  -> Sem r a
failMessage :: forall a (r :: EffectRow).
(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

failMessageText :: forall a r. ()
  => Member Hedgehog r
  => HasCallStack
  => GHC.CallStack
  -> Text
  -> Sem r a
failMessageText :: forall a (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
CallStack -> Text -> Sem r a
failMessageText CallStack
cs =
  CallStack -> String -> Sem r a
forall a (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
cs (String -> Sem r a) -> (Text -> String) -> Text -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

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

-- | Fail when the result is Left with the error message as JSON.
leftFailJson :: forall e a r. ()
  => Member Hedgehog r
  => ToJSON e
  => HasCallStack
  => Either e a
  -> Sem r a
leftFailJson :: forall e a (r :: EffectRow).
(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 a (r :: EffectRow).
(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)

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

-- | Fail when the result is Left with the error message as JSON.
leftFailPretty :: forall e a r. ()
  => Member Hedgehog r
  => Pretty e
  => HasCallStack
  => Either e a
  -> Sem r a
leftFailPretty :: forall e a (r :: EffectRow).
(Member Hedgehog r, Pretty e, HasCallStack) =>
Either e a -> Sem r a
leftFailPretty 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 = SimpleDocStream Any -> String
forall ann. SimpleDocStream ann -> String
PP.renderString (SimpleDocStream Any -> String) -> SimpleDocStream Any -> String
forall a b. (a -> b) -> a -> b
$ LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
PP.layoutPretty LayoutOptions
PP.defaultLayoutOptions (Doc Any -> SimpleDocStream Any) -> Doc Any -> SimpleDocStream Any
forall a b. (a -> b) -> a -> b
$ e -> Doc Any
forall ann. e -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty e
e
      CallStack -> String -> Sem r a
forall a (r :: EffectRow).
(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)

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

-- | Fail when the result is Left with the error message as JSON.
leftFailJsonPretty :: forall e a r. ()
  => Member Hedgehog r
  => ToJSON e
  => HasCallStack
  => Either e a
  -> Sem r a
leftFailJsonPretty :: forall e a (r :: EffectRow).
(Member Hedgehog r, ToJSON e, HasCallStack) =>
Either e a -> Sem r a
leftFailJsonPretty 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.encodePretty e
e
    CallStack -> String -> Sem r a
forall a (r :: EffectRow).
(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)

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

-- | Fail when the result is Left with the error message as JSON.
leftFailYaml :: forall e a r. ()
  => Member Hedgehog r
  => ToJSON e
  => HasCallStack
  => Either e a
  -> Sem r a
leftFailYaml :: forall e a (r :: EffectRow).
(Member Hedgehog r, ToJSON e, HasCallStack) =>
Either e a -> Sem r a
leftFailYaml 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
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 a (r :: EffectRow).
(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)

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

nothingFailM :: forall a r. ()
  => Member Hedgehog r
  => HasCallStack
  => Sem r (Maybe a)
  -> Sem r a
nothingFailM :: forall a (r :: EffectRow).
(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 a (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
Maybe a -> Sem r a
nothingFail

catchFail :: forall e a r. ()
  => Member Hedgehog r
  => HasCallStack
  => Show e
  => Sem (Error e ': r) a
  -> Sem r a
catchFail :: forall e a (r :: EffectRow).
(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 a (r :: EffectRow).
(Member Hedgehog r, Show e, HasCallStack) =>
Sem r (Either e a) -> Sem r a
leftFailM
{-# DEPRECATED catchFail "Use trapFail instead" #-}

trapFail :: forall e a r. ()
  => Member Hedgehog r
  => HasCallStack
  => Show e
  => Sem (Error e ': r) a
  -> Sem r a
trapFail :: forall e a (r :: EffectRow).
(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 a (r :: EffectRow).
(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 a r. ()
  => Member Hedgehog r
  => HasCallStack
  => ToJSON e
  => Sem (Error e ': r) a
  -> Sem r a
trapFailJson :: forall e a (r :: EffectRow).
(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 a (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack String
msg

trapFailJsonPretty :: forall e a r. ()
  => Member Hedgehog r
  => HasCallStack
  => ToJSON e
  => Sem (Error e ': r) a
  -> Sem r a
trapFailJsonPretty :: forall e a (r :: EffectRow).
(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 a (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack String
msg

trapFailYaml :: forall e a r m. ()
  => MonadIO m
  => Member (Embed m) r
  => Member Hedgehog r
  => HasCallStack
  => ToJSON e
  => Sem (Error e ': r) a
  -> Sem r a
trapFailYaml :: forall e a (r :: EffectRow) (m :: * -> *).
(MonadIO m, Member (Embed m) r, 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
      m () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (m () -> Sem r ()) -> m () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
IOIO.putStrLn String
msg
      CallStack -> String -> Sem r a
forall a (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
CallStack -> String -> Sem r a
failMessage CallStack
HasCallStack => CallStack
GHC.callStack String
msg

requireHead :: forall a r. ()
  => Member Hedgehog r
  => HasCallStack
  => [a]
  -> Sem r a
requireHead :: forall a (r :: EffectRow).
(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 a (r :: EffectRow).
(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 :: forall r. ()
  => 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 a (r :: EffectRow).
(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_ :: forall r. ()
  => 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 a (r :: EffectRow).
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @IOException (CallStack -> String -> Sem (Error JsonDecodeError : r) ()
forall a (r :: EffectRow).
(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 a (r :: EffectRow).
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @JsonDecodeError (\JsonDecodeError
e -> CallStack -> Text -> Sem r ()
forall a (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
CallStack -> Text -> Sem r a
failMessageText CallStack
HasCallStack => CallStack
GHC.callStack JsonDecodeError
e.message)

-- | Assert the 'filePath' can be parsed as YAML.
assertIsYamlFile :: forall r. ()
  => 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 a (r :: EffectRow).
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @IOException (CallStack
-> String
-> Sem (Error JsonDecodeError : Error YamlDecodeError : r) ()
forall a (r :: EffectRow).
(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 a (r :: EffectRow).
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @JsonDecodeError (\JsonDecodeError
e -> CallStack -> Text -> Sem (Error YamlDecodeError : r) ()
forall a (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
CallStack -> Text -> Sem r a
failMessageText CallStack
HasCallStack => CallStack
GHC.callStack JsonDecodeError
e.message)
    Sem (Error YamlDecodeError : r) ()
-> (Sem (Error YamlDecodeError : r) () -> Sem r ()) -> Sem r ()
forall a b. a -> (a -> b) -> b
& forall e a (r :: EffectRow).
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @YamlDecodeError (\YamlDecodeError
e -> CallStack -> Text -> Sem r ()
forall a (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
CallStack -> Text -> Sem r a
failMessageText CallStack
HasCallStack => CallStack
GHC.callStack YamlDecodeError
e.message)

-- | Asserts that the given file exists.
assertFileExists :: forall r. ()
  => 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 a (r :: EffectRow).
(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 :: forall r. ()
  => 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 :: forall r. ()
  => 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 a (r :: EffectRow).
(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 :: forall r. ()
  => 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 :: forall r. ()
  => 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 a (r :: EffectRow).
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @IOException (CallStack -> String -> Sem r String
forall a (r :: EffectRow).
(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 a (r :: EffectRow).
(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 :: forall r. ()
  => 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 a (r :: EffectRow).
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @IOException (CallStack -> String -> Sem r String
forall a (r :: EffectRow).
(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 :: forall r. ()
  => 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 a (r :: EffectRow).
(e -> Sem r a) -> Sem (Error e : r) a -> Sem r a
trap @IOException (CallStack -> String -> Sem r String
forall a (r :: EffectRow).
(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 :: forall r. ()
  => 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 a (r :: EffectRow).
(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 :: forall r. ()
  => 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 a (r :: EffectRow).
(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 :: forall a r m. ()
  => 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 a (r :: EffectRow) (m :: * -> *).
(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 a (r :: EffectRow).
(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 :: forall a r. ()
  => HasCallStack
  => Member Hedgehog r
  => Member Log r
  => Member (Embed IO) r
  => NominalDiffTime
  -> UTCTime
  -> String
  -> Sem r a
  -> Sem r a
byDeadlineM :: forall a (r :: EffectRow).
(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 a (r :: EffectRow).
(Member Hedgehog r, HasCallStack, ToString a) =>
a -> 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 a (r :: EffectRow).
(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 a (r :: EffectRow).
(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 :: forall b r m . ()
  => 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 b (r :: EffectRow) (m :: * -> *).
(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 b (r :: EffectRow).
(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 :: forall b r. ()
  => HasCallStack
  => Member (Embed IO) r
  => Member Hedgehog r
  => Member Log r
  => NominalDiffTime
  -> NominalDiffTime
  -> String
  -> Sem r b
  -> Sem r b
byDurationM :: forall b (r :: EffectRow).
(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 a (r :: EffectRow).
(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