fs-sim 0.3.1.0 → 0.4.0.0

raw patch · 9 files changed

+568/−109 lines, 9 filesdep +deepseqdep ~QuickCheckdep ~basedep ~fs-apinew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq

Dependency ranges changed: QuickCheck, base, fs-api, io-classes

API changes (from Hackage documentation)

Files

• CHANGELOG.md +39/−0
• fs-sim.cabal +13/−5
• src/System/FS/Sim/Error.hs +10/−11
• src/System/FS/Sim/FsTree.hs +15/−6
• src/System/FS/Sim/MockFS.hs +1/−3
• src/System/FS/Sim/Stream.hs +139/−69
• test/Main.hs +2/−0
• test/Test/System/FS/Sim/Stream.hs +274/−0
• test/Test/System/FS/StateMachine.hs +75/−15

@@ -1,5 +1,44 @@ # Revision history for fs-sim +## ?.?.?.? -- ????-??-??++## 0.4.0.0 -- 2025-05-30++### Breaking++* Fix a bug where `withErrors` would not put back the previous `Errors` when an+  exception is thrown during execution of the function. Though we fixed the bug,+  it is also a breaking change: the type signature now has an additional+  constraint.+* Change finiteness guarantees for `Stream`s. Where streams could previously be+  *definitely* finite or *possibly* infinite, they should now be *definitely*+  finite or *definitely* infinite. This is mostly a conceptual change: it was+  already guaranteed by most if not all of the `Stream` functions. Still, the+  conceptual change should make the use of `Streams` more ergonomic going+  forward.++  As a result of and in addition to the conceptual change, the `Stream`+  interface got an overhaul. The concrete changes are:++  * The internals of the `Stream` are now exposed, but with big warnings about+    unsafe usage related to finiteness.+  * Added new `runStreamN` and `runStreamIndefinitely` functions.+  * Renamed `mkInfinite` to `unsafeMkInfinite`.+  * Added new `isFinite` and `isInfinite` queries.+  * Added a new `genFiniteN` function.+  * Removed `genMaybe'`, as it was just a specific instantiation of `genMaybe`+    that has no clear benefit being its own top-level function.+  * Added a new `liftShrinkStream` function.+  * Updated documentation.++### Patch++* Make it build with `ghc-9.12`.+* Drop support for `ghc-8.10`.+* Support `io-classes-1.8.0.1`.+* Support the new `MustExist` option for `AllowExisting` that was added in+  `fs-api`.+ ## 0.3.1.0 -- 2024-12-10  ### Non-breaking

@@ -1,6 +1,6 @@ cabal-version:   3.0 name:            fs-sim-version:         0.3.1.0+version:         0.4.0.0 synopsis:        Simulated file systems description:     Simulated file systems. license:         Apache-2.0@@ -19,13 +19,19 @@   CHANGELOG.md   README.md -tested-with:     GHC ==8.10 || ==9.2 || ==9.4 || ==9.6 || ==9.8 || ==9.10+tested-with:     GHC ==9.2 || ==9.4 || ==9.6 || ==9.8 || ==9.10 || ==9.12  source-repository head   type:     git   location: https://github.com/input-output-hk/fs-sim   subdir:   fs-sim +source-repository this+  type:     git+  location: https://github.com/input-output-hk/fs-sim+  subdir:   fs-sim+  tag:      fs-sim-0.4.0.0+ library   hs-source-dirs:   src   exposed-modules:@@ -38,12 +44,12 @@    default-language: Haskell2010   build-depends:-    , base                   >=4.14  && <4.21+    , base                   >=4.16  && <4.22     , base16-bytestring      ^>=0.1  || ^>=1.0     , bytestring             ^>=0.10 || ^>=0.11 || ^>=0.12     , containers             ^>=0.5  || ^>=0.6  || ^>=0.7-    , fs-api                 ^>=0.3-    , io-classes             ^>=1.6  || ^>=1.7+    , fs-api                 ^>=0.4+    , io-classes             ^>=1.6  || ^>=1.7  || ^>=1.8.0.1     , io-classes:strict-stm     , mtl                    ^>=2.2  || ^>=2.3     , primitive              ^>=0.9@@ -63,6 +69,7 @@   other-modules:     Test.System.FS.Sim.Error     Test.System.FS.Sim.FsTree+    Test.System.FS.Sim.Stream     Test.System.FS.StateMachine     Test.Util     Test.Util.RefEnv@@ -74,6 +81,7 @@     , bifunctors     , bytestring     , containers+    , deepseq     , fs-api     , fs-sim     , generics-sop

