tinytools-vty-0.1.0.0: test/PotatoSpec.hs

--TODO DELETE THIS

{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE RecordWildCards      #-}
{-# LANGUAGE UndecidableInstances #-}

module PotatoSpec
  ( spec
  )
where

import           Prelude

import           Test.Hspec
import           Test.Hspec.Contrib.HUnit   (fromHUnitTest)
import           Test.HUnit

import           Control.Monad.IO.Class     (liftIO)
import           Data.Kind
import qualified Data.List                  as L

import qualified Graphics.Vty               as V
import           Reflex
import           Reflex.Host.Class
import           Reflex.Vty
import           Reflex.Vty.Test.Monad.Host

data BasicPotatoTest1 t (m :: Type -> Type)

instance (MonadVtyApp t (TestGuestT t m), TestGuestConstraints t m) => ReflexVtyTestApp (BasicPotatoTest1 t m) t m where
  data VtyAppInputTriggerRefs (BasicPotatoTest1 t m) = BasicPotatoTest1_InputTriggerRefs
  data VtyAppInputEvents (BasicPotatoTest1 t m) = BasicPotatoTest1_InputEvents
  data VtyAppOutput (BasicPotatoTest1 t m) = BasicPotatoTest1_Output
  getApp _ = do
    return $ BasicPotatoTest1_Output
  makeInputs = do
    -- return dummy inputs since they are both empty
    return (BasicPotatoTest1_InputEvents, BasicPotatoTest1_InputTriggerRefs)

test_basic :: Test
test_basic = TestLabel "basic" $ TestCase $ runSpiderHost $
  runReflexVtyTestApp @(BasicPotatoTest1 (SpiderTimeline Global) (SpiderHost Global)) (500,500) $ do
    -- get our app's output events and subscribe to them
    BasicPotatoTest1_Output <- userOutputs
    vtyImages <- vtyOutputs
    --vtyH <- subscribeEvent _basicNetworkTest1_Output_vtyEv
    --dwH <- subscribeEvent $ updated _basicNetworkTest1_Output_displayWidth


    -- fire an empty event and ensure there is no output
    -- also check that an image was rendered
    a1 :: [((), [V.Image])] <- fireQueuedEventsAndRead $ do
      --a <- sequence =<< readEvent vtyH
      b <- sample vtyImages
      return ((),b)
    --liftIO $ (fst . L.last $ a1) @?= Nothing
    --liftIO $ (length . snd . L.last $ a1) @?= 1

    -- fire escape event and ensure we can
    --let someEvent = V.EvKey V.KEsc []
    --queueVtyEvent someEvent
    --a2 :: [Maybe VtyEvent] <- fireQueuedEventsAndRead $ sequence =<< readEvent vtyH
    --liftIO $ a2 @?= [Just someEvent]

    -- resize the screen and check that the changes are reflected
    --queueVtyEvent $ V.EvResize 10 10
    --a3  :: [Maybe Int] <- fireQueuedEventsAndRead $ sequence =<< readEvent dwH
    --liftIO $ a3 @?= [Just 10]

    return ()

spec :: Spec
spec = do
  fromHUnitTest test_basic