Here's an event network sample that I've been using to investigate the behavior of particular monadic actions. I'm wanting a principled approach, rather than this ad-hoc way of testing my code. I know how to test my functions, but I'm looking for best practices for testing Behaviors and Events, given the new design choices in reactive-banana 1.0.0
I'm leaving out a lot, in the hopes I've included only what is necessary to illustrate my problem. Please let me know if there's something missing that should be included to make the problem clearer.
makeNetworkDescription :: Parameters -> MomentIO ()
makeNetworkDescription params = mdo
eInput <- fromAddHandler (input params)
eTick <- fromAddHandler (tick params)
let
eValidated :: Event VAC
eValidated = toVAC <$> eInput
eClearBuffer = Clear <$ eBuffer
eBuffer ::Event BufferMap
eBuffer = bBuffer <@ eTick
bBuffer <- accumB (BufferMap (M.empty :: M.Map AID VAC)) $
manageBuffer <$> unionWith (clearBuffer) eValidated eClearBuffer
reactimate $ writeOut_Debug <$> eBuffer
What the buffer is supposed to do, is accumulated player commands (which would then be processed elsewhere), and then be emptied once a particular batch of player commands were processed. Upon the next tick, it happens all over again.
I'm looking to make sure the buffer gets cleared when it supposed to be, and accumulates commands like it is supposed to. Right now, the code works, and I want to write tests to assure it keeps working as I build this game out.
I could make the buffer Behavior
separated from the Event
network in the above example, but what then? What's the best way to get accurate results from the test?
Edit: Update - I believe this link will provide sufficient hints. I'll take a stab at it and report with more details tomorrow.
Edit: Update - I have a unit test written. I will upload to github when it's purty, and then post. The above link was very helpful in sorting out what to do.
Edit: Update - Turns out, if you run stack test and there are type errors, and then you run it again you get output that says your tests have passed. The upshot is, I'm no closer that I was yesterday. I have code and a clearer problem. I may start a different post for that.ct
Edit: Update - I have a test that breaks in a way that is helpful, but I don't what to do about it exactly. I've posted the entire project for context. Below I include just the test code, errors and some discussion.
main :: IO ()
main = defaultMain
[ testGroup "EventNetwork Input"
[testBuffer "bBuffer" Populated]
]
testBuffer :: String -> BufferState -> Test
testBuffer name Populated =
testCase name $ assert $ bufferPopulated (UAC (PlayerCommand (Move (ToPlanetName Mongo)) (AID (Data.Text.pack "100"))))
testBuffer name Empty =
testCase name $ assert $ bufferEmptied (UAC (PlayerCommand (Move (ToPlanetName Mongo)) (AID (Data.Text.pack "100"))))
bufferPopulated :: UAC -> MomentIO Bool
bufferPopulated ev = do
let eInput = ev <$ never
eValidated = toVAC <$> eInput
bBufferMap <- (buffer eValidated eClear) :: MomentIO (Behavior BufferMap)
let r2 = [(Just $ BufferMap $ M.insert (AID (Data.Text.pack "100")) (toVAC ev) (M.empty :: M.Map AID VAC))]
r1 <- liftIO $ ((interpret (eBuffer bBufferMap) []) :: IO [Maybe BufferMap])
return $ r1 == r2
bufferEmptied :: UAC -> MomentIO Bool
bufferEmptied ev = undefined
eBuffer :: Behavior BufferMap -> Event a -> Event BufferMap
eBuffer bBufferMap nvr =
bBufferMap <@ (() <$ nvr)
eClear = Clear <$ (() <$ never)
tests/Spec.hs:26:19:
No instance for (Test.HUnit.Base.Assertable (MomentIO Bool))
arising from a use of ‘assert’
In the expression: assert
In the second argument of ‘($)’, namely
‘assert
$ bufferPopulated
(UAC
(PlayerCommand (Move (ToPlanetName Mongo)) (AID (pack "100"))))’
In the expression:
testCase name
$ assert
$ bufferPopulated
(UAC
(PlayerCommand (Move (ToPlanetName Mongo)) (AID (pack "100"))))
The problem comes down to accumB
creating a Behavior
in a MomemtIO
. If I have bufferPopulated
return an IO Bool
how can I reconcile that?
Edit: The obvious thing is to write the instance it wants. I think this is probably a red-herring. What do you think. Is this as simple as just writing the MomentIO Bool
instance?
Edit: Update
I think I'm on the right track. I have commented out all test harness code and have changed the signature for bufferPopulated
bufferPopulated :: UAC -> IO Bool
bufferPopulated ev = do
let eInput = ev <$ never
eValidated = toVAC <$> eInput
bBufferMap <- liftMoment ((buffer eValidated eClear) :: Moment (Behavior BufferMap))
let r2 = [(Just $ BufferMap $ M.insert (AID (Data.Text.pack "100")) (toVAC ev) (M.empty :: M.Map AID VAC))]
r1 <- (interpret (eBuffer bBufferMap) []) :: IO [Maybe BufferMap])
return $ r1 == r2
I believe this should work, but here's the error
tests/Spec.hs:35:17:
No instance for (MonadMoment IO) arising from a use of ‘liftMoment’
In a stmt of a 'do' block:
bBufferMap <- liftMoment
((buffer eValidated eClear) :: Moment (Behavior BufferMap))
Let's take a look at MonadMoment
from Reactive.Banana.Combinators
class Monad m => MonadMoment m where
An instance of the MonadMoment class denotes a computation that happens at one particular moment in time.
Unlike the Moment monad, it need not be pure anymore.
Methods
liftMoment :: Moment a -> m a
Instances
MonadMoment MomentIO
MonadMoment Moment
m
can be any Monad
, IO
is a Monad
. so liftMoment
should lift the Moment Behavior (BufferMap)
to IO Behavior (BufferMap)
, why doesn't it. What's wrong with my reasoning?
Source of answer came from this previous answer.
Testing in reactive-banana
interpretFramwork
needs a new signature.
interpretFrameWorks'' :: (Event a -> MomentIO (Behavior b)) -> [a] -> IO (b,[[b]])
interpretFrameWorks'' f xs = do
output <- newIORef []
init <- newIORef undefined
(addHandler, runHandlers) <- newAddHandler
network <- compile $ do
e <- fromAddHandler addHandler
f' <- f e
o <- changes $ f'
i <- valueB $ f'
liftIO $ writeIORef init i
reactimate' $ (fmap . fmap) (\b -> modifyIORef output (++[b])) o
actuate network
bs <- forM xs $ \x -> do
runHandlers x
bs <- readIORef output
writeIORef output []
return bs
i <- readIORef init
return (i, bs)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With