@@ -433,9 +433,11 @@     hPutBufSomeAtE <- commonPutErrors     return Errors {..}   where-    streamGen l = Stream.genInfinite . Stream.genMaybe' l . QC.elements-    streamGen' l = Stream.genInfinite . Stream.genMaybe' l . QC.frequency+    genMaybe' = Stream.genMaybe 2 +    streamGen l = Stream.genInfinite . genMaybe' l . QC.elements+    streamGen' l = Stream.genInfinite . genMaybe' l . QC.frequency+     commonGetErrors = streamGen' 20       [ (1, return $ Left FsReachedEOF)       , (3, Right <$> arbitrary) ]@@ -572,15 +574,12 @@  -- | Execute the next action using the given 'Errors'. After the action is -- finished, the previous 'Errors' are restored.-withErrors :: MonadSTM m => StrictTVar m Errors -> Errors -> m a -> m a-withErrors errorsVar tempErrors action = do-    originalErrors <- atomically $ do-      originalErrors <- readTVar errorsVar-      writeTVar errorsVar tempErrors-      return originalErrors-    res <- action-    atomically $ writeTVar errorsVar originalErrors-    return res+withErrors :: (MonadSTM m, MonadThrow m) => StrictTVar m Errors -> Errors -> m a -> m a+withErrors errorsVar tempErrors action =+    bracket+      (atomically $ swapTVar errorsVar tempErrors)+      (\originalErrors -> atomically $ swapTVar errorsVar originalErrors)+      $ \_ -> action  {-------------------------------------------------------------------------------   Utilities

@@ -231,14 +231,23 @@   Specific file system functions -------------------------------------------------------------------------------} --- | Open a file: create it if necessary or throw an error if it existed--- already wile we were supposed to create it from scratch (when passed--- 'MustBeNew').+-- | Open a file: create it if necessary or throw an error if either:+--    1. It existed already while we were supposed to create it from scratch+--        (when passed 'MustBeNew').+--    2. It did not already exists when we expected to (when passed 'MustExist'). openFile :: Monoid a          => FsPath -> AllowExisting -> FsTree a -> Either FsTreeError (FsTree a)-openFile fp ex = alterFile fp Left (Right mempty) $ \a -> case ex of-    AllowExisting -> Right a-    MustBeNew     -> Left (FsExists fp)+openFile fp ex = alterFile fp Left caseDoesNotExist caseAlreadyExist+  where+    caseAlreadyExist a = case ex of+      AllowExisting -> Right a+      MustBeNew     -> Left (FsExists fp)+      MustExist     -> Right a++    caseDoesNotExist = case ex of+      AllowExisting -> Right mempty+      MustBeNew     -> Right mempty+      MustExist     -> Left (FsMissing fp (pathLast fp :| []))  -- | Replace the contents of the specified file (which must exist) replace :: FsPath -> a -> FsTree a -> Either FsTreeError (FsTree a)

@@ -65,7 +65,7 @@   , hPutBufSomeAt   ) where -import           Control.Monad (forM, forM_, unless, void, when)+import           Control.Monad (forM, forM_, unless, when) import           Control.Monad.Except (MonadError, throwError) import           Control.Monad.Primitive (PrimMonad (..)) import           Control.Monad.State.Strict (MonadState, get, gets, put)@@ -491,8 +491,6 @@           , fsErrorStack  = prettyCallStack           , fsLimitation  = True           }-      when (openMode == ReadMode) $ void $-        checkFsTree $ FS.getFile fp (mockFiles fs)       files' <- checkFsTree $ FS.openFile fp ex (mockFiles fs)       return $ newHandle (fs { mockFiles = files' })                          (OpenHandle fp (filePtr openMode))

