1 {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-missing-methods #-}
2 module Properties
(main
) where
3 import Network
.MPD
.Utils
9 import System
.Environment
11 import Test
.QuickCheck
15 n
<- (maybe 100 read . listToMaybe) `
liftM`
getArgs
16 mapM_ (\(s
, f
) -> printf
"%-25s : " s
>> f n
) tests
17 where tests
= [("splitGroups / reversible",
18 mytest prop_splitGroups_rev
)
19 ,("splitGroups / integrity",
20 mytest prop_splitGroups_integrity
)
21 ,("parseBool", mytest prop_parseBool
)
22 ,("parseBool / reversible",
23 mytest prop_parseBool_rev
)
24 ,("showBool", mytest prop_showBool
)
25 ,("toAssoc / reversible",
26 mytest prop_toAssoc_rev
)
27 ,("toAssoc / integrity",
28 mytest prop_toAssoc_integrity
)
29 ,("parseNum", mytest prop_parseNum
)
30 ,("parseDate / simple",
31 mytest prop_parseDate_simple
)
32 ,("parseDate / complex",
33 mytest prop_parseDate_complex
)]
35 mytest
:: Testable a
=> a
-> Int -> IO ()
36 mytest a n
= check defaultConfig
{ configMaxTest
= n
} a
38 instance Arbitrary
Char where
39 arbitrary
= choose
('\0', '\128')
41 -- an assoc. string is a string of the form "key: value".
42 newtype AssocString
= AS
String
45 instance Arbitrary AssocString
where
49 return . AS
$ key
++ ": " ++ val
51 newtype IntegralString
= IS
String
54 instance Arbitrary IntegralString
where
55 arbitrary
= fmap (IS
. show) (arbitrary
:: Gen
Integer)
57 newtype BoolString
= BS
String
60 instance Arbitrary BoolString
where
61 arbitrary
= fmap BS
$ oneof
[return "1", return "0"]
64 newtype PosInt
= PI
Integer
66 instance Show PosInt
where
69 instance Arbitrary PosInt
where
70 arbitrary
= (PI
. abs) `
fmap` arbitrary
72 -- Simple date representation, like "2004" and "1998".
73 newtype SimpleDateString
= SDS
String
76 instance Arbitrary SimpleDateString
where
77 arbitrary
= fmap (SDS
. concatMap show) .
78 replicateM
4 . oneof
$ map return [0..9]
80 -- Complex date representations, like "2004-20-30".
81 newtype ComplexDateString
= CDS
String
84 instance Arbitrary ComplexDateString
where
87 y
<- replicateM
4 . oneof
$ map return [0..9]
88 let (m
, d
) = splitAt 2 y
89 return . CDS
. intercalate
"-" $ map (concatMap show) [y
, m
, d
]
91 prop_parseDate_simple
:: SimpleDateString
-> Bool
92 prop_parseDate_simple
(SDS x
) = isJust $ parseDate x
94 prop_parseDate_complex
:: ComplexDateString
-> Bool
95 prop_parseDate_complex
(CDS x
) = isJust $ parseDate x
97 prop_toAssoc_rev
:: [AssocString
] -> Bool
98 prop_toAssoc_rev x
= toAssoc
(fromAssoc r
) == r
99 where r
= toAssoc
(fromAS x
)
100 fromAssoc
= map (\(a
, b
) -> a
++ ": " ++ b
)
102 prop_toAssoc_integrity
:: [AssocString
] -> Bool
103 prop_toAssoc_integrity x
= length (toAssoc
$ fromAS x
) == length x
105 fromAS
:: [AssocString
] -> [String]
106 fromAS s
= [x | AS x
<- s
]
108 prop_parseBool_rev
:: BoolString
-> Bool
109 prop_parseBool_rev
(BS x
) = showBool
(fromJust $ parseBool x
) == x
111 prop_parseBool
:: BoolString
-> Bool
112 prop_parseBool
(BS
"1") = fromJust $ parseBool
"1"
113 prop_parseBool
(BS x
) = not (fromJust $ parseBool x
)
115 prop_showBool
:: Bool -> Bool
116 prop_showBool
True = showBool
True == "1"
117 prop_showBool x
= showBool x
== "0"
119 prop_splitGroups_rev
:: [(String, String)] -> Bool
120 prop_splitGroups_rev xs
=
121 let r
= splitGroups xs
in r
== splitGroups
(concat r
)
123 prop_splitGroups_integrity
:: [(String, String)] -> Bool
124 prop_splitGroups_integrity xs
= sort (concat $ splitGroups xs
) == sort xs
126 prop_parseNum
:: IntegralString
-> Bool
127 prop_parseNum
(IS xs
@"") = parseNum xs
== Nothing
128 prop_parseNum
(IS xs
@('-':_
)) = fromMaybe 0 (parseNum xs
) <= 0
129 prop_parseNum
(IS xs
) = fromMaybe 0 (parseNum xs
) >= 0