File: Arbitrary.hs

package info (click to toggle)
haskell-libmpd 0.10.0.1-1
  • links: PTS
  • area: main
  • in suites: sid, trixie
  • size: 332 kB
  • sloc: haskell: 2,776; makefile: 6
file content (143 lines) | stat: -rw-r--r-- 4,332 bytes parent folder | download | duplicates (3)
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]