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