tests/Properties.hs

   1 {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-missing-methods #-}
   2 module Properties (main) where
   3 import Network.MPD.Utils
   4 import Network.MPD.Parse
   5
   6 import Control.Monad
   7 import Data.Char
   8 import Data.List
   9 import Data.Maybe
  10 import System.Environment
  11 import Text.Printf
  12 import Test.QuickCheck
  13
  14 main :: IO ()
  15 main = do
  16     n <- (maybe 100 read . listToMaybe) `liftM` getArgs
  17     mapM_ (\(s, f) -> printf "%-25s : " s >> f n) tests
  18     where tests = [("splitGroups / reversible",
  19                         mytest prop_splitGroups_rev)
  20                   ,("splitGroups / integrity",
  21                         mytest prop_splitGroups_integrity)
  22                   ,("parseBool", mytest prop_parseBool)
  23                   ,("parseBool / reversible",
  24                         mytest prop_parseBool_rev)
  25                   ,("showBool", mytest prop_showBool)
  26                   ,("toAssoc / reversible",
  27                         mytest prop_toAssoc_rev)
  28                   ,("toAssoc / integrity",
  29                         mytest prop_toAssoc_integrity)
  30                   ,("parseNum", mytest prop_parseNum)
  31                   ,("parseDate / simple",
  32                         mytest prop_parseDate_simple)
  33                   ,("parseDate / complex",
  34                         mytest prop_parseDate_complex)
  35                   ,("parseCount", mytest prop_parseCount)
  36                   ,("parseOutputs", mytest prop_parseOutputs)
  37                   ,("parseSong", mytest prop_parseSong)]
  38
  39 mytest :: Testable a => a -> Int -> IO ()
  40 mytest a n = check defaultConfig { configMaxTest = n } a
  41
  42 instance Arbitrary Char where
  43     arbitrary     = choose ('\0', '\128')
  44
  45 -- an assoc. string is a string of the form "key: value".
  46 newtype AssocString = AS String
  47     deriving Show
  48
  49 instance Arbitrary AssocString where
  50     arbitrary = do
  51         key <- arbitrary
  52         val <- arbitrary
  53         return . AS $ key ++ ": " ++ val
  54
  55 newtype IntegralString = IS String
  56     deriving Show
  57
  58 instance Arbitrary IntegralString where
  59     arbitrary = fmap (IS . show) (arbitrary :: Gen Integer)
  60
  61 newtype BoolString = BS String
  62     deriving Show
  63
  64 instance Arbitrary BoolString where
  65     arbitrary = fmap BS $ oneof [return "1", return "0"]
  66
  67 -- Positive integers.
  68 newtype PosInt = PI Integer
  69
  70 instance Show PosInt where
  71     show (PI x) = show x
  72
  73 instance Arbitrary PosInt where
  74     arbitrary = (PI . abs) `fmap` arbitrary
  75
  76 -- Simple date representation, like "2004" and "1998".
  77 newtype SimpleDateString = SDS String
  78     deriving Show
  79
  80 instance Arbitrary SimpleDateString where
  81     arbitrary = (SDS . show) `fmap` (arbitrary :: Gen PosInt)
  82
  83 -- Complex date representations, like "2004-20-30".
  84 newtype ComplexDateString = CDS String
  85     deriving Show
  86
  87 instance Arbitrary ComplexDateString where
  88     arbitrary = do
  89         -- eww...
  90         [y,m,d] <- replicateM 3 (arbitrary :: Gen PosInt)
  91         return . CDS . concat . intersperse "-" $ map show [y,m,d]
  92
  93 prop_parseDate_simple :: SimpleDateString -> Bool
  94 prop_parseDate_simple (SDS x) = isJust $ parseDate x
  95
  96 prop_parseDate_complex :: ComplexDateString -> Bool
  97 prop_parseDate_complex (CDS x) = isJust $ parseDate x
  98
  99 prop_toAssoc_rev :: [AssocString] -> Bool
 100 prop_toAssoc_rev x = toAssoc (fromAssoc r) == r
 101     where r = toAssoc (fromAS x)
 102           fromAssoc = map (\(a, b) -> a ++ ": " ++ b)
 103
 104 prop_toAssoc_integrity :: [AssocString] -> Bool
 105 prop_toAssoc_integrity x = length (toAssoc $ fromAS x) == length x
 106
 107 fromAS :: [AssocString] -> [String]
 108 fromAS s = [x | AS x <- s]
 109
 110 prop_parseBool_rev :: BoolString -> Bool
 111 prop_parseBool_rev (BS x) = showBool (fromJust $ parseBool x) == x
 112
 113 prop_parseBool :: BoolString -> Bool
 114 prop_parseBool (BS "1") = fromJust $ parseBool "1"
 115 prop_parseBool (BS x)   = not (fromJust $ parseBool x)
 116
 117 prop_showBool :: Bool -> Bool
 118 prop_showBool True = showBool True == "1"
 119 prop_showBool x    = showBool x == "0"
 120
 121 prop_splitGroups_rev :: [(String, String)] -> Property
 122 prop_splitGroups_rev xs = not (null xs) ==>
 123     let wrappers = [(fst $ head xs, id)]
 124         r = splitGroups wrappers xs
 125     in r == splitGroups wrappers (concat r)
 126
 127 prop_splitGroups_integrity :: [(String, String)] -> Property
 128 prop_splitGroups_integrity xs = not (null xs) ==>
 129     sort (concat $ splitGroups [(fst $ head xs, id)] xs) == sort xs
 130
 131 prop_parseNum :: IntegralString -> Bool
 132 prop_parseNum (IS xs@"")      = parseNum xs == Nothing
 133 prop_parseNum (IS xs@('-':_)) = fromMaybe 0 (parseNum xs) <= 0
 134 prop_parseNum (IS xs)         = fromMaybe 0 (parseNum xs) >= 0
 135
 136
 137 --------------------------------------------------------------------------
 138 -- Parsers
 139 --------------------------------------------------------------------------
 140
 141 -- MPD fields can't contain newlines and the parser skips initial spaces.
 142 field :: Gen String
 143 field = (filter (/= '\n') . dropWhile isSpace) `fmap` arbitrary
 144
 145 -- | A uniform interface for types that
 146 -- can be turned into raw responses
 147 class Displayable a where
 148     empty   :: a             -- ^ An empty instance
 149     display :: a -> String   -- ^ Transform instantiated object to a
 150                              --   string
 151
 152 instance Displayable Count where
 153     empty = Count { cSongs = 0, cPlaytime = 0 }
 154     display s = unlines $
 155         ["songs: "    ++ show (cSongs s)
 156         ,"playtime: " ++ show (cPlaytime s)]
 157
 158 instance Arbitrary Count where
 159     arbitrary = do
 160         songs <- arbitrary
 161         time  <- arbitrary
 162         return $ Count { cSongs = songs, cPlaytime = time }
 163
 164 prop_parseCount :: Count -> Bool
 165 prop_parseCount c = Right c == (parseCount . lines $ display c)
 166
 167 instance Displayable Device where
 168     empty = Device 0 "" False
 169     display d = unlines $
 170         ["outputid: "      ++ show (dOutputID d)
 171         ,"outputname: "    ++ dOutputName d
 172         ,"outputenabled: " ++ showBool (dOutputEnabled d)]
 173
 174 instance Arbitrary Device where
 175     arbitrary = do
 176         did <- arbitrary
 177         name <- field
 178         enabled <- arbitrary
 179         return $ Device did name enabled
 180
 181 prop_parseOutputs :: [Device] -> Bool
 182 prop_parseOutputs ds =
 183     Right ds == (parseOutputs . lines $ concatMap display ds)
 184
 185 instance Displayable Song where
 186     empty = Song { sgArtist = "", sgAlbum = "", sgTitle = "", sgFilePath = ""
 187                  , sgGenre  = "", sgName  = "", sgComposer = ""
 188                  , sgPerformer = "", sgLength = 0, sgDate = 0
 189                  , sgTrack = (0,0), sgDisc = (0,0), sgIndex = Nothing }
 190     display s = unlines $
 191         ["file: "      ++ sgFilePath s
 192         ,"Artist: "    ++ sgArtist s
 193         ,"Album: "     ++ sgAlbum s
 194         ,"Title: "     ++ sgTitle s
 195         ,"Genre: "     ++ sgGenre s
 196         ,"Name: "      ++ sgName s
 197         ,"Composer: "  ++ sgComposer s
 198         ,"Performer: " ++ sgPerformer s
 199         ,"Date: "      ++ show (sgDate s)
 200         ,"Track: "     ++ (let (x,y) = sgTrack s in show x++"/"++show y)
 201         ,"Disc: "      ++ (let (x,y) = sgDisc  s in show x++"/"++show y)
 202         ,"Time: "      ++ show (sgLength s)]
 203         ++ maybe [] (\x -> [case x of Pos n -> "Pos: " ++ show n
 204                                       ID  n -> "Id: "  ++ show n]) (sgIndex s)
 205
 206 instance Arbitrary Song where
 207     arbitrary = do
 208         [file,artist,album,title,genre,name,cmpsr,prfmr] <- replicateM 8 field
 209         date  <- abs `fmap` arbitrary
 210         len   <- abs `fmap` arbitrary
 211         track <- two $ abs `fmap` arbitrary
 212         disc  <- two $ abs `fmap` arbitrary
 213         idx   <- oneof [return Nothing
 214                        ,liftM (Just . Pos) $ abs `fmap` arbitrary
 215                        ,liftM (Just . ID)  $ abs `fmap` arbitrary]
 216         return $ Song { sgArtist = artist, sgAlbum = album, sgTitle = title
 217                       , sgFilePath = file, sgGenre = genre, sgName = name
 218                       , sgComposer = cmpsr, sgPerformer = prfmr, sgLength = len
 219                       , sgDate = date, sgTrack = track, sgDisc = disc
 220                       , sgIndex = idx }
 221
 222 prop_parseSong :: Song -> Bool
 223 prop_parseSong s = Right s == (parseSong . toAssoc . lines $ display s)