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]
|