@@ -1,30 +1,39 @@ {-# LANGUAGE DeriveFunctor       #-} {-# LANGUAGE ScopedTypeVariables #-} --- | Possibly infinite streams of @'Maybe' a@s.+-- | Finite and infinite streams of @'Maybe' a@s. module System.FS.Sim.Stream (     -- * Streams-    Stream+    Stream (..)+  , InternalInfo (..)     -- * Running   , runStream+  , runStreamN+  , runStreamIndefinitely     -- * Construction   , always   , empty-  , mkInfinite   , repeating+  , unsafeMkInfinite   , unsafeMkFinite+    -- * Modify+  , filter     -- * Query   , null+  , isFinite+  , isInfinite     -- * Generation and shrinking   , genFinite+  , genFiniteN   , genInfinite   , genMaybe-  , genMaybe'   , shrinkStream+  , liftShrinkStream   ) where  import           Control.Monad (replicateM)-import           Prelude hiding (null)+import           Prelude hiding (filter, isInfinite, null)+import qualified Prelude import qualified Test.QuickCheck as QC import           Test.QuickCheck (Gen) @@ -32,29 +41,45 @@   Streams -------------------------------------------------------------------------------} --- | A 'Stream' is a stream of @'Maybe' a@s, which is /possibly/ infinite or--- /definitely/ finite.------ Finiteness is tracked internally and used for 'QC.shrink'ing and the 'Show'--- instance.-data Stream a = Stream {-      -- | Info about the size of the stream.-      _streamInternalInfo :: InternalInfo-    , _getStream          :: [Maybe a]+-- | A stream of @'Maybe' a@s that can be infinite.+data Stream a =+  -- | UNSAFE: when constructing, modifying, or accessing the internals of a+  -- 'Stream', it is the responsibility of the user to preserve the following+  -- invariant:+  --+  -- INVARIANT: if the stream is marked as 'Infinite', then the internal list+  -- should be infinite. If the stream is marked as 'Finite', then the internal+  -- list should finite.+  --+  -- * If the internal list is infinite but marked as 'Finite', then 'QC.shrink'+  --   or 'show' on the corresponding stream will diverge.+  --+  -- * If the internal list is finite but marked as 'Infinite', then 'QC.shrink'+  --   on the corresponding stream will degrade to an infinite list of empty+  --   streams.+  UnsafeStream {+      -- | UNSAFE: see 'UnsafeStream' for more information.+      --+      -- Info about the finiteness of the stream. It is used for 'QC.shrink'ing+      -- and the 'Show' instance.+      unsafeStreamInternalInfo :: InternalInfo+      -- | UNSAFE: see 'UnsafeStream' for more information.+      --+      -- The internal list underlying the stream.+    , unsafeStreamList         :: [Maybe a]     }   deriving Functor --- | Tag for 'Stream's that describes whether it is either /definitely/ a finite--- stream, or /possibly/ an infinite stream.+-- | Tag for 'Stream's that describes whether it is finite or infinite. ----- Useful for the 'Show' instance of 'Stream': when a 'Stream' is /definitely/--- finite, we can safely print the full stream.+-- Useful for the 'Show' instance of 'Stream': when a 'Stream' is finite, we can+-- safely print the full stream. data InternalInfo = Infinite | Finite --- | Fully shows a 'Stream' if it is /definitely/ finite, or prints a--- placeholder string if it is /possibly/ infinite.+-- | Fully shows a 'Stream' if it is finite, or prints a placeholder string if+-- it is infinite. instance Show a => Show (Stream a) where-  showsPrec n (Stream info xs) = case info of+  showsPrec n (UnsafeStream info xs) = case info of       Infinite -> ("<infinite stream>" ++)       Finite   -> (if n > 10 then ('(':) else id)                 . shows xs@@ -65,81 +90,127 @@   Running -------------------------------------------------------------------------------} --- | Advance the 'Stream'. Return the @'Maybe' a@ and the remaining 'Stream'.+-- | \( O(1) \): advance the 'Stream'. Return the @'Maybe' a@ and the remaining+-- 'Stream'. -- -- Returns 'Nothing' by default if the 'Stream' is empty. runStream :: Stream a -> (Maybe a, Stream a)-runStream s@(Stream _    []    ) = (Nothing, s)-runStream   (Stream info (a:as)) = (a, Stream info as)+runStream s@(UnsafeStream _    []    ) = (Nothing, s)+runStream   (UnsafeStream info (a:as)) = (a, UnsafeStream info as) +-- | \( O(n) \): like 'runStream', but advancing the stream @n@ times.+--+-- If @n<=0@, then the stream is advanced @0@ times.+runStreamN :: Int -> Stream a -> ([Maybe a], Stream a)+runStreamN n s+  | n <= 0 = ([], s)+  | otherwise =+      let (x, s') = runStream s+          (xs, s'') = runStreamN (n-1) s'+      in  (x:xs, s'')++-- | \( O(\infty) \): like 'runStream', but advancing the stream indefinitely.+--+-- For infinite streams, this produces an infinite list. For finite streams,+-- this produces a finite list.+runStreamIndefinitely :: Stream a -> [Maybe a]+runStreamIndefinitely (UnsafeStream _ as) = as ++ repeat Nothing+ {-------------------------------------------------------------------------------   Construction -------------------------------------------------------------------------------}  -- | Make an empty 'Stream'. empty :: Stream a-empty = Stream Finite []+empty = UnsafeStream Finite []  -- | Make a 'Stream' that always generates the given @a@. always :: a -> Stream a-always x = Stream Infinite (repeat (Just x))+always x = UnsafeStream Infinite (repeat (Just x))  -- | Make a 'Stream' that infinitely repeats the given list. repeating :: [Maybe a] -> Stream a-repeating xs = Stream Infinite $ concat (repeat xs)+repeating xs = UnsafeStream Infinite $ cycle xs --- | UNSAFE: Make a 'Stream' that is marked as definitely finite.------ This is unsafe since a user can pass in any list, and evaluating--- 'Test.QuickCheck.shrink' or 'show' on the resulting 'Stream' will diverge. It--- is the user's responsibility to only pass in a finite list.+-- | UNSAFE: Make a 'Stream' that is marked as finite. It is the user's+-- responsibility to only pass in finite lists. See 'UnsafeStream' for more+-- information. unsafeMkFinite :: [Maybe a] -> Stream a-unsafeMkFinite = Stream Finite+unsafeMkFinite = UnsafeStream Finite --- | Make a 'Stream' that is marked as possibly infinite.-mkInfinite :: [Maybe a] -> Stream a-mkInfinite = Stream Infinite+-- | UNSAFE: Make a 'Stream' that is marked as infinite. It is the user's+-- responsibility to only pass in infinite lists. See 'UnsafeStream' for more+-- information.+unsafeMkInfinite :: [Maybe a] -> Stream a+unsafeMkInfinite = UnsafeStream Infinite  {-------------------------------------------------------------------------------+  Modify+-------------------------------------------------------------------------------}++-- | Filter a 'Stream', preserving finiteness.+filter :: (Maybe a -> Bool) -> Stream a -> Stream a+filter p (UnsafeStream info xs) = UnsafeStream info (Prelude.filter p xs)++{-------------------------------------------------------------------------------   Query -------------------------------------------------------------------------------} --- | Return 'True' if the stream is empty.+-- | Check that the stream is empty. ----- A stream consisting of only 'Nothing's (even if it is only one) is not--- considered to be empty.+-- In general, a stream is only empty if the stream is equivalent to 'empty'.+--+-- A finite\/infinite stream consisting of only 'Nothing's is not considered to+-- be empty. In particular, @'null' ('always' Nothing) /= True@. null :: Stream a -> Bool-null (Stream _ []) = True-null _             = False+null (UnsafeStream Finite []) = True+null _                        = False +-- | Check that the stream is finite+isFinite :: Stream a -> Bool+isFinite (UnsafeStream Finite _)   = True+isFinite (UnsafeStream Infinite _) = False++-- | Check that the stream is infinite+isInfinite :: Stream a -> Bool+isInfinite (UnsafeStream Finite _)   = False+isInfinite (UnsafeStream Infinite _) = True+ {-------------------------------------------------------------------------------   Generation and shrinking -------------------------------------------------------------------------------} --- | Shrink a stream like it is an 'Test.QuickCheck.InfiniteList'.+-- | Shrink a stream like it is an 'QC.InfiniteList'. ----- Possibly infinite streams are shrunk differently than lists that are--- definitely finite, which is to ensure that shrinking terminates.--- * Possibly infinite streams are shrunk by taking finite prefixes of the---  argument stream. As such, shrinking a possibly infinite stream creates---  definitely finite streams.--- * Definitely finite streams are shrunk like lists are shrunk normally,---   preserving that the created streams are still definitely finite.+-- Infinite streams are shrunk differently than lists that are finite, which is+-- to ensure that we shrink infinite lists towards finite lists.+--+-- * Infinite streams are shrunk by taking finite prefixes of the argument+--   stream. Note that there are an infinite number of finite prefixes, so even+--   though the *shrink list* is infinite, the individual *list elements* are+--   finite.+--+-- * Finite streams are shrunk like lists are shrunk normally, preserving+--   finiteness. shrinkStream :: Stream a -> [Stream a]-shrinkStream (Stream info xs0) = case info of-    Infinite -> Stream Finite <$> [take n xs0 | n <- map (2^) [0 :: Int ..]]-    Finite   -> Stream Finite <$> QC.shrinkList (const []) xs0+shrinkStream (UnsafeStream info xs0) = case info of+    Infinite -> UnsafeStream Finite <$> [take n xs0 | n <- map (2^) [0 :: Int ..]]+    Finite   -> UnsafeStream Finite <$> QC.shrinkList (const []) xs0 +-- | Like 'shrinkStream', but with a custom shrinker for elements of the stream.+liftShrinkStream :: (Maybe a -> [Maybe a]) -> Stream a -> [Stream a]+liftShrinkStream shrinkOne (UnsafeStream info xs0) = case info of+    Infinite -> UnsafeStream Finite <$> [take n xs0 | n <- map (2^) [0 :: Int ..]]+    Finite   -> UnsafeStream Finite <$> QC.shrinkList shrinkOne xs0+ -- | Make a @'Maybe' a@ generator based on an @a@ generator. -- -- Each element has a chance of being either 'Nothing' or an element generated--- with the given @a@ generator (wrapped in a 'Just').------ The first argument is the likelihood (as used by 'QC.frequency') of a--- 'Just' where 'Nothing' has likelihood 2.+-- with the given @a@ generator (wrapped in a 'Just'). These /likelihoods/ are+-- passed to 'QC.frequency'. genMaybe ::-     Int   -- ^ Likelihood of 'Nothing'-  -> Int   -- ^ Likelihood of @'Just' a@+     Int -- ^ Likelihood of 'Nothing'+  -> Int -- ^ Likelihood of @'Just' a@   -> Gen a   -> Gen (Maybe a) genMaybe nLi jLi genA = QC.frequency@@ -147,22 +218,21 @@     , (jLi, Just <$> genA)     ] --- | Like 'genMaybe', but with the likelihood of 'Nothing' fixed to @2@. 'QC.frequency'-genMaybe' ::-     Int   -- ^ Likelihood of @'Just' a@-  -> Gen a+-- | Generate a finite 'Stream' of length @n@.+genFiniteN ::+     Int -- ^ Requested size of finite stream.   -> Gen (Maybe a)-genMaybe' = genMaybe 2+  -> Gen (Stream a)+genFiniteN n gen = UnsafeStream Finite <$> replicateM n gen --- | Generate a finite 'Stream' of length @n@.+-- | Generate a sized, finite 'Stream'. genFinite ::-     Int           -- ^ Requested size of finite stream. Tip: use 'genMaybe'.-  -> Gen (Maybe a)+     Gen (Maybe a)   -> Gen (Stream a)-genFinite n gen = Stream Finite <$> replicateM n gen+genFinite gen = UnsafeStream Finite <$> QC.listOf gen  -- | Generate an infinite 'Stream'. genInfinite ::-     Gen (Maybe a)  -- ^ Tip: use 'genMaybe'.+     Gen (Maybe a)   -> Gen (Stream a)-genInfinite gen = Stream Infinite <$> QC.infiniteListOf gen+genInfinite gen = UnsafeStream Infinite <$> QC.infiniteListOf gen

@@ -2,6 +2,7 @@  import qualified Test.System.FS.Sim.Error import qualified Test.System.FS.Sim.FsTree+import qualified Test.System.FS.Sim.Stream import qualified Test.System.FS.StateMachine import           Test.Tasty @@ -9,5 +10,6 @@ main = defaultMain $ testGroup "fs-sim-test" [       Test.System.FS.Sim.Error.tests     , Test.System.FS.Sim.FsTree.tests+    , Test.System.FS.Sim.Stream.tests     , Test.System.FS.StateMachine.tests     ]

@@ -0,0 +1,274 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE DerivingStrategies  #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}++{-# OPTIONS_GHC -Wno-orphans #-}++-- The @base@ library throws warnings on uses of @head@ on later GHC versions.+-- This is a just a test module, so we ignore the warning.+{-# OPTIONS_GHC -Wno-unrecognised-warning-flags #-}+{-# OPTIONS_GHC -Wno-x-partial #-}++module Test.System.FS.Sim.Stream (tests) where++import           Control.DeepSeq+import           Data.Maybe (isJust, isNothing)+import           Prelude hiding (filter, isInfinite, null)+import qualified Prelude+import           System.FS.Sim.Stream+import           Test.Tasty+import           Test.Tasty.QuickCheck+import           Test.Util++tests :: TestTree+tests = testGroup "Test.System.FS.Sim.Stream" [+      testProperty "prop_runStream" $+        prop_runStream @Int+    , testProperty "prop_runStreamN" $+        prop_runStreamN @Int+    , testProperty "prop_null"+        prop_null+    , testGroup "Shrinkers" [+          testProperty "prop_shrinkStreamFail" $+            prop_shrinkStreamFail @Int+        , testProperty "prop_eventuallyJust @InfiniteStream" $+            \(InfiniteStream s) -> prop_eventuallyJust @Int s+        , testProperty "prop_eventuallyNothing @InfiniteStream" $+            \(InfiniteStream s) -> prop_eventuallyNothing @Int s+        , testProperty "prop_eventuallyNothing @FiniteStream" $+            \(FiniteStream s) -> prop_eventuallyNothing @Int s+        ]+    , testGroup "Generators and shrinkers" [+          testGroup "Stream" $+            prop_forAllArbitraryAndShrinkSatisfy+              @(Stream Int)+              arbitrary+              (\s -> if isFinite s then shrink s else take 20 (shrink s))+              prop_stream+              prop_finiteStream+        , testGroup "FiniteSteam" $+            prop_arbitraryAndShrinkSatisfy+              @(FiniteStream Int)+              (\(FiniteStream s) -> prop_finiteStream s)+              (\(FiniteStream s) -> prop_finiteStream s)+        , testGroup "InfiniteStream" $+            prop_forAllArbitraryAndShrinkSatisfy+              @(InfiniteStream Int)+              arbitrary+              (take 6 . shrink)+              (\(InfiniteStream s) -> prop_infiniteStream s)+              (\(InfiniteStream s) -> prop_finiteStream s)+        , testGroup "NonEmptyStream" $+            prop_forAllArbitraryAndShrinkSatisfy+              @(NonEmptyStream Int)+              arbitrary+              (\s@(NonEmptyStream s') -> if isFinite s' then shrink s else take 20 (shrink s))+              (\(NonEmptyStream s) -> prop_nonEmptyStream s)+              (\(NonEmptyStream s) -> prop_nonEmptyStream s)+        ]+    ]++{-------------------------------------------------------------------------------+  Properties+-------------------------------------------------------------------------------}++-- | Advancing a stream behaves like a head on an equivalent list.+prop_runStream :: (Eq a, Show a) => Stream a -> Property+prop_runStream s =+    x === head ys+  where+    (x, _s') = runStream s+    ys = runStreamIndefinitely s++-- | Advancing a stream @n@ times behaves likes @take n@ on an equivalent list.+prop_runStreamN :: (Eq a, Show a) => Int -> Stream a -> Property+prop_runStreamN n s =+    xs === take n ys+  where+    (xs, _s') = runStreamN n s+    ys = runStreamIndefinitely s++-- | Empty streams are null+prop_null :: Property+prop_null = once $ property $ null empty++{-------------------------------------------------------------------------------+  Shrinkers+-------------------------------------------------------------------------------}++-- | A simple property that is expected to fail, but should exercise the+-- shrinker a little bit.+prop_shrinkStreamFail :: Stream a -> Property+prop_shrinkStreamFail s = expectFailure $+    let xs = fst (runStreamN 10 s)+    in  property $ length (Prelude.filter isJust xs) /= length (Prelude.filter isNothing xs)++-- | A stream eventually produces a 'Just'+prop_eventuallyJust :: Stream a -> Property+prop_eventuallyJust = eventually isJust++-- | A stream eventually produces a 'Nothing'+prop_eventuallyNothing :: Stream a -> Property+prop_eventuallyNothing = eventually isNothing++eventually :: (Maybe a -> Bool) -> Stream a -> Property+eventually p = go 1+  where+    go !n s =+      let (x, s') = runStream s in+      if p x+        then tabulate "Number of elements inspected" [showPowersOf 2 n] $ property True+        else go (n+1) s'++{-------------------------------------------------------------------------------+  Generators and shrinkers+-------------------------------------------------------------------------------}++-- | A 'Stream' is either finite or infinite+prop_stream :: NFData a => Stream a -> Property+prop_stream s =+         prop_finiteStream s+    .||. prop_infiniteStream s++-- | A stream is finite+prop_finiteStream :: NFData a => Stream a -> Property+prop_finiteStream s =+    property (isFinite s) .&&. property (not (isInfinite s)) .&&.+    prop_deepseqStream s++-- | An stream is infinite+prop_infiniteStream :: Stream a -> Property+prop_infiniteStream s =+    property (isInfinite s) .&&. property (not (isFinite s))++-- | A stream is non-empty, and finite or infinite+prop_nonEmptyStream :: NFData a => Stream a -> Property+prop_nonEmptyStream s =+         property $ not (null s)+    .&&. prop_stream s++prop_deepseqStream :: NFData a => Stream a -> Property+prop_deepseqStream (UnsafeStream info xs) = property (rwhnf info `seq` rnf xs)++{-------------------------------------------------------------------------------+  Generators and shrinkers: utility properties+-------------------------------------------------------------------------------}++prop_arbitraryAndShrinkSatisfy ::+     forall a. (Arbitrary a, Show a)+  => (a -> Property) -- ^ Generator property+  -> (a -> Property) -- ^ Shrinker property+  -> [TestTree]+prop_arbitraryAndShrinkSatisfy =+    prop_forAllArbitraryAndShrinkSatisfy arbitrary shrink++prop_forAllArbitraryAndShrinkSatisfy ::+     forall a. Show a+  => Gen a+  -> (a -> [a])+  -> (a -> Property) -- ^ Generator property+  -> (a -> Property) -- ^ Shrinker property+  -> [TestTree]+prop_forAllArbitraryAndShrinkSatisfy gen shr pgen pshr =+    [ prop_forAllArbitrarySatisfies gen shr pgen+    , prop_forAllShrinkSatisfies gen shr pshr+    ]++prop_forAllArbitrarySatisfies ::+     forall a. Show a+  => Gen a+  -> (a -> [a])+  -> (a -> Property)+  -> TestTree+prop_forAllArbitrarySatisfies gen shr p =+    testProperty "Arbitrary satisfies property" $+      forAllShrink gen shr p++prop_forAllShrinkSatisfies ::+     forall a. Show a+  => Gen a+  -> (a -> [a])+  -> (a -> Property)+  -> TestTree+prop_forAllShrinkSatisfies gen shr p =+    testProperty "Shrinking satisfies property" $+      forAll gen $ \x ->+        case shr x of+          [] -> label "no shrinks" $ property True+          xs -> forAll (growingElements xs) p++{-------------------------------------------------------------------------------+  Arbitrary instances+-------------------------------------------------------------------------------}++--+-- Stream+--++instance Arbitrary a => Arbitrary (Stream a) where+  arbitrary = oneof [+        genFinite arbitrary+      , genInfinite arbitrary+      ]+  shrink = liftShrinkStream shrink++--+-- NonEmptyStream+--++newtype NonEmptyStream a = NonEmptyStream (Stream a)+  deriving stock Show++instance Arbitrary a => Arbitrary (NonEmptyStream a) where+  arbitrary = NonEmptyStream <$> oneof [+        genFiniteNonEmpty+      , genInfinite arbitrary+      ]+    where+      genFiniteNonEmpty = do+        x <- arbitrary+        xs <- arbitrary+        pure $ unsafeMkFinite (x : xs)+  shrink (NonEmptyStream s) =+      [ NonEmptyStream s'+      | s' <- shrink s+      , not (Prelude.null (unsafeStreamList s')) ]++--+-- FiniteStream+--++newtype FiniteStream a = FiniteStream {+    getFiniteStream :: Stream a+  }+  deriving stock Show++instance Arbitrary a => Arbitrary (FiniteStream a) where+  arbitrary = FiniteStream <$> genFinite arbitrary+  shrink (FiniteStream s) = FiniteStream <$> shrinkStream s++--+-- InfiniteStream+--++newtype InfiniteStream a = InfiniteStream {+    getInfiniteStream :: Stream a+  }+  deriving stock Show++instance Arbitrary a => Arbitrary (InfiniteStream a) where+  arbitrary = InfiniteStream <$> genInfinite arbitrary+  shrink (InfiniteStream s) = InfiniteStream <$> shrinkStream s++--+-- Tiny+--++newtype Tiny a = Tiny a+  deriving stock Show++instance Arbitrary (Tiny Int) where+  arbitrary = Tiny <$> choose (0, 5)+  shrink (Tiny x) = [ Tiny x' | x' <- shrink x, 0 <= x', x' <= 5]

@@ -676,7 +676,7 @@         (rf, wf) = if fileExists then (10,3) else (1,3)      genAllowExisting :: Gen AllowExisting-    genAllowExisting = elements [AllowExisting, MustBeNew]+    genAllowExisting = elements [AllowExisting, MustBeNew, MustExist]      genSeekMode :: Gen SeekMode     genSeekMode = elements [@@ -1004,84 +1004,107 @@   -- > Get ..   | TagPutTruncateGet -  -- Close a handle 2 times+  -- | Close a handle 2 times   --   -- > h <- Open ..   -- > close h   -- > close h   | TagClosedTwice -  -- Open an existing file with ReadMode and then with WriteMode+  -- | Open an existing file with ReadMode and then with WriteMode   --   -- > open fp ReadMode   -- > open fp Write   | TagOpenReadThenWrite -  -- Open 2 Readers of a file.+  -- | Open 2 Readers of a file.   --   -- > open fp ReadMode   -- > open fp ReadMode   | TagOpenReadThenRead -  -- ListDir on a non empty dirextory.+  -- | ListDir on a non empty dirextory.   --   -- > CreateDirIfMissing True a/b   -- > ListDirectory a   | TagCreateDirWithParentsThenListDirNotNull -  -- Read from an AppendMode file+  -- | Read from an AppendMode file   --   -- > h <- Open fp AppendMode   -- > Read h ..   | TagReadInvalid -  -- Write to a read only file+  -- | Write to a read only file   --   -- > h <- Open fp ReadMode   -- > Put h ..   | TagWriteInvalid -  -- Put Seek and Get+  -- | Put Seek and Get   --   -- > Put ..   -- > Seek ..   -- > Get ..   | TagPutSeekGet -  -- Put Seek (negative) and Get+  -- | Put Seek (negative) and Get   --   -- > Put ..   -- > Seek .. (negative)   -- > Get ..   | TagPutSeekNegGet -  -- Open with MustBeNew (O_EXCL flag), but the file already existed.+  -- | Open with MustBeNew (O_EXCL flag), but the file already existed.   --   -- > h <- Open fp (AppendMode _)   -- > Close h   -- > Open fp (AppendMode MustBeNew)   | TagExclusiveFail +  -- | Open a file in read mode successfully+  --+  -- > h <- Open fp (WriteMode _)+  -- > Close h+  -- > h <- Open fp ReadMode+  | TagReadModeMustExist -  -- Reading returns an empty bytestring when EOF+  -- | Open a file in read mode, but it fails because the file does not exist.   --+  -- > h <- Open fp ReadMode+  | TagReadModeMustExistFail++  -- | Open a file in non-read mode with 'MustExist' successfully.+  --+  -- > h <- Open fp (_ MustBeNew)+  -- > Close h+  -- > h <- Open fp (_ MustExist)+  | TagFileMustExist++  -- | Open a file in non-read mode with 'MustExist', but it fails because the+  -- files does not exist.+  --+  -- > h <- Open fp (_ MustExist)+  | TagFileMustExistFail++  -- | Reading returns an empty bytestring when EOF+  --   -- > h <- open fp ReadMode   -- > Get h 1 == ""   | TagReadEOF --  -- GetAt+  -- | GetAt   --   -- > GetAt ...   | TagPread -  -- Roundtrip for I/O with user-supplied buffers+  -- | Roundtrip for I/O with user-supplied buffers   --   -- > PutBuf h bs c   -- > GetBuf h c          (==bs)   | TagPutGetBuf -  -- Roundtrip for I/O with user-supplied buffers+  -- | Roundtrip for I/O with user-supplied buffers   --   -- > PutBufAt h bs c o   -- > GetBufAt h c o      (==bs)@@ -1136,6 +1159,10 @@     , tagPutSeekGet Set.empty Set.empty     , tagPutSeekNegGet Set.empty Set.empty     , tagExclusiveFail+    , tagReadModeMustExist+    , tagReadModeMustExistFail+    , tagFileMustExist+    , tagFileMustExistFail     , tagReadEOF     , tagPread     , tagPutGetBuf Set.empty@@ -1480,6 +1507,39 @@           , fsErrorType fsError == FsResourceAlreadyExist ->             Left TagExclusiveFail         _otherwise -> Right tagExclusiveFail++    tagReadModeMustExist :: EventPred+    tagReadModeMustExist = C.predicate $ \ev ->+      case (eventMockCmd ev, eventMockResp ev) of+        (Open _ ReadMode, Resp (Right (RHandle _))) -> Left TagReadModeMustExist+        _otherwise -> Right tagReadModeMustExist++    tagReadModeMustExistFail :: EventPred+    tagReadModeMustExistFail = C.predicate $ \ev ->+      case (eventMockCmd ev, eventMockResp ev) of+        (Open _ ReadMode, Resp (Left fsError))+          | fsErrorType fsError == FsResourceDoesNotExist ->+            Left TagReadModeMustExistFail+        _otherwise -> Right tagReadModeMustExistFail++    tagFileMustExist :: EventPred+    tagFileMustExist = C.predicate $ \ev ->+      case (eventMockCmd ev, eventMockResp ev) of+        (Open _ mode, Resp (Right (WHandle _ _)))+          | MustExist <- allowExisting mode+          , mode /= ReadMode+          -> Left TagFileMustExist+        _otherwise -> Right tagFileMustExist++    tagFileMustExistFail :: EventPred+    tagFileMustExistFail = C.predicate $ \ev ->+      case (eventMockCmd ev, eventMockResp ev) of+        (Open _ mode, Resp (Left fsError))+          | MustExist <- allowExisting mode+          , mode /= ReadMode+          , fsErrorType fsError == FsResourceDoesNotExist ->+            Left TagFileMustExistFail+        _otherwise -> Right tagFileMustExistFail      tagReadEOF :: EventPred     tagReadEOF = successful $ \ev suc ->