Merge from git-annex.

1 files changed, 39 insertions, 2 deletions

diff --git a/Utility/QuickCheck.hs b/Utility/QuickCheck.hs
index b0a39f3..2093670 100644
--- a/Utility/QuickCheck.hs
+++ b/Utility/QuickCheck.hs
@@ -1,6 +1,6 @@
 {- QuickCheck with additional instances
  -
- - Copyright 2012-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2020 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -10,16 +10,53 @@
 
 module Utility.QuickCheck
 	( module X
-	, module Utility.QuickCheck
+	, TestableString
+	, fromTestableString
+	, TestableFilePath
+	, fromTestableFilePath
+	, nonNegative
+	, positive
 	) where
 
 import Test.QuickCheck as X
 import Data.Time.Clock.POSIX
 import Data.Ratio
+import Data.Char
 import System.Posix.Types
 import Data.List.NonEmpty (NonEmpty(..))
 import Prelude
 
+{- A String, but Arbitrary is limited to ascii.
+ -
+ - When in a non-utf8 locale, String does not normally contain any non-ascii
+ - characters, except for ones in surrogate plane. Converting a string that
+ - does contain other unicode characters to a ByteString using the
+ - filesystem encoding (see GHC.IO.Encoding) will throw an exception,
+ - so use this instead to avoid quickcheck tests breaking unncessarily.
+ -} 
+newtype TestableString = TestableString
+	{ fromTestableString :: String }
+	deriving (Show)
+
+instance Arbitrary TestableString where
+	arbitrary = TestableString . filter isAscii <$> arbitrary
+
+{- FilePath constrained to not be the empty string, not contain a NUL, 
+ - and contain only ascii.
+ -
+ - No real-world filename can be empty or contain a NUL. So code can
+ - well be written that assumes that and using this avoids quickcheck
+ - tests breaking unncessarily.
+ -} 
+newtype TestableFilePath = TestableFilePath
+	{ fromTestableFilePath :: FilePath }
+	deriving (Show)
+
+instance Arbitrary TestableFilePath where
+	arbitrary = (TestableFilePath . fromTestableString <$> arbitrary)
+		`suchThat` (not . null . fromTestableFilePath)
+		`suchThat` (not . any (== '\NUL') . fromTestableFilePath)
+
 {- Times before the epoch are excluded. Half with decimal and half without. -}
 instance Arbitrary POSIXTime where
 	arbitrary = do