1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
-- File created: 2008-10-10 22:03:00
module Tests.Base ( PString(unPS), Path(unP), COpts(unCOpts)
, (-->), fromRight, isRight
) where
import System.FilePath (extSeparator, pathSeparators)
import Test.QuickCheck
import System.FilePath.Glob.Base (CompOptions(..))
newtype PString = PatString { unPS :: String } deriving Show
newtype Path = Path { unP :: String } deriving Show
newtype COpts = COpts { unCOpts :: CompOptions } deriving Show
alpha0, alpha :: String
alpha0 = extSeparator : "-^!" ++ ['a'..'z'] ++ ['0'..'9']
alpha = pathSeparators ++ alpha0
instance Arbitrary PString where
arbitrary = sized $ \size -> do
let xs =
(1, return "**/") :
map (\(a,b) -> (a*100,b))
[ (40, plain alpha)
, (20, return "?")
, (20, charRange)
, (10, return "*")
, (10, openRange)
]
s <- mapM (const $ frequency xs) [1..size]
return.PatString $ concat s
shrink (PatString s) = map PatString (shrink s)
instance Arbitrary Path where
arbitrary = sized $ \size -> do
s <- mapM (const $ plain alpha) [1..size `mod` 16]
return.Path $ concat s
shrink (Path s) = map Path (shrink s)
instance Arbitrary COpts where
arbitrary = do
(a,b,c,d,e,f) <- arbitrary
return.COpts $ CompOptions a b c d e f False
plain :: String -> Gen String
plain from = sized $ \size -> mapM (const $ elements from) [0..size `mod` 3]
charRange :: Gen String
charRange = do
s <- plain alpha0
if s `elem` ["^","!"]
then do
s' <- plain alpha0
return$ "[" ++ s ++ s' ++ "]"
else
return$ "[" ++ s ++ "]"
openRange :: Gen String
openRange = do
probA <- choose (0,1) :: Gen Float
probB <- choose (0,1) :: Gen Float
a <- if probA > 0.4
then fmap (Just .abs) arbitrary
else return Nothing
b <- if probB > 0.4
then fmap (Just .abs) arbitrary
else return Nothing
return.concat $
[ "<"
, maybe "" show (a :: Maybe Int)
, "-"
, maybe "" show (b :: Maybe Int)
, ">"
]
-- Not in Data.Either until base-4.7 (GHC 7.8)
isRight :: Either a b -> Bool
isRight (Right _) = True
isRight _ = False
fromRight :: Either a b -> b
fromRight (Right x) = x
fromRight _ = error "fromRight :: Left"
(-->) :: Bool -> Bool -> Bool
a --> b = not a || b
|
