[commit: packages/filepath] master: Add newtypes for valid paths on Windows and Posix, make sure to be smart about shrinking with valid function (4409c75)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/filepath

On branch  : master
Link       : http://git.haskell.org/packages/filepath.git/commitdiff/4409c75af7bc122ae2ed3e45bf7bc27e62460de1

>---------------------------------------------------------------

commit 4409c75af7bc122ae2ed3e45bf7bc27e62460de1
Author: Neil Mitchell <ndmitchell at gmail.com>
Date:   Sun Nov 2 22:00:38 2014 +0000

    Add newtypes for valid paths on Windows and Posix, make sure to be smart about shrinking with valid function


>---------------------------------------------------------------

4409c75af7bc122ae2ed3e45bf7bc27e62460de1
 tests/TestUtil.hs | 28 ++++++++++++++++++++++++++--
 1 file changed, 26 insertions(+), 2 deletions(-)

diff --git a/tests/TestUtil.hs b/tests/TestUtil.hs
index 7f01f8f..08aa443 100644
--- a/tests/TestUtil.hs
+++ b/tests/TestUtil.hs
@@ -1,6 +1,6 @@
 
 module TestUtil(
-    (==>), QFilePath(..), test,
+    (==>), QFilePath(..), QFilePathValidW(..), QFilePathValidP(..), test,
     module Test.QuickCheck,
     module Data.List
     ) where
@@ -8,23 +8,47 @@ module TestUtil(
 import Test.QuickCheck hiding ((==>))
 import Data.List
 import Control.Monad
+import qualified System.FilePath.Windows as W
+import qualified System.FilePath.Posix as P
 
 infixr 0 ==>
 a ==> b = not a || b
 
 
+newtype QFilePathValidW = QFilePathValidW FilePath deriving Show
+
+instance Arbitrary QFilePathValidW where
+    arbitrary = fmap (QFilePathValidW . W.makeValid) arbitraryFilePath
+    shrink (QFilePathValidW x) = shrinkValid QFilePathValidW W.makeValid x
+
+newtype QFilePathValidP = QFilePathValidP FilePath deriving Show
+
+instance Arbitrary QFilePathValidP where
+    arbitrary = fmap (QFilePathValidP . P.makeValid) arbitraryFilePath
+    shrink (QFilePathValidP x) = shrinkValid QFilePathValidP P.makeValid x
+
 newtype QFilePath = QFilePath FilePath deriving Show
 
 instance Arbitrary QFilePath where
     arbitrary = fmap QFilePath arbitraryFilePath
-    shrink (QFilePath x) = map QFilePath $ shrink x
+    shrink (QFilePath x) = shrinkValid QFilePath id x
 
 
+-- | Generate an arbitrary FilePath use a few special (interesting) characters.
 arbitraryFilePath :: Gen FilePath
 arbitraryFilePath = sized $ \n -> do
     k <- choose (0,n)
     replicateM k $ elements "?./:\\a ;_"
 
+-- | Shrink, but also apply a validity function. Try and make shorter, or use more
+--   @a@ (since @a@ is pretty dull), but make sure you terminate even after valid.
+shrinkValid :: (FilePath -> a) -> (FilePath -> FilePath) -> FilePath -> [a]
+shrinkValid wrap valid o =
+    [ wrap y
+    | y <- map valid $ shrinkList (\x -> ['a' | x /= 'a']) o
+    , length y < length o || (length y == length o && countA y > countA o)]
+    where countA = length . filter (== 'a')
+
 
 test :: Testable a => a -> IO ()
 test prop = do