essence-of-live-coding-0.2.4: test/Cell/Util.hs

{-# LANGUAGE Arrows #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Cell.Util where

-- base
import qualified Control.Category as C
import Data.Functor.Identity
import Data.Maybe
import Control.Monad

-- transformers
import Control.Monad.Trans.Reader

-- test-framework
import Test.Framework

-- test-framework-quickcheck2
import Test.Framework.Providers.QuickCheck2

-- QuickCheck
import Test.QuickCheck hiding (output)

-- essence-of-live-coding
import LiveCoding

import Util

test = testGroup "Utility unit tests"
--   [ testProperty "Buffer works as expected" CellSimulation
--       { cell = buffer
--       , input = []
--     --   , input =
--     --       [ []
--     --       , [Pop]
--     --       , [Push (23 :: Int)]
--     --       , []
--     --       , [Pop, Pop]
--     --       , [Push 42, Pop]
--     --       , [Push 1, Push 2]
--     --       , []
--     --       , []
--     --       , [Pop, Push 3]
--     --       , []
--     --       , [Pop]
--     --       , [Pop]
--     --       , []
--     --       ]
--       , output = []
--     --   , output =
--     --       [ Nothing
--     --       , Nothing
--     --       , Just 23
--     --       , Just 23
--     --       , Nothing
--     --       , Nothing
--     --       , Just 1
--     --       , Just 1
--     --       , Just 1
--     --       , Just 2
--     --       , Just 2
--     --       , Just 3
--     --       , Nothing
--     --       , Nothing
--     --       ]
--       }
  [ testProperty "buffered works as expected" CellSimulation
    { cell = buffered C.id
    , input =
        [ Just (23 :: Int)
        ]
    , output =
        [ Nothing
        ]
    }
  , testProperty "buffered can be used in an asynchronous setting" $ do
      jointInputs <- arbitrary -- Simulates when input arrives and when inner cell is activated
      -- Make sure cell is ticked at the last time, and no new input arrives
      let innerCell = proc (aMaybe :: Maybe Int) -> do
            isScheduled <- constM ask -< ()
            returnA -< guard isScheduled >> aMaybe
          outerCell = buffered innerCell
          (outputs, _) = runIdentity $ steps (runReaderC' outerCell) jointInputs
          labelString = unwords [show jointInputs, show outputs, show $ length jointInputs, show $ length outputs]
          inputs = snd $ unzip jointInputs
          bufferNotEmpty = isJust $ listToMaybe $ reverse outputs
      -- Make sure each message arrived exactly once, in order
      return
        $ counterexample labelString
        $ catMaybes inputs === catMaybes outputs
        .||. bufferNotEmpty
  ]