1{-# LANGUAGE OverloadedStrings #-}
2
3module TestECMWithTestSequenceCommon (
4    someEventsOnly,
5    numberEventsOnly,
6    pattern',
7    pattern'',
8    pattern''',
9    pattern'''',
10    testLookups,
11    printOutEvents,
12    printOutFailedPattern
13) where
14
15import qualified Caching.ExpiringCacheMap.Utils.TestSequence as TestSeq
16
17import qualified Data.ByteString.Char8 as BS
18
19printOutFailedPattern from_where filt_events' filt_events'' filt_events''' filt_events'''' = do
20  putStrLn $ "Failed sequence test in " ++ from_where ++ ":"
21  if not (pattern' (filt_events'))
22    then putStrLn $ "Failed: pattern 1: " ++ (show filt_events')
23    else return ()
24  if not (pattern'' (filt_events''))
25    then putStrLn $ "Failed: pattern 2: " ++ (show filt_events'')
26    else return ()
27  if not (pattern''' (filt_events'''))
28    then putStrLn $ "Failed: pattern 3: " ++ (show filt_events''')
29    else return ()
30  if not (pattern'''' (filt_events''''))
31    then putStrLn $ "Failed: pattern 4: " ++ (show filt_events'''')
32    else return ()
33  return ()
34
35
36printOutEvents events' events'' events''' events'''' = do
37  (putStrLn . show . filter someEventsOnly . reverse) events'
38  (putStrLn . show . filter someEventsOnly . reverse) events''
39  (putStrLn . show . filter someEventsOnly . reverse) events'''
40  (putStrLn . show . filter someEventsOnly . reverse) events''''
41  return ()
42
43someEventsOnly a =
44  case a of
45    TestSeq.GetTime _    -> True
46    TestSeq.ReadNumber _ -> True
47    TestSeq.HaveNumber _ -> True
48    _ -> False
49
50numberEventsOnly a =
51  case a of
52    TestSeq.ReadNumber _ -> True
53    TestSeq.HaveNumber _ -> True
54    _ -> False
55
56pattern' c =
57  case c of
58    [ TestSeq.ReadNumber numr1,
59      TestSeq.GetTime _,
60      TestSeq.HaveNumber numh1,
61      TestSeq.HaveNumber numh1',
62      TestSeq.ReadNumber numr2,
63      TestSeq.GetTime _,
64      TestSeq.HaveNumber numh2 ]
65      | numr1 == numh1 && numr1 == numh1' && numr2 == numh2 -> True
66    _ -> False
67
68pattern'' c =
69  case c of
70    [ TestSeq.ReadNumber numr1,
71      TestSeq.GetTime _,
72      TestSeq.HaveNumber numh1,
73      TestSeq.GetTime _,
74      TestSeq.GetTime _,
75      TestSeq.HaveNumber numh1',
76      TestSeq.ReadNumber numr2,
77      TestSeq.GetTime _,
78      TestSeq.HaveNumber numh2 ]
79      | numr1 == numh1 && numr1 == numh1' && numr2 == numh2 -> True
80    _ -> False
81
82pattern''' c =
83  case c of
84    [ TestSeq.ReadNumber numr1,
85      TestSeq.GetTime _,
86      TestSeq.HaveNumber numh1,
87      TestSeq.HaveNumber numh1',
88      TestSeq.ReadNumber numr2,
89      TestSeq.GetTime _,
90      TestSeq.HaveNumber numh2 ]
91      | numr1 == numh1 && numr1 == numh1' && numr2 == numh2 -> True
92    _ -> False
93
94pattern'''' c =
95  case c of
96    [ TestSeq.ReadNumber numr1,
97      TestSeq.GetTime _,
98      TestSeq.HaveNumber numh1,
99      TestSeq.GetTime _,
100      TestSeq.ReadNumber numr2,
101      TestSeq.GetTime _,
102      TestSeq.HaveNumber numh2,
103      TestSeq.ReadNumber numr3,
104      TestSeq.GetTime _,
105      TestSeq.HaveNumber numh3 ]
106      | numr1 == numh1 && numr2 == numh2 && numr3 == numh3 -> True
107    _ -> False
108
109testLookups lookup = do
110  b <- lookup ("file1" :: BS.ByteString)
111  TestSeq.haveNumber b
112  b <- lookup "file1"
113  TestSeq.haveNumber b
114  b <- lookup "file2"
115  TestSeq.haveNumber b
116  return b
117