hedgehog-extras 0.4.6.0 → 0.4.7.0

raw patch · 2 files changed

+24/−2 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hedgehog-extras.cabal +1/−1
• src/Hedgehog/Extras/Test/Base.hs +23/−1

@@ -1,7 +1,7 @@ cabal-version: 2.4  name:                   hedgehog-extras-version:                0.4.6.0+version:                0.4.7.0 synopsis:               Supplemental library for hedgehog description:            Supplemental library for hedgehog. category:               Test

@@ -32,6 +32,7 @@   , noteTempFile    , headM+  , indexM   , fromJustM    , nothingFail@@ -81,7 +82,7 @@ import           Control.Monad.Reader (MonadIO (..), MonadReader (ask)) import           Control.Monad.Trans.Resource (ReleaseKey, runResourceT) import           Data.Aeson (Result (..))-import           Data.Bool (Bool, (&&))+import           Data.Bool (Bool, (&&), otherwise) import           Data.Either (Either (..), either) import           Data.Eq (Eq ((/=))) import           Data.Foldable (for_)@@ -111,6 +112,7 @@ import qualified Control.Concurrent as IO import qualified Control.Concurrent.STM as STM import qualified Control.Monad.Trans.Resource as IO+import qualified Data.List as L import qualified Data.Time.Clock as DTC import qualified GHC.Stack as GHC import qualified Hedgehog as H@@ -317,16 +319,36 @@ leftFailM :: (MonadTest m, Show e, HasCallStack) => m (Either e a) -> m a leftFailM f = f >>= leftFail +maybeAt :: Int -> [a] -> Maybe a+maybeAt n xs+  | n < 0 = Nothing+  | otherwise = L.foldr go (const Nothing) xs n+      where+        go :: a -> (Int -> Maybe a) -> Int -> Maybe a+        go x r k =+          case k of+            0 -> Just x+            _ -> r (k - 1)+ headM :: (MonadTest m, HasCallStack) => [a] -> m a headM (a:_) = return a headM [] = GHC.withFrozenCallStack $ failMessage GHC.callStack "Cannot take head of empty list" +indexM :: (MonadTest m, HasCallStack) => Int -> [a] -> m a+indexM n xs =+  case maybeAt n xs of+    Just x -> pure x+    Nothing ->+      GHC.withFrozenCallStack $+        failMessage GHC.callStack $ "Cannot get index " <> show n <> " of list of length " <> show (L.length xs)+ onLeft :: Monad m => (e -> m a) -> m (Either e a) -> m a onLeft h f = f >>= either h pure  onNothing :: Monad m => m a -> m (Maybe a) -> m a onNothing h f = f >>= maybe h pure +-- | Index into a list.  On failure, a friendly message is included in the test report. fromJustM :: (MonadTest m, HasCallStack) => Maybe a -> m a fromJustM (Just a) = return a fromJustM Nothing = GHC.withFrozenCallStack $ failMessage GHC.callStack "Cannot take head of empty list"