MixedTest.hs

{-# LANGUAGE DeriveDataTypeable, FlexibleInstances #-}

module Graphics.QML.Test.MixedTest where

import Graphics.QML.Objects
import Graphics.QML.Test.Framework
import Graphics.QML.Test.MayGen
import qualified Graphics.QML.Test.ScriptDSL as S

import Test.QuickCheck.Gen
import Control.Applicative
import Data.Typeable
import Data.Proxy

data ObjectA
    = OANewB Int
    | OACheckB Int
    deriving (Show, Typeable)

objectAType :: TestType
objectAType = TestType (Proxy :: Proxy ObjectA)

data ObjectB
    = OBNewA Int
    | OBCheckA Int
    deriving (Show, Typeable)

objectBType :: TestType
objectBType = TestType (Proxy :: Proxy ObjectB)

instance TestAction ObjectA where
    legalActionIn (OANewB n) env = testEnvIsaJ n objectBType env
    legalActionIn _ _ = True
    nextActionsFor env = mayOneof [
        OANewB <$> (fromGen $ choose (1, testEnvNextJ env)),
        OACheckB <$> mayElements (filter (/= 0) $ testEnvListJ objectBType env)]
    updateEnvRaw (OANewB n) = testEnvStep . testEnvSerial (\s ->
        testEnvSetJ n objectBType s)
    updateEnvRaw _ = testEnvStep
    actionRemote (OANewB v) n =
        S.saveVar v $ S.var n `S.dot` "newB" `S.call` []
    actionRemote (OACheckB v) n =
        S.eval $ S.var n `S.dot` "checkB" `S.call` [S.var v]
    mockObjDef = [
        defMethod "newB" $ \m -> expectAction m $ \a -> case a of
            OANewB _ -> do
                obj <- forkMockObj m
                return $ Right (obj :: ObjRef (MockObj ObjectB))
            _        -> return $ Left TBadActionCtor,
        defMethod "checkB" $ \m v -> expectAction m $ \a -> case a of
            OACheckB w -> checkMockObj m (v :: MockObj ObjectB) w
            _          -> return $ Left TBadActionCtor]

instance TestAction ObjectB where
    legalActionIn (OBNewA n) env = testEnvIsaJ n objectAType env
    legalActionIn _ _ = True
    nextActionsFor env = mayOneof [
        OBNewA <$> (fromGen $ choose (1, testEnvNextJ env)),
        OBCheckA <$> mayElements (filter (/= 0) $ testEnvListJ objectAType env)]
    updateEnvRaw (OBNewA n) = testEnvStep . testEnvSerial (\s ->
        testEnvSetJ n objectAType s)
    updateEnvRaw _ = testEnvStep
    actionRemote (OBNewA v) n =
        S.saveVar v $ S.var n `S.dot` "newA" `S.call` []
    actionRemote (OBCheckA v) n =
        S.eval $ S.var n `S.dot` "checkA" `S.call` [S.var v]
    mockObjDef = [
        defMethod "newA" $ \m -> expectAction m $ \a -> case a of
            OBNewA _ -> do
                obj <- forkMockObj m
                return $ Right (obj :: ObjRef (MockObj ObjectA))
            _        -> return $ Left TBadActionCtor,
        defMethod "checkA" $ \m v -> expectAction m $ \a -> case a of
            OBCheckA w -> checkMockObj m (v :: MockObj ObjectA) w
            _          -> return $ Left TBadActionCtor]