module HaskellWorks.Polysemy.Hedgehog.Jot
  ( jotShow,
    jotShow_,
    jotWithCallstack,

    jot,
    jot_,
    jotText_,
    jotM,
    jotM_,
    jotBsUtf8M,
    jotLbsUtf8M,
    jotIO,
    jotIO_,
    jotShowM,
    jotShowM_,
    jotShowIO,
    jotShowIO_,
    jotEach,
    jotEach_,
    jotEachM,
    jotEachM_,
    jotEachIO,
    jotEachIO_,

    jotPkgGoldenFile,
    jotPkgInputFile,
    jotRootInputFile,
    jotTempFile,
  ) where


import qualified Data.ByteString.Lazy                           as LBS
import qualified Data.Text                                      as Text
import qualified Data.Text.Encoding                             as Text
import qualified Data.Text.Lazy                                 as LT
import qualified Data.Text.Lazy.Encoding                        as LT
import qualified GHC.Stack                                      as GHC
import           HaskellWorks.Polysemy.Prelude

import qualified Hedgehog.Internal.Property                     as H
import qualified Hedgehog.Internal.Source                       as H

import           HaskellWorks.Polysemy
import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog
import           HaskellWorks.Polysemy.Hedgehog.Workspace.Types
import           HaskellWorks.Polysemy.String

-- | Annotate the given string at the context supplied by the callstack.
jotWithCallstack :: ()
  => Member Hedgehog r
  => GHC.CallStack
  -> String
  -> Sem r ()
jotWithCallstack :: forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
cs String
a =
  Log -> Sem r ()
forall (r :: EffectRow). Member Hedgehog r => Log -> Sem r ()
writeLog (Log -> Sem r ()) -> Log -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Maybe Span -> String -> Log
H.Annotation (CallStack -> Maybe Span
H.getCaller CallStack
cs) String
a

-- | Annotate with the given string.
jot :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => String
  -> Sem r String
jot :: forall (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
String -> Sem r String
jot String
a = (HasCallStack => Sem r String) -> Sem r String
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r String) -> Sem r String)
-> (HasCallStack => Sem r String) -> Sem r String
forall a b. (a -> b) -> a -> b
$ do
  !String
b <- String -> Sem r String
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
a -> Sem r a
eval String
a
  CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack String
b
  String -> Sem r String
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return String
b

-- | Annotate the given string returning unit.
jot_ :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => ToString s
  => s
  -> Sem r ()
jot_ :: forall (r :: EffectRow) s.
(Member Hedgehog r, HasCallStack, ToString s) =>
s -> Sem r ()
jot_ s
a = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ s -> String
forall a. ToString a => a -> String
toString s
a

-- | Annotate the given text returning unit.
jotText_ :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => Text
  -> Sem r ()
jotText_ :: forall (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
Text -> Sem r ()
jotText_ Text
a = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
a

-- | Annotate the given string in a monadic context.
jotM :: ()
  => ToString s
  => Member Hedgehog r
  => GHC.HasCallStack
  => Sem r s
  -> Sem r s
jotM :: forall s (r :: EffectRow).
(ToString s, Member Hedgehog r, HasCallStack) =>
Sem r s -> Sem r s
jotM Sem r s
a = (HasCallStack => Sem r s) -> Sem r s
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r s) -> Sem r s)
-> (HasCallStack => Sem r s) -> Sem r s
forall a b. (a -> b) -> a -> b
$ do
  !s
b <- Sem r s -> Sem r s
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
Sem r a -> Sem r a
evalM Sem r s
a
  CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ s -> String
forall a. ToString a => a -> String
toString s
b
  s -> Sem r s
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return s
b

jotBsUtf8M :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => Sem r ByteString
  -> Sem r ByteString
