unit-testinghaskellreactive-banana

Reactive Banana 1.0.0 - Unit testing in the MomentIO() Monad


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?


Solution

  • 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)