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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
|
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.Map.Syntax.Tests where
------------------------------------------------------------------------------
import qualified Data.List as L
import Data.Function (on)
import qualified Data.Map as M
import Data.Monoid (mempty, mappend)
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.HUnit (assertEqual)
import Data.Map.Syntax
import Data.Map.Syntax.Util (mkMapABC, mkMapDEF,mkMapAEF,
ArbMapSyntax(..))
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- |Simple tests for not-nested maps
insTests :: Spec
insTests = do
it "Insert overwrite" overDup
it "Insert over fail" failDup
it "Reject duplicate" skipDup
it "Trying dupFunc" dupFunc
prop "Insert overwrite from list" prop_syntaxMatchesNubOver
prop "Insert conditional from list" prop_syntaxMatchesNubCond
prop "Insert error on dup from list" prop_syntaxMatchesNubErr
monoidLaws :: Spec
monoidLaws = do
prop "Left identity" prop_leftId
prop "Right identity" prop_rightId
prop "Associativity" prop_assoc
------------------------------------------------------------------------------
-- |Simple tests of ##, #!, #?
overDup :: IO ()
overDup = assertEqual "Failed to overwrite duplicate entry"
(Right $ M.fromList [("firstName","Egon") :: (String,String)])
(runMap $ mkDupMap (##))
failDup :: IO ()
failDup = assertEqual "Failed to error on duplicate entry"
(Left [("firstName" :: String)])
(runMap $ mkDupMap (#!))
skipDup :: IO ()
skipDup = assertEqual "Failed to reject duplicate entry"
(Right $ M.fromList [("firstName","Peter")])
(runMap $ mkDupMap (#?))
dupFunc :: IO ()
dupFunc = assertEqual "Failed use dupFunc"
(Right $ M.fromList [("firstName","firstNamePeterEgon")
:: (String,String)])
(runMapSyntax' f M.lookup M.insert $ mkDupMap (#!))
where
f k v v1 = Just (k `mappend` v1 `mappend` v)
mkDupMap :: (String -> String -> MapSyntax String String)
-> MapSyntax String String
mkDupMap strat = do
"firstName" `strat` "Peter"
"firstName" `strat` "Egon"
------------------------------------------------------------------------------
prop_syntaxMatchesNubOver :: [(String,Int)] -> Bool
prop_syntaxMatchesNubOver pairs = Right revNubMap == (runMap mSyntax)
where mSyntax = mapM_ (\(k,v) -> (k ## v)) pairs
revNubMap = M.fromList . L.nubBy ((==) `on` fst) . L.reverse $ pairs
-- Nub keeps the first of each unique entry, so reverse list to
-- simulate keeping the last
prop_syntaxMatchesNubCond :: [(String,Int)] -> Bool
prop_syntaxMatchesNubCond pairs = Right nubMap == (runMap mSyntax)
where mSyntax = mapM_ (\(k,v) -> (k #? v)) pairs
nubMap = M.fromList . L.nubBy ((==) `on` fst) $ pairs
prop_syntaxMatchesNubErr :: [(String,Int)] -> Bool
prop_syntaxMatchesNubErr pairs =
let mMap = runMap $ mapM_ (\(k,v) -> (k #! v)) pairs
in if pairs == L.nubBy ((==) `on` fst) pairs
then mMap == (Right . M.fromList $ pairs)
else case mMap of
Right _ -> False -- We expected (Left dupKeys)
Left _ -> True -- Wasn't sure about semantics here
-- runMap ... ("a" #! 1) >> ("a" #! 2) >> ("a" #! 3)
-- should be (Left ["a"]), or (Left ["a","a"])?
------------------------------------------------------------------------------
-- |Tests for #! when do blocks are nested
nestingTests :: Spec
nestingTests = do
it "Nested error dups" nestedErr
it "Nested error dups mapK" nestedErrMapK
it "Nester error dups mapV" nestedErrMapV
it "Nested overwrite dups" nestedOver
it "Nested overwrite dups mapK" nestedOverMapK
it "Nested overwrite dups mapV" nestedOverMapV
it "Nested ignore dups mixed" nestedIgnoreMix
it "Nested complex pass" nestedComplex
it "Nested complex error" nestedComplexErr
nestedErr :: IO ()
nestedErr = assertEqual "Failed to error on duplicates across do blocks"
(Left ['E','F'])
(runMap $ do {mkMapDEF (#!); mkMapAEF (#!)})
nestedErrMapK :: IO ()
nestedErrMapK = assertEqual "Failed to error on mapK'ed dups across blocks"
(Left ['B'])
(runMap $ do
mapK succ $ mkMapABC (#!)
mapK succ $ mkMapAEF (#!)
)
nestedErrMapV :: IO ()
nestedErrMapV = assertEqual "Failed to error on mapV'ed dups across blocks"
(Left ['A'])
(runMap $ do
mapV succ $ mkMapABC (#!)
mapV succ $ mkMapAEF (#!)
)
nestedOver :: IO ()
nestedOver = assertEqual "Failed to overwrite dup entries across blocks"
(Right $ M.fromList
[('A',100),('B',2),('C',3),('E',200),('F',300)])
(runMap $ do
mkMapABC (##)
mkMapAEF (##)
)
nestedOverMapK :: IO ()
nestedOverMapK = assertEqual "Failed to mapK in nested blocks"
(Right $ M.fromList
[('A',100),('E',200),('F',300),('C',10),('D',20),('B',2)])
(runMap $ do
mkMapABC (##)
mapK pred $ mkMapDEF (##)
mkMapAEF (##)
)
nestedOverMapV :: IO ()
nestedOverMapV = assertEqual "Failed to mapV in nested blocks"
(Right $ M.fromList
[('A',99),('B',2),('C',3),('E',199),('F',299)])
(runMap $ do
mkMapABC (##)
mapV pred $ mkMapAEF (##)
)
nestedIgnoreMix :: IO ()
nestedIgnoreMix = assertEqual "Failed to mapK/mapV in 'Ignore' do blocks"
(Right $ M.fromList
[('B',0),('C',1),('D',2),('E',31),('@',101)])
(runMap $ do
mapV pred . mapK succ $ mkMapABC (#?)
mapV succ . mapK pred $ mkMapDEF (#?)
mapK pred . mapV succ $ mkMapAEF (#?)
)
nestedComplex :: IO ()
nestedComplex = assertEqual "Failed a mix of dup strategies in nested block"
(Right $ M.fromList
[('@',1),('A',2),('B',1000),('C',1000),('D',10),('E',20),('F',30),('G',300),('H',199),('I',299)])
(runMap $ do
mapK succ . mapK succ $ mkMapABC (##)
mapK succ . mapK succ . mapK succ . mapV pred $
mkMapAEF (#?)
mapK succ ((mapV (const 1000) $ mkMapABC (##)) >>
mkMapAEF (#?))
mkMapDEF (##)
mapK pred $ mkMapABC (#?)
)
nestedComplexErr :: IO ()
nestedComplexErr = assertEqual
"Failed to detect dup in complex nested block"
(Left ['B'])
(runMap $ do
mapK succ . mapK succ $ mkMapABC (##)
mapK succ . mapK succ . mapK succ . mapV pred $
mkMapAEF (#?)
mapK succ ((mapV (const 1000) $ mkMapABC (##)) >>
mkMapAEF (#?))
mapK pred $ mkMapABC (#!)
mkMapDEF (##)
mapK pred $ mkMapABC (#?)
)
------------------------------------------------------------------------------
-- |Monoid Laws
prop_leftId :: ArbMapSyntax String Int -> Bool
prop_leftId a = runMap (mempty `mappend` m) == runMap m
where m = unArbSyntax a
prop_rightId :: ArbMapSyntax String Int -> Bool
prop_rightId a = runMap (m `mappend` mempty) == runMap m
where m = unArbSyntax a
prop_assoc :: ArbMapSyntax String Int
-> ArbMapSyntax String Int
-> ArbMapSyntax String Int
-> Bool
prop_assoc a' b' c' =
runMap ((a `mappend` b) `mappend` c) ==
runMap (a `mappend` (b `mappend` c))
where a = unArbSyntax a'
b = unArbSyntax b'
c = unArbSyntax c'
|