jotBsUtf8M :: forall (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
Sem r ByteString -> Sem r ByteString
jotBsUtf8M Sem r ByteString
a = (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r ByteString) -> Sem r ByteString)
-> (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a b. (a -> b) -> a -> b
$ do
  !ByteString
b <- Sem r ByteString -> Sem r ByteString
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
Sem r a -> Sem r a
evalM Sem r ByteString
a
  CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Text.decodeUtf8 ByteString
b
  ByteString -> Sem r ByteString
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b

jotLbsUtf8M :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => Sem r LBS.ByteString
  -> Sem r LBS.ByteString
jotLbsUtf8M :: forall (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
Sem r ByteString -> Sem r ByteString
jotLbsUtf8M Sem r ByteString
a = (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r ByteString) -> Sem r ByteString)
-> (HasCallStack => Sem r ByteString) -> Sem r ByteString
forall a b. (a -> b) -> a -> b
$ do
  !ByteString
b <- Sem r ByteString -> Sem r ByteString
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
Sem r a -> Sem r a
evalM Sem r ByteString
a
  CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text -> String
LT.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
LT.decodeUtf8 ByteString
b
  ByteString -> Sem r ByteString
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b

-- | Annotate the given string in a monadic context returning unit.
jotM_ :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => Sem r String
  -> Sem r ()
jotM_ :: forall (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
Sem r String -> Sem r ()
jotM_ Sem r String
a = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
  !String
b <- Sem r String -> Sem r String
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
Sem r a -> Sem r a
evalM Sem r String
a
  CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack String
b
  () -> Sem r ()
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Annotate the given string in IO.
jotIO :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => IO String
  -> Sem r String
jotIO :: forall (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
IO String -> Sem r String
jotIO IO String
f = (HasCallStack => Sem r String) -> Sem r String
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r String) -> Sem r String)
-> (HasCallStack => Sem r String) -> Sem r String
forall a b. (a -> b) -> a -> b
$ do
  !String
a <- IO String -> Sem r String
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
IO a -> Sem r a
evalIO IO String
f
  CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack String
a
  String -> Sem r String
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return String
a

-- | Annotate the given string in IO returning unit.
jotIO_ :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => IO String
  -> Sem r ()
jotIO_ :: forall (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
IO String -> Sem r ()
jotIO_ IO String
f = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
  !String
a <- IO String -> Sem r String
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
IO a -> Sem r a
evalIO IO String
f
  CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack String
a
  () -> Sem r ()
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Annotate the given value.
jotShow :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => Show a
  => a
  -> Sem r a
jotShow :: forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack, Show a) =>
a -> Sem r a
jotShow a
a = (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
  !a
b <- a -> Sem r a
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
a -> Sem r a
eval a
a
  CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (a -> String
forall a. Show a => a -> String
show a
b)
  a -> Sem r a
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return a
b

-- | Annotate the given value returning unit.
jotShow_ :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => Show a
  => a
  -> Sem r ()
jotShow_ :: forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack, Show a) =>
a -> Sem r ()
jotShow_ a
a = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (a -> String
forall a. Show a => a -> String
show a
a)

-- | Annotate the given value in a monadic context.
jotShowM :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => Show a
  => Sem r a
  -> Sem r a
jotShowM :: forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack, Show a) =>
Sem r a -> Sem r a
jotShowM Sem r a
a = (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
  !a
b <- Sem r a -> Sem r a
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
Sem r a -> Sem r a
evalM Sem r a
a
  CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (a -> String
forall a. Show a => a -> String
show a
b)
  a -> Sem r a
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return a
b

-- | Annotate the given value in a monadic context returning unit.
jotShowM_ :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => Show a
  => Sem r a
  -> Sem r ()
jotShowM_ :: forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack, Show a) =>
Sem r a -> Sem r ()
jotShowM_ Sem r a
a = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
  !a
b <- Sem r a -> Sem r a
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
Sem r a -> Sem r a
evalM Sem r a
a
  CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (a -> String
forall a. Show a => a -> String
show a
b)
  () -> Sem r ()
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Annotate the given value in IO.
jotShowIO :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => Show a
  => IO a
  -> Sem r a
jotShowIO :: forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack, Show a) =>
IO a -> Sem r a
jotShowIO IO 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
  !a
a <- IO a -> Sem r a
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
IO a -> Sem r a
evalIO IO a
f
  CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (a -> String
forall a. Show a => a -> String
show a
a)
  a -> Sem r a
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Annotate the given value in IO returning unit.
jotShowIO_ :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => Show a
  => IO a
  -> Sem r ()
jotShowIO_ :: forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack, Show a) =>
IO a -> Sem r ()
jotShowIO_ IO a
f = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
  !a
