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