tests/Properties.hs

   1 {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-missing-methods #-}
   2 module Properties (main) where
   3 import Network.MPD.Utils
   4
   5 import Control.Monad
   6 import Data.Char
   7 import Data.List
   8 import Data.Maybe
   9 import System.Environment
  10 import Text.Printf
  11 import Test.QuickCheck
  12
  13 main :: IO ()
  14 main = do
  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)]
  34
  35 mytest :: Testable a => a -> Int -> IO ()
  36 mytest a n = check defaultConfig { configMaxTest = n } a
  37
  38 instance Arbitrary Char where
  39     arbitrary     = choose ('\0', '\128')
  40
  41 -- an assoc. string is a string of the form "key: value".
  42 newtype AssocString = AS String
  43     deriving Show
  44
  45 instance Arbitrary AssocString where
  46     arbitrary = do
  47         key <- arbitrary
  48         val <- arbitrary
  49         return . AS $ key ++ ": " ++ val
  50
  51 newtype IntegralString = IS String
  52     deriving Show
  53
  54 instance Arbitrary IntegralString where
  55     arbitrary = fmap (IS . show) (arbitrary :: Gen Integer)
  56
  57 newtype BoolString = BS String
  58     deriving Show
  59
  60 instance Arbitrary BoolString where
  61     arbitrary = fmap BS $ oneof [return "1", return "0"]
  62
  63 -- Simple date representation, like "2004" and "1998".
  64 newtype SimpleDateString = SDS String
  65     deriving Show
  66
  67 instance Arbitrary SimpleDateString where
  68     arbitrary = fmap (SDS . concatMap show) .
  69                 replicateM 4 . oneof $ map return [0..9]
  70
  71 -- Complex date representations, like "2004-20-30".
  72 newtype ComplexDateString = CDS String
  73     deriving Show
  74
  75 instance Arbitrary ComplexDateString where
  76     arbitrary = do
  77         -- eww...
  78         y <- replicateM 4 . oneof $ map return [0..9]
  79         let (m, d) = splitAt 2 y
  80         return . CDS . intercalate "-" $ map (concatMap show) [y, m, d]
  81
  82 prop_parseDate_simple :: SimpleDateString -> Bool
  83 prop_parseDate_simple (SDS x) = isJust $ parseDate x
  84
  85 prop_parseDate_complex :: ComplexDateString -> Bool
  86 prop_parseDate_complex (CDS x) = isJust $ parseDate x
  87
  88 prop_toAssoc_rev :: [AssocString] -> Bool
  89 prop_toAssoc_rev x = toAssoc (fromAssoc r) == r
  90     where r = toAssoc (fromAS x)
  91           fromAssoc = map (\(a, b) -> a ++ ": " ++ b)
  92
  93 prop_toAssoc_integrity :: [AssocString] -> Bool
  94 prop_toAssoc_integrity x = length (toAssoc $ fromAS x) == length x
  95
  96 fromAS :: [AssocString] -> [String]
  97 fromAS s = [x | AS x <- s]
  98
  99 prop_parseBool_rev :: BoolString -> Bool
 100 prop_parseBool_rev (BS x) = showBool (fromJust $ parseBool x) == x
 101
 102 prop_parseBool :: BoolString -> Bool
 103 prop_parseBool (BS "1") = fromJust $ parseBool "1"
 104 prop_parseBool (BS x)   = not (fromJust $ parseBool x)
 105
 106 prop_showBool :: Bool -> Bool
 107 prop_showBool True = showBool True == "1"
 108 prop_showBool x    = showBool x == "0"
 109
 110 prop_splitGroups_rev :: [(String, String)] -> Bool
 111 prop_splitGroups_rev xs =
 112     let r = splitGroups xs in r == splitGroups (concat r)
 113
 114 prop_splitGroups_integrity :: [(String, String)] -> Bool
 115 prop_splitGroups_integrity xs = sort (concat $ splitGroups xs) == sort xs
 116
 117 prop_parseNum :: IntegralString -> Bool
 118 prop_parseNum (IS xs@"")      = parseNum xs == Nothing
 119 prop_parseNum (IS xs@('-':_)) = fromMaybe 0 (parseNum xs) <= 0
 120 prop_parseNum (IS xs)         = fromMaybe 0 (parseNum xs) >= 0