{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Terminal.Game.Layer.Object.Test where
import Terminal.Game.Layer.Object.Interface
import Terminal.Game.Layer.Object.Primitive
import qualified Control.Monad.Except as E
import qualified Control.Monad.RWS as S
import qualified Data.Bifunctor as B
data TestEvent = TCleanUpError
| TException ATGException
| TQuitGame
| TSetupDisplay
| TShutdownDisplay
| TStartGame
| TStartEvents
| TStopEvents
deriving (TestEvent -> TestEvent -> Bool
(TestEvent -> TestEvent -> Bool)
-> (TestEvent -> TestEvent -> Bool) -> Eq TestEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestEvent -> TestEvent -> Bool
== :: TestEvent -> TestEvent -> Bool
$c/= :: TestEvent -> TestEvent -> Bool
/= :: TestEvent -> TestEvent -> Bool
Eq, Int -> TestEvent -> ShowS
[TestEvent] -> ShowS
TestEvent -> String
(Int -> TestEvent -> ShowS)
-> (TestEvent -> String)
-> ([TestEvent] -> ShowS)
-> Show TestEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestEvent -> ShowS
showsPrec :: Int -> TestEvent -> ShowS
$cshow :: TestEvent -> String
show :: TestEvent -> String
$cshowList :: [TestEvent] -> ShowS
showList :: [TestEvent] -> ShowS
Show)
newtype Test a = Test (E.ExceptT () (S.RWS () [TestEvent] GRec) a)
deriving ((forall a b. (a -> b) -> Test a -> Test b)
-> (forall a b. a -> Test b -> Test a) -> Functor Test
forall a b. a -> Test b -> Test a
forall a b. (a -> b) -> Test a -> Test b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Test a -> Test b
fmap :: forall a b. (a -> b) -> Test a -> Test b
$c<$ :: forall a b. a -> Test b -> Test a
<$ :: forall a b. a -> Test b -> Test a
Functor, Functor Test
Functor Test =>
(forall a. a -> Test a)
-> (forall a b. Test (a -> b) -> Test a -> Test b)
-> (forall a b c. (a -> b -> c) -> Test a -> Test b -> Test c)
-> (forall a b. Test a -> Test b -> Test b)
-> (forall a b. Test a -> Test b -> Test a)
-> Applicative Test
forall a. a -> Test a
forall a b. Test a -> Test b -> Test a
forall a b. Test a -> Test b -> Test b
forall a b. Test (a -> b) -> Test a -> Test b
forall a b c. (a -> b -> c) -> Test a -> Test b -> Test c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Test a
pure :: forall a. a -> Test a
$c<*> :: forall a b. Test (a -> b) -> Test a -> Test b
<*> :: forall a b. Test (a -> b) -> Test a -> Test b
$cliftA2 :: forall a b c. (a -> b -> c) -> Test a -> Test b -> Test c
liftA2 :: forall a b c. (a -> b -> c) -> Test a -> Test b -> Test c
$c*> :: forall a b. Test a -> Test b -> Test b
*> :: forall a b. Test a -> Test b -> Test b
$c<* :: forall a b. Test a -> Test b -> Test a
<* :: forall a b. Test a -> Test b -> Test a
Applicative, Applicative Test
Applicative Test =>
(forall a b. Test a -> (a -> Test b) -> Test b)
-> (forall a b. Test a -> Test b -> Test b)
-> (forall a. a -> Test a)
-> Monad Test
forall a. a -> Test a
forall a b. Test a -> Test b -> Test b
forall a b. Test a -> (a -> Test b) -> Test b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Test a -> (a -> Test b) -> Test b
>>= :: forall a b. Test a -> (a -> Test b) -> Test b
$c>> :: forall a b. Test a -> Test b -> Test b
>> :: forall a b. Test a -> Test b -> Test b
$creturn :: forall a. a -> Test a
return :: forall a. a -> Test a
Monad,
E.MonadError (), S.MonadState GRec,
S.MonadWriter [TestEvent])
runTest :: Test a -> GRec -> (Maybe a, [TestEvent])
runTest :: forall a. Test a -> GRec -> (Maybe a, [TestEvent])
runTest (Test ExceptT () (RWS () [TestEvent] GRec) a
em) GRec
es = let m :: RWS () [TestEvent] GRec (Either () a)
m = ExceptT () (RWS () [TestEvent] GRec) a
-> RWS () [TestEvent] GRec (Either () a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
E.runExceptT ExceptT () (RWS () [TestEvent] GRec) a
em
t :: (Either () a, [TestEvent])
t = RWS () [TestEvent] GRec (Either () a)
-> () -> GRec -> (Either () a, [TestEvent])
forall r w s a. RWS r w s a -> r -> s -> (a, w)
S.evalRWS RWS () [TestEvent] GRec (Either () a)
m () GRec
es in
(Either () a -> Maybe a)
-> (Either () a, [TestEvent]) -> (Maybe a, [TestEvent])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
B.first ((() -> Maybe a) -> (a -> Maybe a) -> Either () a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> () -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just) (Either () a, [TestEvent])
t
mockHandle :: InputHandle
mockHandle :: InputHandle
mockHandle = MVar [Event] -> [ThreadId] -> InputHandle
InputHandle (String -> MVar [Event]
forall a. HasCallStack => String -> a
error String
"mock handle keyMvar")
(String -> [ThreadId]
forall a. HasCallStack => String -> a
error String
"mock handle threads")
instance MonadInput Test where
startEvents :: TPS -> Test InputHandle
startEvents TPS
_ = [TestEvent] -> Test ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
S.tell [TestEvent
TStartEvents] Test () -> Test InputHandle -> Test InputHandle
forall a b. Test a -> Test b -> Test b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
InputHandle -> Test InputHandle
forall a. a -> Test a
forall (m :: * -> *) a. Monad m => a -> m a
return InputHandle
mockHandle
pollEvents :: MVar [Event] -> Test [Event]
pollEvents MVar [Event]
_ = (GRec -> ([Event], GRec)) -> Test [Event]
forall a. (GRec -> (a, GRec)) -> Test a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
S.state GRec -> ([Event], GRec)
getPolled
stopEvents :: [ThreadId] -> Test ()
stopEvents [ThreadId]
_ = [TestEvent] -> Test ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
S.tell [TestEvent
TStopEvents]
areEventsOver :: Test Bool
areEventsOver = (GRec -> Bool) -> Test Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets GRec -> Bool
isOver
instance MonadTimer Test where
getTime :: Test TPS
getTime = TPS -> Test TPS
forall a. a -> Test a
forall (m :: * -> *) a. Monad m => a -> m a
return TPS
1
sleepABit :: TPS -> Test ()
sleepABit TPS
_ = () -> Test ()
forall a. a -> Test a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance MonadException Test where
cleanUpErr :: forall a b. Test a -> Test b -> Test a
cleanUpErr Test a
a Test b
_ = [TestEvent] -> Test ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
S.tell [TestEvent
TCleanUpError] Test () -> Test a -> Test a
forall a b. Test a -> Test b -> Test b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Test a
a
throwExc :: forall a. ATGException -> Test a
throwExc ATGException
e = [TestEvent] -> Test ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
S.tell [ATGException -> TestEvent
TException ATGException
e] Test () -> Test a -> Test a
forall a b. Test a -> Test b -> Test b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
() -> Test a
forall a. () -> Test a
forall e (m :: * -> *) a. MonadError e m => e -> m a
E.throwError ()
instance MonadDisplay Test where
setupDisplay :: Test ()
setupDisplay = () () -> Test () -> Test ()
forall a b. a -> Test b -> Test a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [TestEvent] -> Test ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
S.tell [TestEvent
TSetupDisplay]
clearDisplay :: Test ()
clearDisplay = () -> Test ()
forall a. a -> Test a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
displaySize :: Test (Maybe Dimensions)
displaySize = ExceptT () (RWS () [TestEvent] GRec) (Maybe Dimensions)
-> Test (Maybe Dimensions)
forall a. ExceptT () (RWS () [TestEvent] GRec) a -> Test a
Test (ExceptT () (RWS () [TestEvent] GRec) (Maybe Dimensions)
-> Test (Maybe Dimensions))
-> ExceptT () (RWS () [TestEvent] GRec) (Maybe Dimensions)
-> Test (Maybe Dimensions)
forall a b. (a -> b) -> a -> b
$ (GRec -> (Maybe Dimensions, GRec))
-> ExceptT () (RWS () [TestEvent] GRec) (Maybe Dimensions)
forall a.
(GRec -> (a, GRec)) -> ExceptT () (RWS () [TestEvent] GRec) a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
S.state GRec -> (Maybe Dimensions, GRec)
getDims
blitPlane :: Maybe Plane -> Plane -> Test ()
blitPlane Maybe Plane
_ Plane
_ = () -> Test ()
forall a. a -> Test a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
shutdownDisplay :: Test ()
shutdownDisplay = () () -> Test () -> Test ()
forall a b. a -> Test b -> Test a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [TestEvent] -> Test ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
S.tell [TestEvent
TShutdownDisplay]