tests/Properties.hs

   1 {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-missing-methods #-}
   2 module Main (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
  31 mytest :: Testable a => a -> Int -> IO ()
  32 mytest a n = check defaultConfig { configMaxTest = n } a
  33
  34 instance Arbitrary Char where
  35     arbitrary     = choose ('\0', '\128')
  36
  37 -- an assoc. string is a string of the form "key: value".
  38 newtype AssocString = AS String
  39     deriving Show
  40
  41 instance Arbitrary AssocString where
  42     arbitrary = do
  43         key <- arbitrary
  44         val <- arbitrary
  45         return . AS $ key ++ ": " ++ val
  46
  47 newtype IntegralString = IS String
  48     deriving Show
  49
  50 instance Arbitrary IntegralString where
  51     arbitrary = do
  52         xs <- sized $ \n -> replicateM (n `min` 15) $
  53                             oneof (map return ['0'..'9'])
  54         neg <- oneof [return True, return False]
  55         return $ IS (if neg then '-':xs else xs)
  56
  57 newtype BoolString = BS String
  58     deriving Show
  59
  60 instance Arbitrary BoolString where
  61     arbitrary = do
  62         v <- oneof [return True, return False]
  63         return . BS $ if v then "1" else "0"
  64
  65 prop_toAssoc_rev :: [AssocString] -> Bool
  66 prop_toAssoc_rev x = toAssoc (fromAssoc r) == r
  67     where r = toAssoc (fromAS x)
  68           fromAssoc = map (\(a, b) -> a ++ ": " ++ b)
  69
  70 prop_toAssoc_integrity :: [AssocString] -> Bool
  71 prop_toAssoc_integrity x = length (toAssoc $ fromAS x) == length x
  72
  73 fromAS :: [AssocString] -> [String]
  74 fromAS s = [x | AS x <- s]
  75
  76 prop_parseBool_rev :: BoolString -> Bool
  77 prop_parseBool_rev (BS x) = showBool (parseBool x) == x
  78
  79 prop_parseBool :: BoolString -> Bool
  80 prop_parseBool (BS "1") = parseBool "1"
  81 prop_parseBool (BS x)   = not (parseBool x)
  82
  83 prop_showBool :: Bool -> Bool
  84 prop_showBool True = showBool True == "1"
  85 prop_showBool x    = showBool x == "0"
  86
  87 prop_splitGroups_rev :: [(String, String)] -> Bool
  88 prop_splitGroups_rev xs =
  89     let r = splitGroups xs in r == splitGroups (concat r)
  90
  91 prop_splitGroups_integrity :: [(String, String)] -> Bool
  92 prop_splitGroups_integrity xs = sort (concat $ splitGroups xs) == sort xs
  93
  94 prop_parseNum :: IntegralString -> Bool
  95 prop_parseNum (IS xs@"")      = parseNum xs == Nothing
  96 prop_parseNum (IS xs@('-':_)) = fromMaybe 0 (parseNum xs) <= 0
  97 prop_parseNum (IS xs)         = fromMaybe 0 (parseNum xs) >= 0