a <- IO a -> Sem r a
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
IO a -> Sem r a
evalIO IO a
f
  CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (a -> String
forall a. Show a => a -> String
show a
a)
  () -> Sem r ()
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Annotate the each value in the given traversable.
jotEach :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => Show a
  => Traversable f
  => f a
  -> Sem r (f a)
jotEach :: forall (r :: EffectRow) a (f :: * -> *).
(Member Hedgehog r, HasCallStack, Show a, Traversable f) =>
f a -> Sem r (f a)
jotEach f a
as = (HasCallStack => Sem r (f a)) -> Sem r (f a)
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r (f a)) -> Sem r (f a))
-> (HasCallStack => Sem r (f a)) -> Sem r (f a)
forall a b. (a -> b) -> a -> b
$ do
  f a -> (a -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ f a
as ((a -> Sem r ()) -> Sem r ()) -> (a -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (String -> Sem r ()) -> (a -> String) -> a -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
  f a -> Sem r (f a)
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return f a
as

-- | Annotate the each value in the given traversable returning unit.
jotEach_ :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => Show a
  => Traversable f
  => f a
  -> Sem r ()
jotEach_ :: forall (r :: EffectRow) a (f :: * -> *).
(Member Hedgehog r, HasCallStack, Show a, Traversable f) =>
f a -> Sem r ()
jotEach_ f a
as = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ f a -> (a -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ f a
as ((a -> Sem r ()) -> Sem r ()) -> (a -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (String -> Sem r ()) -> (a -> String) -> a -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Annotate the each value in the given traversable in a monadic context.
jotEachM :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => Show a
  => Traversable f
  => Sem r (f a)
  -> Sem r (f a)
jotEachM :: forall (r :: EffectRow) a (f :: * -> *).
(Member Hedgehog r, HasCallStack, Show a, Traversable f) =>
Sem r (f a) -> Sem r (f a)
jotEachM Sem r (f a)
f = (HasCallStack => Sem r (f a)) -> Sem r (f a)
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r (f a)) -> Sem r (f a))
-> (HasCallStack => Sem r (f a)) -> Sem r (f a)
forall a b. (a -> b) -> a -> b
$ do
  !f a
as <- Sem r (f a)
f
  f a -> (a -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ f a
as ((a -> Sem r ()) -> Sem r ()) -> (a -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (String -> Sem r ()) -> (a -> String) -> a -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
  f a -> Sem r (f a)
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return f a
as

-- | Annotate the each value in the given traversable in a monadic context returning unit.
jotEachM_ :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => Show a
  => Traversable f
  => Sem r (f a)
  -> Sem r ()
jotEachM_ :: forall (r :: EffectRow) a (f :: * -> *).
(Member Hedgehog r, HasCallStack, Show a, Traversable f) =>
Sem r (f a) -> Sem r ()
jotEachM_ Sem r (f a)
f = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
  !f a
as <- Sem r (f a)
f
  f a -> (a -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ f a
as ((a -> Sem r ()) -> Sem r ()) -> (a -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (String -> Sem r ()) -> (a -> String) -> a -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Annotate the each value in the given traversable in IO.
jotEachIO :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => Show a
  => Traversable f
  => IO (f a)
  -> Sem r (f a)
jotEachIO :: forall (r :: EffectRow) a (f :: * -> *).
(Member Hedgehog r, HasCallStack, Show a, Traversable f) =>
IO (f a) -> Sem r (f a)
jotEachIO IO (f a)
f = (HasCallStack => Sem r (f a)) -> Sem r (f a)
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r (f a)) -> Sem r (f a))
-> (HasCallStack => Sem r (f a)) -> Sem r (f a)
forall a b. (a -> b) -> a -> b
$ do
  !f a
as <- IO (f a) -> Sem r (f a)
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
IO a -> Sem r a
evalIO IO (f a)
f
  f a -> (a -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ f a
as ((a -> Sem r ()) -> Sem r ()) -> (a -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (String -> Sem r ()) -> (a -> String) -> a -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
  f a -> Sem r (f a)
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return f a
as

-- | Annotate the each value in the given traversable in IO returning unit.
jotEachIO_ :: ()
  => Member Hedgehog r
  => GHC.HasCallStack
  => Show a
  => Traversable f
  => IO (f a)
  -> Sem r ()
jotEachIO_ :: forall (r :: EffectRow) a (f :: * -> *).
(Member Hedgehog r, HasCallStack, Show a, Traversable f) =>
IO (f a) -> Sem r ()
jotEachIO_ IO (f a)
f = (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack ((HasCallStack => Sem r ()) -> Sem r ())
-> (HasCallStack => Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
  !f a
as <- IO (f a) -> Sem r (f a)
forall (r :: EffectRow) a.
(Member Hedgehog r, HasCallStack) =>
IO a -> Sem r a
evalIO IO (f a)
f
  f a -> (a -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ f a
as ((a -> Sem r ()) -> Sem r ()) -> (a -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ CallStack -> String -> Sem r ()
forall (r :: EffectRow).
Member Hedgehog r =>
CallStack -> String -> Sem r ()
jotWithCallstack CallStack
HasCallStack => CallStack
GHC.callStack (String -> Sem r ()) -> (a -> String) -> a -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Return the input file path after annotating it relative to the package directory
jotPkgInputFile :: ()
  => HasCallStack
  => Member Hedgehog r
  => Member (Reader PackagePath) r
  => FilePath
  -> Sem r FilePath
jotPkgInputFile :: forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Reader PackagePath) r) =>
String -> Sem r String
jotPkgInputFile String
filePath = (HasCallStack => Sem r String) -> Sem r String
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r String) -> Sem r String)
-> (HasCallStack => Sem r String) -> Sem r String
forall a b. (a -> b) -> a -> b
$ do
  PackagePath { $sel:filePath:PackagePath :: PackagePath -> String
filePath = String
pkgPath } <- Sem r PackagePath
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask
  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
pkgPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
filePath
  String -> Sem r String
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return String
filePath

-- | Return the golden file path after annotating it relative to the package directory
jotPkgGoldenFile :: ()
  => HasCallStack
  => Member Hedgehog r
  => Member (Reader PackagePath) r
  => FilePath
  -> Sem r FilePath
jotPkgGoldenFile :: forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Reader PackagePath) r) =>
String -> Sem r String
jotPkgGoldenFile String
filePath = (HasCallStack => Sem r String) -> Sem r String
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r String) -> Sem r String)
-> (HasCallStack => Sem r String) -> Sem r String
forall a b. (a -> b) -> a -> b
$ do
  PackagePath { $sel:filePath:PackagePath :: PackagePath -> String
filePath = String
pkgPath } <- Sem r PackagePath
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask
  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
pkgPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
filePath
  String -> Sem r String
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return String
filePath

jotRootInputFile :: ()
  => HasCallStack
  => Member Hedgehog r
  => Member (Reader ProjectRoot) r
  => FilePath
  -> Sem r FilePath
jotRootInputFile :: forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Reader ProjectRoot) r) =>
String -> Sem r String
jotRootInputFile String
filePath = (HasCallStack => Sem r String) -> Sem r String
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r String) -> Sem r String)
-> (HasCallStack => Sem r String) -> Sem r String
forall a b. (a -> b) -> a -> b
$ do
  ProjectRoot { $sel:filePath:ProjectRoot :: ProjectRoot -> String
filePath = String
pkgPath } <- Sem r ProjectRoot
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask
  String -> Sem r String
forall (r :: EffectRow).
(Member Hedgehog r, HasCallStack) =>
String -> Sem r String
jot (String -> Sem r String) -> String -> Sem r String
forall a b. (a -> b) -> a -> b
$ String
pkgPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
filePath

-- | Return the test file path after annotating it relative to the project root directory
jotTempFile :: ()
  => HasCallStack
  => Member Hedgehog r
  => Member (Reader Workspace) r
  => FilePath
  -> Sem r FilePath
jotTempFile :: forall (r :: EffectRow).
(HasCallStack, Member Hedgehog r, Member (Reader Workspace) r) =>
String -> Sem r String
jotTempFile String
filePath = (HasCallStack => Sem r String) -> Sem r String
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r String) -> Sem r String)
-> (HasCallStack => Sem r String) -> Sem r String
forall a b. (a -> b) -> a -> b
$ do
  Workspace { $sel:filePath:Workspace :: Workspace -> String
filePath = String
workspace } <- Sem r Workspace
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask
  let relPath :: String
relPath = String
workspace String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
filePath
  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
workspace String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
relPath
  String -> Sem r String
forall a. a -> Sem r a
forall (m :: * -> *) a. Monad m => a -> m a
return String
relPath