1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
|
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wwarn -fno-warn-orphans -fno-warn-missing-methods -XFlexibleInstances #-}
-- | This module contains Arbitrary instances for various types.
module Arbitrary
( AssocString(..)
, BoolString(..)
, YearString(..)
, DateString(..)
, MetadataMap(..)
, positive, field
) where
import Control.Applicative ((<$>), (<*>))
import Control.Monad (liftM2, liftM3, replicateM)
import Data.Char (isSpace)
import Data.List (intersperse)
import qualified Data.Map as M
import Data.Time
import Test.QuickCheck
import Test.QuickCheck.Arbitrary
import Test.QuickCheck.Gen
import Network.MPD.Commands.Types
import Data.ByteString (ByteString)
import qualified Data.ByteString.UTF8 as UTF8
instance Arbitrary ByteString where
arbitrary = UTF8.fromString <$> listOf1 arbitraryPrintableChar
-- No longer provided by QuickCheck 2
-- two :: Monad m => m a -> m (a, a)
-- two m = liftM2 (,) m m
three :: Monad m => m a -> m (a, a, a)
three m = liftM3 (,,) m m m
-- Generate a positive number.
positive :: (Arbitrary a, Num a) => Gen a
positive = abs <$> arbitrary
possibly :: Gen a -> Gen (Maybe a)
possibly m = arbitrary >>= bool (Just <$> m) (return Nothing)
where bool thenE elseE b = if b then thenE else elseE
-- MPD fields can't contain newlines and the parser skips initial spaces.
field :: Gen String
field = (filter (/= '\n') . dropWhile isSpace) <$> listOf1 arbitraryPrintableChar
fieldBS :: Gen ByteString
fieldBS = UTF8.fromString <$> field
instance Arbitrary Value where
arbitrary = Value <$> fieldBS
newtype MetadataMap = MetadataMap { fromMetadataMap :: M.Map Metadata [Value] }
deriving (Show)
instance Arbitrary MetadataMap where
arbitrary = do
size <- choose (1, 1000)
vals <- replicateM size (listOf1 arbitrary)
keys <- replicateM size arbitrary
return . MetadataMap $ M.fromList (zip keys vals)
-- Orphan instances for built-in types
instance Arbitrary Day where
arbitrary = ModifiedJulianDay <$> arbitrary
instance Arbitrary DiffTime where
arbitrary = secondsToDiffTime <$> positive
instance Arbitrary UTCTime where
arbitrary = UTCTime <$> arbitrary <*> arbitrary
-- an assoc. string is a string of the form "key: value", followed by
-- the key and value separately.
data AssocString = AS ByteString ByteString ByteString
instance Show AssocString where
show (AS str _ _) = UTF8.toString str
instance Arbitrary AssocString where
arbitrary = do
key <- filter (/= ':') <$> arbitrary
val <- dropWhile (== ' ') <$> arbitrary
return $ AS (UTF8.fromString (key ++ ": " ++ val))
(UTF8.fromString key)
(UTF8.fromString val)
newtype BoolString = BS ByteString
deriving Show
instance Arbitrary BoolString where
arbitrary = BS <$> elements ["1", "0"]
-- Simple date representation, like "2004" and "1998".
newtype YearString = YS ByteString
deriving Show
instance Arbitrary YearString where
arbitrary = YS . UTF8.fromString . show <$> (positive :: Gen Integer)
-- Complex date representations, like "2004-20-30".
newtype DateString = DS ByteString
deriving Show
instance Arbitrary DateString where
arbitrary = do
(y,m,d) <- three (positive :: Gen Integer)
return . DS . UTF8.fromString . concat . intersperse "-" $ map show [y,m,d]
instance Arbitrary Count where
arbitrary = liftM2 Count arbitrary arbitrary
instance Arbitrary Device where
arbitrary = liftM3 Device arbitrary field arbitrary
instance Arbitrary Id where
arbitrary = Id <$> arbitrary
instance Arbitrary Song where
arbitrary = Song <$> arbitrary
<*> (fromMetadataMap <$> arbitrary)
<*> possibly arbitrary
<*> positive
<*> possibly arbitrary
<*> possibly positive
instance Arbitrary Path where
arbitrary = Path <$> fieldBS
instance Arbitrary Stats where
arbitrary = Stats <$> positive <*> positive <*> positive <*> positive
<*> positive <*> positive <*> positive
instance Arbitrary Metadata where
arbitrary = elements [minBound .. maxBound]
|