temp

fs-sim/src/System/FS/Sim/Error.hs

@@ -40,6 +40,7 @@ module System.FS.Sim.Error (
   , allNull
   , genErrors
   , simpleErrors
+  , emptyErrors
   ) where
 
 import           Prelude hiding (null)
@@ -80,16 +81,6 @@ import qualified System.FS.Sim.STM as Sim
 newtype Stream a = Stream { getStream :: [Maybe a] }
     deriving (Show, Functor)
 
-instance Semigroup (Stream a) where
-  Stream s1 <> Stream s2 = Stream (zipWith pickLast s1 s2)
-    where
-      pickLast (Just x) Nothing = Just x
-      pickLast _        mbY     = mbY
-
-instance Monoid (Stream a) where
-  mempty  = Stream (repeat Nothing)
-  mappend = (<>)
-
 -- | Create a 'Stream' based on the given possibly infinite list of @'Maybe'
 -- a@s.
 mkStream :: [Maybe a] -> Stream a
@@ -104,6 +95,18 @@ runStream   (Stream (a:as)) = (a, Stream as)
 always :: a -> Stream a
 always a = Stream (repeat (Just a))
 
+-- -- | Make a 'Stream' generator based on a @a@ generator.
+-- --
+-- -- The generator generates an infinite stream, where 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.
+-- arbitraryStream :: Int -> Gen a -> Gen (Stream a)
+-- arbitraryStream  justLikeliHood genA =
+--     Stream .
+
 -- | Make a 'Stream' generator based on a @a@ generator.
 --
 -- The generator generates a finite stream of 10 elements, where each element
@@ -337,33 +340,8 @@ instance Show Errors where
         , s "renameFileE"               renameFileE
         ]
 
-instance Semigroup Errors where
-  egs1 <> egs2 = Errors
-      { dumpStateE                = combine dumpStateE
-      , hOpenE                    = combine hOpenE
-      , hCloseE                   = combine hCloseE
-      , hSeekE                    = combine hSeekE
-      , hGetSomeE                 = combine hGetSomeE
-      , hGetSomeAtE               = combine hGetSomeAtE
-      , hPutSomeE                 = combine hPutSomeE
-      , hTruncateE                = combine hTruncateE
-      , hGetSizeE                 = combine hGetSizeE
-      , createDirectoryE          = combine createDirectoryE
-      , createDirectoryIfMissingE = combine createDirectoryIfMissingE
-      , listDirectoryE            = combine listDirectoryE
-      , doesDirectoryExistE       = combine doesDirectoryExistE
-      , doesFileExistE            = combine doesFileExistE
-      , removeDirectoryRecursiveE = combine removeDirectoryRecursiveE
-      , removeFileE               = combine removeFileE
-      , renameFileE               = combine renameFileE
-      }
-    where
-      combine :: (Errors -> Stream a) -> Stream a
-      combine f = f egs1 <> f egs2
-
-instance Monoid Errors where
-  mappend = (<>)
-  mempty = simpleErrors mempty
+emptyErrors :: Errors
+emptyErrors = simpleErrors (Stream [])
 
 -- | Use the given 'ErrorStream' for each field/method. No corruption of
 -- 'hPutSome'.