packages feed

hw-polysemy 0.2.14.6 → 0.2.14.7

raw patch · 18 files changed

+147/−126 lines, 18 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- HaskellWorks.Polysemy.Amazonka.LocalStack: runReaderLocalAwsEnvDiscover :: () => Member (Embed IO) r => IO Container -> Sem (Reader Env : r) a -> Sem r a
+ HaskellWorks.Polysemy.Amazonka.LocalStack: runReaderLocalAwsEnvDiscover :: forall a r. () => Member (Embed IO) r => IO Container -> Sem (Reader Env : r) a -> Sem r a

Files

amazonka/HaskellWorks/Polysemy/Amazonka.hs view
@@ -64,7 +64,7 @@       Nothing   -> id   Nothing           -> id -runReaderAwsEnvDiscover :: ()+runReaderAwsEnvDiscover :: forall a r. ()   => Member (Embed IO) r   => Sem (Reader AWS.Env : r) a   -> Sem r a@@ -85,7 +85,7 @@    runReader awsEnv f -sendAws :: ()+sendAws :: forall a r m. ()   => HasCallStack   => AWS.AWSRequest a   => Member (DataLog AwsLogEntry) r
core/HaskellWorks/Error.hs view
@@ -7,14 +7,22 @@  import           HaskellWorks.Polysemy.Prelude -onLeft :: forall e m a. Monad m => (e -> m a) -> Either e a -> m a+onLeft :: forall e a m. ()+  => Monad m+  => (e -> m a) -> Either e a -> m a onLeft f = either f pure -onNothing :: forall a m. Monad m => m a -> Maybe a -> m a+onNothing :: forall a m. ()+  => Monad m+  => m a -> Maybe a -> m a onNothing h = maybe h return -onLeftM :: forall e m a. Monad m => (e -> m a) -> m (Either e a) -> m a+onLeftM :: forall e a m. ()+  => Monad m+  => (e -> m a) -> m (Either e a) -> m a onLeftM f action = onLeft f =<< action -onNothingM :: forall a m. Monad m => m a -> m (Maybe a) -> m a+onNothingM :: forall a m. ()+  => Monad m+  => m a -> m (Maybe a) -> m a onNothingM h f = onNothing h =<< f
core/HaskellWorks/Polysemy/Control/Concurrent/QSem.hs view
@@ -14,7 +14,7 @@ import           Polysemy import           Polysemy.Resource -newQSem :: ()+newQSem :: forall r m. ()   => MonadIO m   => Member (Embed m) r   => Int@@ -22,7 +22,7 @@ newQSem n = do   embed $ liftIO $ IO.newQSem n -waitQSem :: ()+waitQSem :: forall r m. ()   => MonadIO m   => Member (Embed m) r   => QSem@@ -30,7 +30,7 @@ waitQSem sem =   embed $ liftIO $ IO.waitQSem sem -signalQSem :: ()+signalQSem :: forall r m. ()   => MonadIO m   => Member (Embed m) r   => QSem@@ -38,7 +38,7 @@ signalQSem sem =   embed $ liftIO $ IO.signalQSem sem -bracketQSem :: ()+bracketQSem :: forall a r m. ()   => MonadIO m   => Member (Embed m) r   => Member Resource r
core/HaskellWorks/Polysemy/Control/Concurrent/STM.hs view
@@ -14,7 +14,7 @@ import           HaskellWorks.Polysemy.Prelude import           Polysemy -atomically :: forall a m r. ()+atomically :: forall a r m. ()   => MonadIO m   => Member (Embed m) r   => STM a
core/HaskellWorks/Polysemy/Control/Concurrent/STM/TVar.hs view
@@ -19,7 +19,7 @@ import           HaskellWorks.Polysemy.Prelude import           Polysemy -newTVarIO :: forall a m r. ()+newTVarIO :: forall a r m. ()   => MonadIO m   => Member (Embed m) r   => a@@ -27,7 +27,7 @@ newTVarIO a = do   embed $ liftIO $ STM.newTVarIO a -readTVarIO :: forall a m r. ()+readTVarIO :: forall a r m. ()   => MonadIO m   => Member (Embed m) r   => TVar a@@ -35,7 +35,7 @@ readTVarIO tvar = do   embed $ liftIO $ STM.readTVarIO tvar -registerDelay :: ()+registerDelay :: forall r m. ()   => MonadIO m   => Member (Embed m) r   => Int
core/HaskellWorks/Polysemy/Data/Aeson.hs view
@@ -15,7 +15,7 @@   = AesonDecodeError String   deriving (Show) -aesonDecode :: ()+aesonDecode :: forall a r. ()   => Member (Error AesonDecodeError) r   => FromJSON a   => LBS.ByteString
core/HaskellWorks/Polysemy/Data/Either.hs view
@@ -7,7 +7,7 @@ import           Polysemy import           Polysemy.Error -onLeftThrow :: ()+onLeftThrow :: forall e a r. ()   => Member (Error e) r   => Sem r (Either e a)   -> Sem r a
core/HaskellWorks/Polysemy/Error.hs view
@@ -15,7 +15,7 @@ -- | Run a computation that may fail, and handle the error case. -- Unlike 'catch' from 'Polysemy.Error' this function removes the 'Error' -- effect from the stack.-trap :: forall e r a. ()+trap :: forall e a r. ()   => (e -> Sem r a)   -> Sem (Error e ': r) a   -> Sem r a@@ -23,21 +23,21 @@   runError f >>= either h pure  -- | Like 'trap', but the error is not passed to the handler.-trap_ :: forall e r a. ()+trap_ :: forall e a r. ()   => Sem r a   -> Sem (Error e ': r) a   -> Sem r a trap_ h =   trap (const h) -embedRunExceptT :: ()+embedRunExceptT :: forall e a r m. ()   => Member (Embed m) r   => ExceptT e m a   -> Sem r (Either e a) embedRunExceptT = embed . runExceptT  -- | Run an embedded 'ExceptT' effect in a 'Sem' monad and throw any errors.-embedThrowExceptT :: ()+embedThrowExceptT :: forall e a r m. ()   => Member (Error e) r   => Member (Embed m) r   => ExceptT e m a
core/HaskellWorks/Polysemy/Except.hs view
@@ -45,7 +45,7 @@ -- /Beware/: Effects that aren't interpreted in terms of 'IO' -- will have local state semantics in regards to 'Except' effects -- interpreted this way. See 'Final'.-catchExToFinal :: forall m r a.()+catchExToFinal :: forall a r m. ()   => X.MonadCatch m   => X.MonadThrow m   => Member (Final m) r@@ -63,7 +63,7 @@  ------------------------------------------------------------------------------ -- | Run a 'Except' effect in terms of 'X.catch' and 'X.throwM' through final IO monad.-catchExToFinalIO :: forall r a.()+catchExToFinalIO :: forall a r. ()   => Member (Final IO) r   => Sem (Except ': r) a   -> Sem r a
core/HaskellWorks/Polysemy/Log.hs view
@@ -49,7 +49,7 @@       raise . interpretDataLogLocalNoop (f . context) =<< runT ma {-# inline interpretDataLogLocalNoop #-} -interpretDataLogToJsonStdout :: ()+interpretDataLogToJsonStdout :: forall e a r. ()   => Member (Embed IO) r   => (e -> J.Value)   -> Sem (DataLog e : r) a@@ -58,7 +58,7 @@   interpretDataLogStdoutWith (T.decodeUtf8 . LBS.toStrict . J.encode . toJson)  -- | Log a datalog message with the given severity and provided callstack.-annotateCs :: ()+annotateCs :: forall a r. ()   => Member GhcTime r   => CallStack   -> a@@ -79,7 +79,10 @@     send . DataLog =<< annotateCs cs (LogMessage severity message) {-# inline logCs #-} -logEntryToJson :: (a -> Value) -> LogEntry a -> Value+logEntryToJson :: forall a. ()+  => (a -> Value)+  -> LogEntry a+  -> Value logEntryToJson aToJson (LogEntry value time callstack) =     object       [ "time" .= time
hedgehog/HaskellWorks/Polysemy/Hedgehog/Assert.hs view
@@ -75,7 +75,7 @@ import           Polysemy.Error import           Polysemy.Log -(===) :: ()+(===) :: forall a r. ()   => Member Hedgehog r   => Eq a   => Show a@@ -86,7 +86,7 @@ (===) a b = withFrozenCallStack $ assertEquals a b  -- | Fail when the result is Left.-leftFail :: ()+leftFail :: forall e a r. ()   => Member Hedgehog r   => Show e   => HasCallStack@@ -96,7 +96,7 @@   Right a -> pure a   Left e  -> failMessage GHC.callStack ("Expected Right: " <> show e) -nothingFail :: ()+nothingFail :: forall a r. ()   => Member Hedgehog r   => HasCallStack   => Maybe a@@ -105,14 +105,14 @@   Just a  -> return a   Nothing -> failMessage GHC.callStack "Expected Just" -failure :: ()+failure :: forall a r. ()   => Member Hedgehog r   => HasCallStack   => Sem r a failure =   withFrozenCallStack $ failWith Nothing "" -failMessage :: ()+failMessage :: forall a r. ()   => Member Hedgehog r   => HasCallStack   => GHC.CallStack@@ -121,7 +121,7 @@ failMessage cs =   withFrozenCallStack $ failWithCustom cs Nothing -leftFailM :: forall e r a. ()+leftFailM :: forall e a r. ()   => Member Hedgehog r   => Show e   => HasCallStack@@ -131,7 +131,7 @@   withFrozenCallStack $ f >>= leftFail  -- | Fail when the result is Left with the error message as JSON.-leftFailJson :: ()+leftFailJson :: forall e a r. ()   => Member Hedgehog r   => ToJSON e   => HasCallStack@@ -143,7 +143,7 @@     let msg = LT.unpack $ LT.decodeUtf8 $ J.encode e     failMessage GHC.callStack ("Expected Right: " <> msg) -leftFailJsonM :: forall e r a. ()+leftFailJsonM :: forall e a r. ()   => Member Hedgehog r   => ToJSON e   => HasCallStack@@ -153,7 +153,7 @@   withFrozenCallStack $ f >>= leftFailJson  -- | Fail when the result is Left with the error message as JSON.-leftFailPretty :: ()+leftFailPretty :: forall e a r. ()   => Member Hedgehog r   => Pretty e   => HasCallStack@@ -166,7 +166,7 @@       let msg = PP.renderString $ PP.layoutPretty PP.defaultLayoutOptions $ PP.pretty e       failMessage GHC.callStack ("Expected Right: " <> msg) -leftFailPrettyM :: forall e r a. ()+leftFailPrettyM :: forall e a r. ()   => Member Hedgehog r   => Pretty e   => HasCallStack@@ -176,7 +176,7 @@   withFrozenCallStack $ f >>= leftFailPretty  -- | Fail when the result is Left with the error message as JSON.-leftFailJsonPretty :: ()+leftFailJsonPretty :: forall e a r. ()   => Member Hedgehog r   => ToJSON e   => HasCallStack@@ -188,7 +188,7 @@     let msg = LT.unpack $ LT.decodeUtf8 $ J.encodePretty e     failMessage GHC.callStack ("Expected Right: " <> msg) -leftFailJsonPrettyM :: forall e r a. ()+leftFailJsonPrettyM :: forall e a r. ()   => Member Hedgehog r   => ToJSON e   => HasCallStack@@ -198,7 +198,7 @@   withFrozenCallStack $ f >>= leftFailJsonPretty  -- | Fail when the result is Left with the error message as JSON.-leftFailYaml :: ()+leftFailYaml :: forall e a r. ()   => Member Hedgehog r   => ToJSON e   => HasCallStack@@ -210,7 +210,7 @@     let msg = T.unpack $ T.decodeUtf8 $ Y.encode e     failMessage GHC.callStack ("Expected Right: " <> msg) -leftFailYamlM :: forall e r a. ()+leftFailYamlM :: forall e a r. ()   => Member Hedgehog r   => ToJSON e   => HasCallStack@@ -219,7 +219,7 @@ leftFailYamlM f =   withFrozenCallStack $ f >>= leftFailYaml -nothingFailM :: forall r a. ()+nothingFailM :: forall a r. ()   => Member Hedgehog r   => HasCallStack   => Sem r (Maybe a)@@ -227,7 +227,7 @@ nothingFailM f =   withFrozenCallStack $ f >>= nothingFail -catchFail :: forall e r a.()+catchFail :: forall e a r. ()   => Member Hedgehog r   => HasCallStack   => Show e@@ -237,7 +237,7 @@   withFrozenCallStack $ f & runError & leftFailM {-# DEPRECATED catchFail "Use trapFail instead" #-} -trapFail :: forall e r a.()+trapFail :: forall e a r. ()   => Member Hedgehog r   => HasCallStack   => Show e@@ -249,7 +249,7 @@     Right a -> pure a     Left e  -> failMessage GHC.callStack $ show e -trapFailJson :: forall e r a.()+trapFailJson :: forall e a r. ()   => Member Hedgehog r   => HasCallStack   => ToJSON e@@ -263,7 +263,7 @@       let msg = LT.unpack $ LT.decodeUtf8 $ J.encode e       failMessage GHC.callStack msg -trapFailJsonPretty :: forall e r a.()+trapFailJsonPretty :: forall e a r. ()   => Member Hedgehog r   => HasCallStack   => ToJSON e@@ -277,7 +277,7 @@       let msg = LT.unpack $ LT.decodeUtf8 $ J.encodePretty e       failMessage GHC.callStack msg -trapFailYaml :: forall e r a.()+trapFailYaml :: forall e a r. ()   => Member Hedgehog r   => HasCallStack   => ToJSON e@@ -291,7 +291,7 @@       let msg = T.unpack $ T.decodeUtf8 $ Y.encode e       failMessage GHC.callStack msg -requireHead :: ()+requireHead :: forall a r. ()   => Member Hedgehog r   => HasCallStack   => [a]@@ -301,7 +301,7 @@     []    -> failMessage GHC.callStack "Cannot take head of empty list"     (x:_) -> pure x -assertPidOk :: ()+assertPidOk :: forall r. ()   => HasCallStack   => Member Hedgehog r   => Member (Embed IO) r@@ -312,7 +312,7 @@   nothingFailM $ getPid hProcess  -- | Assert the 'filePath' can be parsed as JSON.-assertIsJsonFile_ :: ()+assertIsJsonFile_ :: forall r. ()   => HasCallStack   => Member Hedgehog r   => Member (Embed IO) r@@ -325,7 +325,7 @@     & trap @JsonDecodeError (\e -> failMessage GHC.callStack (e ^. the @"message"))  -- | Assert the 'filePath' can be parsed as YAML.-assertIsYamlFile :: ()+assertIsYamlFile :: forall r. ()   => HasCallStack   => Member Hedgehog r   => Member (Embed IO) r@@ -339,7 +339,7 @@     & trap @YamlDecodeError (\e -> failMessage GHC.callStack (e ^. the @"message"))  -- | Asserts that the given file exists.-assertFileExists :: ()+assertFileExists :: forall r. ()   => HasCallStack   => Member Hedgehog r   => Member (Embed IO) r@@ -352,7 +352,7 @@   unless exists $ failWithCustom GHC.callStack Nothing (file <> " has not been successfully created.")  -- | Asserts that all of the given files exist.-assertFilesExist :: ()+assertFilesExist :: forall r. ()   => HasCallStack   => Member Hedgehog r   => Member (Embed IO) r@@ -363,7 +363,7 @@   withFrozenCallStack $ for_ files assertFileExists  -- | Asserts that the given file is missing.-assertFileMissing :: ()+assertFileMissing :: forall r. ()   => HasCallStack   => Member Hedgehog r   => Member (Embed IO) r@@ -376,7 +376,7 @@   when exists $ failWithCustom GHC.callStack Nothing (file <> " should not have been created.")  -- | Asserts that all of the given files are missing.-assertFilesMissing :: ()+assertFilesMissing :: forall r. ()   => HasCallStack   => Member Hedgehog r   => Member (Embed IO) r@@ -387,12 +387,15 @@   withFrozenCallStack $ for_ files assertFileMissing  -- | Assert the file contains the given number of occurrences of the given string-assertFileOccurences :: ()+assertFileOccurences :: forall r. ()   => HasCallStack   => Member Hedgehog r   => Member (Embed IO) r   => Member Log r-  => Int -> String -> FilePath -> Sem r ()+  => Int+  -> String+  -> FilePath+  -> Sem r () assertFileOccurences n s fp = withFrozenCallStack $ do   contents <- readFile fp     & trap @IOException (failMessage GHC.callStack . show)@@ -400,7 +403,7 @@   L.length (L.filter (s `L.isInfixOf`) (L.lines contents)) === n  -- | Assert the file contains the given number of occurrences of the given string-assertFileLines :: ()+assertFileLines :: forall r. ()   => HasCallStack   => Member Hedgehog r   => Member (Embed IO) r@@ -422,7 +425,7 @@     failWithCustom GHC.callStack Nothing (fp <> " has an unexpected number of lines")  -- | Assert the file contains the given number of occurrences of the given string-assertEndsWithSingleNewline :: ()+assertEndsWithSingleNewline :: forall r. ()   => HasCallStack   => Member Hedgehog r   => Member (Embed IO) r@@ -439,7 +442,7 @@     _ -> failWithCustom GHC.callStack Nothing (fp <> " must end with newline.")  -- | Asserts that the given directory exists.-assertDirectoryExists :: ()+assertDirectoryExists :: forall r. ()   => HasCallStack   => Member Hedgehog r   => Member (Embed IO) r@@ -452,7 +455,7 @@   unless exists $ failWithCustom GHC.callStack Nothing ("Directory '" <> dir <> "' does not exist on the file system.")  -- | Asserts that the given directory is missing.-assertDirectoryMissing :: ()+assertDirectoryMissing :: forall r. ()   => HasCallStack   => Member Hedgehog r   => Member Log r@@ -464,7 +467,7 @@     & trap @IOException (const (pure False))   when exists $ failWithCustom GHC.callStack Nothing ("Directory '" <> dir <> "' does exist on the file system.") -byDeadlineIO :: ()+byDeadlineIO :: forall a r m. ()   => HasCallStack   => Member (Embed m) r   => Member (Embed IO) r@@ -480,7 +483,7 @@ -- | 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 ::  ()+byDeadlineM :: forall a r. ()   => HasCallStack   => Member Hedgehog r   => Member Log r@@ -510,7 +513,7 @@ -- | 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 :: ()+byDurationIO :: forall b r m . ()   => HasCallStack   => Member (Embed m) r   => Member (Embed IO) r@@ -527,7 +530,7 @@ -- | 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 :: ()+byDurationM :: forall b r. ()   => HasCallStack   => Member (Embed IO) r   => Member Hedgehog r
hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs view
@@ -79,14 +79,14 @@  makeSem ''Hedgehog -trapAssertion :: ()+trapAssertion :: forall a r. ()   => Member Hedgehog r   => (H.Failure -> Sem r a)   -> Sem r a   -> Sem r a trapAssertion = flip catchAssertion -hedgehogToMonadTestFinal :: ()+hedgehogToMonadTestFinal :: forall a r m. ()   => IO.MonadIO m   => IO.MonadCatch m   => H.MonadTest m@@ -120,19 +120,19 @@   WriteLog logValue ->     liftS $ H.writeLog logValue -hedgehogToPropertyFinal :: ()+hedgehogToPropertyFinal :: forall a r. ()   => Member (Final (H.PropertyT IO)) r   => Sem (Hedgehog ': r) a   -> Sem r a hedgehogToPropertyFinal = hedgehogToMonadTestFinal -hedgehogToTestFinal :: ()+hedgehogToTestFinal :: forall a r. ()   => Member (Final (H.TestT IO)) r   => Sem (Hedgehog ': r) a   -> Sem r a hedgehogToTestFinal = hedgehogToMonadTestFinal -catchExToPropertyFinal :: ()+catchExToPropertyFinal :: forall a r. ()   => Member (Final (H.PropertyT IO)) r   => Sem (Except ': r) a   -> Sem r a
hedgehog/HaskellWorks/Polysemy/Hedgehog/Eval.hs view
@@ -13,14 +13,14 @@ import           HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog import           Polysemy -evalIO_ :: ()+evalIO_ :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => IO a   -> Sem r () evalIO_ = void . evalIO -evalM_ :: ()+evalM_ :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => Sem r a
hedgehog/HaskellWorks/Polysemy/Hedgehog/Jot.hs view
@@ -74,7 +74,7 @@ import qualified Polysemy.Log.Effect.DataLog                    as Log  -- | Annotate the given string at the context supplied by the callstack.-jotWithCallstack :: ()+jotWithCallstack :: forall r. ()   => Member Hedgehog r   => GHC.CallStack   -> String@@ -83,7 +83,7 @@   writeLog $ H.Annotation (H.getCaller cs) a  -- | Annotate with the given string.-jot :: ()+jot :: forall r. ()   => Member Hedgehog r   => GHC.HasCallStack   => String@@ -94,16 +94,16 @@   return b  -- | Annotate the given string returning unit.-jot_ :: ()+jot_ :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack-  => ToString s-  => s+  => ToString a+  => a   -> Sem r () jot_ a = GHC.withFrozenCallStack $ jotWithCallstack GHC.callStack $ toString a  -- | Annotate the given text returning unit.-jotText_ :: ()+jotText_ :: forall r. ()   => Member Hedgehog r   => GHC.HasCallStack   => Text@@ -111,18 +111,18 @@ jotText_ a = GHC.withFrozenCallStack $ jotWithCallstack GHC.callStack $ Text.unpack a  -- | Annotate the given string in a monadic context.-jotM :: ()-  => ToString s+jotM :: forall a r. ()+  => ToString a   => Member Hedgehog r   => GHC.HasCallStack-  => Sem r s-  -> Sem r s+  => Sem r a+  -> Sem r a jotM a = GHC.withFrozenCallStack $ do   !b <- evalM a   jotWithCallstack GHC.callStack $ toString b   return b -jotBsUtf8M :: ()+jotBsUtf8M :: forall r. ()   => Member Hedgehog r   => GHC.HasCallStack   => Sem r ByteString@@ -132,7 +132,7 @@   jotWithCallstack GHC.callStack $ Text.unpack $ Text.decodeUtf8 b   return b -jotLbsUtf8M :: ()+jotLbsUtf8M :: forall r. ()   => Member Hedgehog r   => GHC.HasCallStack   => Sem r LBS.ByteString@@ -143,7 +143,7 @@   return b  -- | Annotate the given string in a monadic context returning unit.-jotM_ :: ()+jotM_ :: forall r. ()   => Member Hedgehog r   => GHC.HasCallStack   => Sem r String@@ -154,7 +154,7 @@   return ()  -- | Annotate the given string in IO.-jotIO :: ()+jotIO :: forall r. ()   => Member Hedgehog r   => GHC.HasCallStack   => IO String@@ -165,7 +165,7 @@   return a  -- | Annotate the given string in IO returning unit.-jotIO_ :: ()+jotIO_ :: forall r. ()   => Member Hedgehog r   => GHC.HasCallStack   => IO String@@ -176,7 +176,7 @@   return ()  -- | Annotate the given value.-jotShow :: ()+jotShow :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => Show a@@ -188,7 +188,7 @@   return b  -- | Annotate the given value returning unit.-jotShow_ :: ()+jotShow_ :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => Show a@@ -197,7 +197,7 @@ jotShow_ a = GHC.withFrozenCallStack $ jotWithCallstack GHC.callStack (show a)  -- | Annotate the given value in a monadic context.-jotShowM :: ()+jotShowM :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => Show a@@ -209,7 +209,7 @@   return b  -- | Annotate the given value in a monadic context returning unit.-jotShowM_ :: ()+jotShowM_ :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => Show a@@ -221,7 +221,7 @@   return ()  -- | Annotate the given value in IO.-jotShowIO :: ()+jotShowIO :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => Show a@@ -233,7 +233,7 @@   return a  -- | Annotate the given value in IO returning unit.-jotShowIO_ :: ()+jotShowIO_ :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => Show a@@ -245,7 +245,7 @@   return ()  -- | Annotate the given value as JSON.-jotJson :: ()+jotJson :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => ToJSON a@@ -257,7 +257,7 @@   return b  -- | Annotate the given value as JSON.-jotJson_ :: ()+jotJson_ :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => ToJSON a@@ -269,7 +269,7 @@   return ()  -- | Annotate the given value as JSON in a monadic context.-jotJsonM :: ()+jotJsonM :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => ToJSON a@@ -281,7 +281,7 @@   return b  -- | Annotate the given value as JSON in a monadic context.-jotJsonM_ :: ()+jotJsonM_ :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => ToJSON a@@ -293,7 +293,7 @@   return ()  -- | Annotate the given value as JSON.-jotJsonPretty :: ()+jotJsonPretty :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => ToJSON a@@ -305,7 +305,7 @@   return b  -- | Annotate the given value as JSON.-jotJsonPretty_ :: ()+jotJsonPretty_ :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => ToJSON a@@ -317,7 +317,7 @@   return ()  -- | Annotate the given value as JSON in a monadic context.-jotJsonPrettyM :: ()+jotJsonPrettyM :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => ToJSON a@@ -329,7 +329,7 @@   return b  -- | Annotate the given value as JSON in a monadic context.-jotJsonPrettyM_ :: ()+jotJsonPrettyM_ :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => ToJSON a@@ -341,7 +341,7 @@   return ()  -- | Annotate the given value as JSON.-jotYaml :: ()+jotYaml :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => ToJSON a@@ -353,7 +353,7 @@   return b  -- | Annotate the given value as JSON.-jotYaml_ :: ()+jotYaml_ :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => ToJSON a@@ -365,7 +365,7 @@   return ()  -- | Annotate the given value as JSON in a monadic context.-jotYamlM :: ()+jotYamlM :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => ToJSON a@@ -377,7 +377,7 @@   return b  -- | Annotate the given value as JSON in a monadic context.-jotYamlM_ :: ()+jotYamlM_ :: forall a r. ()   => Member Hedgehog r   => GHC.HasCallStack   => ToJSON a@@ -389,7 +389,7 @@   return ()  -- | Annotate the each value in the given traversable.-jotEach :: ()+jotEach :: forall a f r. ()   => Member Hedgehog r   => GHC.HasCallStack   => Show a@@ -401,7 +401,7 @@   return as  -- | Annotate the each value in the given traversable returning unit.-jotEach_ :: ()+jotEach_ :: forall a f r. ()   => Member Hedgehog r   => GHC.HasCallStack   => Show a@@ -411,7 +411,7 @@ jotEach_ as = GHC.withFrozenCallStack $ for_ as $ jotWithCallstack GHC.callStack . show  -- | Annotate the each value in the given traversable in a monadic context.-jotEachM :: ()+jotEachM :: forall a f r. ()   => Member Hedgehog r   => GHC.HasCallStack   => Show a@@ -424,7 +424,7 @@   return as  -- | Annotate the each value in the given traversable in a monadic context returning unit.-jotEachM_ :: ()+jotEachM_ :: forall a f r. ()   => Member Hedgehog r   => GHC.HasCallStack   => Show a@@ -436,7 +436,7 @@   for_ as $ jotWithCallstack GHC.callStack . show  -- | Annotate the each value in the given traversable in IO.-jotEachIO :: ()+jotEachIO :: forall a f r. ()   => Member Hedgehog r   => GHC.HasCallStack   => Show a@@ -449,7 +449,7 @@   return as  -- | Annotate the each value in the given traversable in IO returning unit.-jotEachIO_ :: ()+jotEachIO_ :: forall a f r. ()   => Member Hedgehog r   => GHC.HasCallStack   => Show a@@ -461,7 +461,7 @@   for_ as $ jotWithCallstack GHC.callStack . show  -- | Return the input file path after annotating it relative to the package directory-jotPkgInputFile :: ()+jotPkgInputFile :: forall r. ()   => HasCallStack   => Member Hedgehog r   => Member (Reader PackagePath) r@@ -473,7 +473,7 @@   return fp  -- | Return the golden file path after annotating it relative to the package directory-jotPkgGoldenFile :: ()+jotPkgGoldenFile :: forall r. ()   => HasCallStack   => Member Hedgehog r   => Member (Reader PackagePath) r@@ -484,7 +484,7 @@   jot_ $ pkgPath <> "/" <> fp   return fp -jotRootInputFile :: ()+jotRootInputFile :: forall r. ()   => HasCallStack   => Member Hedgehog r   => Member (Reader ProjectRoot) r@@ -495,7 +495,7 @@   jot $ pkgPath <> "/" <> fp  -- | Return the test file path after annotating it relative to the project root directory-jotTempFile :: ()+jotTempFile :: forall r. ()   => HasCallStack   => Member Hedgehog r   => Member (Reader Workspace) r
hw-polysemy.cabal view
@@ -1,6 +1,6 @@ cabal-version:          3.4 name:                   hw-polysemy-version:                0.2.14.6+version:                0.2.14.7 synopsis:               Opinionated polysemy library description:            Opinionated polysemy library. license:                Apache-2.0
test/Test/Polysemy/Env.hs view
@@ -38,7 +38,7 @@   EnvironmentVariableMissing String   deriving (Show, Eq) -runTestEnv :: ()+runTestEnv :: forall a r. ()   => HasCallStack   => Member (Embed IO) r   => Member Hedgehog r@@ -51,7 +51,7 @@   withFrozenCallStack $ f     & runReaderAwsEnvDiscover -runLocalTestEnv :: ()+runLocalTestEnv :: forall a r. ()   => HasCallStack   => Member (Embed IO) r   => Member Hedgehog r@@ -65,12 +65,12 @@   withFrozenCallStack $ f     & runReaderLocalAwsEnvDiscover mk -runReaderFromEnvOrFail :: forall i r a. ()+runReaderFromEnvOrFail :: forall b a r. ()   => Member (Embed IO) r   => Member Hedgehog r-  => (String -> i)+  => (String -> b)   -> String-  -> Sem (Reader i ': r) a+  -> Sem (Reader b ': r) a   -> Sem r a runReaderFromEnvOrFail f envVar action = do   env <- lookupEnv envVar
testcontainers-localstack/HaskellWorks/Polysemy/Amazonka/LocalStack.hs view
@@ -20,7 +20,7 @@ import qualified TestContainers.Monad                         as TC import qualified TestContainers.Tasty                         as TC -runReaderLocalAwsEnvDiscover :: ()+runReaderLocalAwsEnvDiscover :: forall a r. ()   => Member (Embed IO) r   => IO TC.Container   -> Sem (Reader AWS.Env : r) a
testcontainers-localstack/HaskellWorks/TestContainers/LocalStack.hs view
@@ -1,5 +1,6 @@-{-# LANGUAGE GADTs             #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GADTs              #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE OverloadedStrings  #-}  {- HLINT ignore "Use camelCase" -} @@ -14,7 +15,9 @@ import           Prelude  import           Control.Concurrent                           (threadDelay)+import qualified Control.Concurrent                           as IO import           Control.Exception                            (try)+import qualified Control.Exception                            as E import           Control.Monad.IO.Class import qualified Data.ByteString.Lazy                         as LBS import           Data.Function@@ -58,7 +61,7 @@   -- Look up the corresponding port on the host machine for the exposed port 4566.   let localStackPort = TC.containerPort localstackContainer 4566 -  liftIO $ waitForLocalStack "localhost" localStackPort 8+  liftIO $ waitForLocalStack "localhost" localStackPort 100    pure localstackContainer @@ -71,12 +74,16 @@     checkLoop startTime url = do         result <- try $ simpleHttp url :: IO (Either HttpException LBS.ByteString)         case result of-            Right _ -> putStrLn "LocalStack is ready!"-            Left _  -> do+            Right _ -> do+              putStrLn "LocalStack is ready!"+              IO.threadDelay 100_000+              putStrLn ""+            Left e -> do                 currentTime <- getPOSIXTime                 let elapsedTime = currentTime - startTime                 when (elapsedTime < fromIntegral timeout) $ do-                    threadDelay 1000000  -- Wait for 1 second+                    threadDelay 100_000                     checkLoop startTime url                 when (elapsedTime >= fromIntegral timeout) $ do                     putStrLn "Timeout reached. LocalStack is not ready."+                    E.throw e