{-# LANGUAGE CPP #-}
module Caching.ExpiringCacheMap.Utils.TestSequence (
runTestSequence,
newTestSVar,
enterTestSVar,
readTestSVar,
getCurrentTime,
readNumber,
haveNumber,
TestSequenceEvents(..),
TestSequenceState(..),
TestSequence(..),
TestSVar(..)
) where
#if (!defined(__GLASGOW_HASKELL__)) || (__GLASGOW_HASKELL__ < 710)
import Control.Applicative (Applicative(..))
#endif
import Control.Monad (ap, liftM)
import Data.Word (Word32)
data TestSequenceEvents =
GetVar Word32 |
PutVar Word32 |
GetTime Word32 |
ReadNumber Int |
HaveNumber Int
deriving (TestSequenceEvents -> TestSequenceEvents -> Bool
(TestSequenceEvents -> TestSequenceEvents -> Bool)
-> (TestSequenceEvents -> TestSequenceEvents -> Bool)
-> Eq TestSequenceEvents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestSequenceEvents -> TestSequenceEvents -> Bool
$c/= :: TestSequenceEvents -> TestSequenceEvents -> Bool
== :: TestSequenceEvents -> TestSequenceEvents -> Bool
$c== :: TestSequenceEvents -> TestSequenceEvents -> Bool
Eq)
instance Show TestSequenceEvents where
show :: TestSequenceEvents -> String
show (GetVar Word32
a) = String
"GetVar " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Word32 -> String
forall a. Show a => a -> String
show Word32
a)
show (PutVar Word32
a) = String
"PutVar " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Word32 -> String
forall a. Show a => a -> String
show Word32
a)
show (GetTime Word32
a) = String
"GetTime " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Word32 -> String
forall a. Show a => a -> String
show Word32
a)
show (ReadNumber Int
a) = String
"ReadNumber " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
a)
show (HaveNumber Int
a) = String
"HaveNumber " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
a)
newtype TestSequenceState b =
TestSequenceState (Word32, [TestSequenceEvents], Maybe b)
instance Show (TestSequenceState ct) where
show :: TestSequenceState ct -> String
show (TestSequenceState (Word32
a,[TestSequenceEvents]
b,Maybe ct
_)) =
String
"TestSequenceState " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Word32 -> String
forall a. Show a => a -> String
show Word32
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([TestSequenceEvents] -> String
forall a. Show a => a -> String
show [TestSequenceEvents]
b)
newtype TestSequence b a =
TestSequence (TestSequenceState b -> (TestSequenceState b, a))
newtype TestSVar a = TestSVar a
instance Functor (TestSequence a) where
fmap :: forall a b. (a -> b) -> TestSequence a a -> TestSequence a b
fmap = (a -> b) -> TestSequence a a -> TestSequence a b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative (TestSequence a) where
pure :: forall a. a -> TestSequence a a
pure = a -> TestSequence a a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b.
TestSequence a (a -> b) -> TestSequence a a -> TestSequence a b
(<*>) = TestSequence a (a -> b) -> TestSequence a a -> TestSequence a b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad (TestSequence a) where
TestSequence TestSequenceState a -> (TestSequenceState a, a)
fun >>= :: forall a b.
TestSequence a a -> (a -> TestSequence a b) -> TestSequence a b
>>= a -> TestSequence a b
k =
(TestSequenceState a -> (TestSequenceState a, b))
-> TestSequence a b
forall b a.
(TestSequenceState b -> (TestSequenceState b, a))
-> TestSequence b a
TestSequence
(\TestSequenceState a
state -> let (TestSequenceState a
state', a
ret) = (TestSequenceState a -> (TestSequenceState a, a)
fun TestSequenceState a
state)
TestSequence TestSequenceState a -> (TestSequenceState a, b)
fun' = a -> TestSequence a b
k a
ret
in TestSequenceState a -> (TestSequenceState a, b)
fun' TestSequenceState a
state')
return :: forall a. a -> TestSequence a a
return a
ret =
(TestSequenceState a -> (TestSequenceState a, a))
-> TestSequence a a
forall b a.
(TestSequenceState b -> (TestSequenceState b, a))
-> TestSequence b a
TestSequence ((TestSequenceState a -> (TestSequenceState a, a))
-> TestSequence a a)
-> (TestSequenceState a -> (TestSequenceState a, a))
-> TestSequence a a
forall a b. (a -> b) -> a -> b
$
\(TestSequenceState (Word32
timer, [TestSequenceEvents]
hl, Maybe a
testsvar)) ->
((Word32, [TestSequenceEvents], Maybe a) -> TestSequenceState a
forall b.
(Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
TestSequenceState (Word32
timerWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
1,[TestSequenceEvents]
hl, Maybe a
testsvar), a
ret)
runTestSequence :: Show a => TestSequence b a -> IO (TestSequenceState b, a)
runTestSequence :: forall a b.
Show a =>
TestSequence b a -> IO (TestSequenceState b, a)
runTestSequence TestSequence b a
f = do
let ret :: (TestSequenceState b, a)
ret = (TestSequenceState b -> (TestSequenceState b, a)
fun ((Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
forall b.
(Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
TestSequenceState (Word32
0, [], Maybe b
forall a. Maybe a
Nothing)))
in (TestSequenceState b, a) -> IO (TestSequenceState b, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TestSequenceState b, a)
ret
where
TestSequence TestSequenceState b -> (TestSequenceState b, a)
fun = ((TestSequenceState b -> (TestSequenceState b, ()))
-> TestSequence b ()
forall b a.
(TestSequenceState b -> (TestSequenceState b, a))
-> TestSequence b a
TestSequence
(\(TestSequenceState (Word32
t, [TestSequenceEvents]
hl, Maybe b
testsvar)) ->
((Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
forall b.
(Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
TestSequenceState (Word32
tWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
1, [TestSequenceEvents]
hl, Maybe b
testsvar), ()))) TestSequence b () -> TestSequence b a -> TestSequence b a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TestSequence b a
f
newTestSVar :: a -> TestSequence a (TestSVar a)
newTestSVar :: forall a. a -> TestSequence a (TestSVar a)
newTestSVar a
var = (TestSequenceState a -> (TestSequenceState a, TestSVar a))
-> TestSequence a (TestSVar a)
forall b a.
(TestSequenceState b -> (TestSequenceState b, a))
-> TestSequence b a
TestSequence ((TestSequenceState a -> (TestSequenceState a, TestSVar a))
-> TestSequence a (TestSVar a))
-> (TestSequenceState a -> (TestSequenceState a, TestSVar a))
-> TestSequence a (TestSVar a)
forall a b. (a -> b) -> a -> b
$
\(TestSequenceState (Word32
timer, [TestSequenceEvents]
hl, Maybe a
Nothing)) ->
((Word32, [TestSequenceEvents], Maybe a) -> TestSequenceState a
forall b.
(Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
TestSequenceState (Word32
timerWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
1, [TestSequenceEvents]
hl, a -> Maybe a
forall a. a -> Maybe a
Just a
var), a -> TestSVar a
forall a. a -> TestSVar a
TestSVar a
var)
enterTestSVar :: TestSVar a -> (a -> TestSequence a (a,b)) -> TestSequence a b
enterTestSVar :: forall a b.
TestSVar a -> (a -> TestSequence a (a, b)) -> TestSequence a b
enterTestSVar TestSVar a
testsvar a -> TestSequence a (a, b)
fun = do
a
teststate <- TestSVar a -> TestSequence a a
forall a. TestSVar a -> TestSequence a a
readTestSVar TestSVar a
testsvar
(a
teststate',b
passalong) <- a -> TestSequence a (a, b)
fun a
teststate
TestSVar a -> a -> TestSequence a a
forall a. TestSVar a -> a -> TestSequence a a
putTestSVar TestSVar a
testsvar a
teststate'
b -> TestSequence a b
forall (m :: * -> *) a. Monad m => a -> m a
return b
passalong
putTestSVar :: TestSVar a -> a -> TestSequence a a
putTestSVar :: forall a. TestSVar a -> a -> TestSequence a a
putTestSVar TestSVar a
_testsvar a
testsvar' = (TestSequenceState a -> (TestSequenceState a, a))
-> TestSequence a a
forall b a.
(TestSequenceState b -> (TestSequenceState b, a))
-> TestSequence b a
TestSequence ((TestSequenceState a -> (TestSequenceState a, a))
-> TestSequence a a)
-> (TestSequenceState a -> (TestSequenceState a, a))
-> TestSequence a a
forall a b. (a -> b) -> a -> b
$
\(TestSequenceState (Word32
timer, [TestSequenceEvents]
hl, Maybe a
testsvar)) ->
((Word32, [TestSequenceEvents], Maybe a) -> TestSequenceState a
forall b.
(Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
TestSequenceState (Word32
timerWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
1, (Word32 -> TestSequenceEvents
PutVar Word32
timer) TestSequenceEvents -> [TestSequenceEvents] -> [TestSequenceEvents]
forall a. a -> [a] -> [a]
: [TestSequenceEvents]
hl, a -> Maybe a
forall a. a -> Maybe a
Just a
testsvar'),
case Maybe a
testsvar of
Maybe a
Nothing -> a
testsvar'
Just a
testsvar'' -> a
testsvar'')
readTestSVar :: TestSVar a -> TestSequence a a
readTestSVar :: forall a. TestSVar a -> TestSequence a a
readTestSVar TestSVar a
_testsvar = (TestSequenceState a -> (TestSequenceState a, a))
-> TestSequence a a
forall b a.
(TestSequenceState b -> (TestSequenceState b, a))
-> TestSequence b a
TestSequence ((TestSequenceState a -> (TestSequenceState a, a))
-> TestSequence a a)
-> (TestSequenceState a -> (TestSequenceState a, a))
-> TestSequence a a
forall a b. (a -> b) -> a -> b
$
\(TestSequenceState (Word32
timer, [TestSequenceEvents]
hl, Just a
testsvar)) ->
((Word32, [TestSequenceEvents], Maybe a) -> TestSequenceState a
forall b.
(Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
TestSequenceState (Word32
timerWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
1, (Word32 -> TestSequenceEvents
GetVar Word32
timer) TestSequenceEvents -> [TestSequenceEvents] -> [TestSequenceEvents]
forall a. a -> [a] -> [a]
: [TestSequenceEvents]
hl, a -> Maybe a
forall a. a -> Maybe a
Just a
testsvar), a
testsvar)
getCurrentTime :: TestSequence a Int
getCurrentTime :: forall a. TestSequence a Int
getCurrentTime = (TestSequenceState a -> (TestSequenceState a, Int))
-> TestSequence a Int
forall b a.
(TestSequenceState b -> (TestSequenceState b, a))
-> TestSequence b a
TestSequence ((TestSequenceState a -> (TestSequenceState a, Int))
-> TestSequence a Int)
-> (TestSequenceState a -> (TestSequenceState a, Int))
-> TestSequence a Int
forall a b. (a -> b) -> a -> b
$
\(TestSequenceState (Word32
timer, [TestSequenceEvents]
hl, Maybe a
testsvar)) ->
((Word32, [TestSequenceEvents], Maybe a) -> TestSequenceState a
forall b.
(Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
TestSequenceState (Word32
timerWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
1, (Word32 -> TestSequenceEvents
GetTime Word32
timer) TestSequenceEvents -> [TestSequenceEvents] -> [TestSequenceEvents]
forall a. a -> [a] -> [a]
: [TestSequenceEvents]
hl, Maybe a
testsvar), Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
timer)
readNumber :: TestSequence a Int
readNumber :: forall a. TestSequence a Int
readNumber = (TestSequenceState a -> (TestSequenceState a, Int))
-> TestSequence a Int
forall b a.
(TestSequenceState b -> (TestSequenceState b, a))
-> TestSequence b a
TestSequence ((TestSequenceState a -> (TestSequenceState a, Int))
-> TestSequence a Int)
-> (TestSequenceState a -> (TestSequenceState a, Int))
-> TestSequence a Int
forall a b. (a -> b) -> a -> b
$
\(TestSequenceState (Word32
timer, [TestSequenceEvents]
hl, Maybe a
testsvar)) ->
let number :: Int
number = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
timer
in ((Word32, [TestSequenceEvents], Maybe a) -> TestSequenceState a
forall b.
(Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
TestSequenceState (Word32
timerWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
1, (Int -> TestSequenceEvents
ReadNumber Int
number) TestSequenceEvents -> [TestSequenceEvents] -> [TestSequenceEvents]
forall a. a -> [a] -> [a]
: [TestSequenceEvents]
hl, Maybe a
testsvar), Int
number)
haveNumber :: Int -> TestSequence a ()
haveNumber :: forall a. Int -> TestSequence a ()
haveNumber Int
number = (TestSequenceState a -> (TestSequenceState a, ()))
-> TestSequence a ()
forall b a.
(TestSequenceState b -> (TestSequenceState b, a))
-> TestSequence b a
TestSequence ((TestSequenceState a -> (TestSequenceState a, ()))
-> TestSequence a ())
-> (TestSequenceState a -> (TestSequenceState a, ()))
-> TestSequence a ()
forall a b. (a -> b) -> a -> b
$
\(TestSequenceState (Word32
timer, [TestSequenceEvents]
hl, Maybe a
testsvar)) ->
((Word32, [TestSequenceEvents], Maybe a) -> TestSequenceState a
forall b.
(Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
TestSequenceState (Word32
timerWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
1, (Int -> TestSequenceEvents
HaveNumber Int
number) TestSequenceEvents -> [TestSequenceEvents] -> [TestSequenceEvents]
forall a. a -> [a] -> [a]
: [TestSequenceEvents]
hl, Maybe a
testsvar), ())