content: {-# LANGUAGE GADTs #-}
  {-# LANGUAGE LambdaCase #-}
  module Test.Run where
  
  import Control.Monad
  import Control.Monad.Ref
  import Data.Dependent.Sum
  import Data.Functor.Identity
  import Data.These
  
  import Reflex
  import Reflex.Host.Class
  
  data AppIn t b e = AppIn
    { _appIn_behavior :: Behavior t b
    , _appIn_event :: Event t e
    }
  
  data AppOut t b e = AppOut
    { _appOut_behavior :: Behavior t b
    , _appOut_event :: Event t e
    }
  
  runApp :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)
         => (AppIn t bIn eIn -> PerformEventT t m (AppOut t bOut eOut))
         -> bIn
         -> [Maybe (These bIn eIn)]
         -> IO [[(bOut, Maybe eOut)]]
  runApp app b0 input = runSpiderHost $ do
    (appInHoldE, pulseHoldTriggerRef) <- newEventWithTriggerRef
    (appInE, pulseEventTriggerRef) <- newEventWithTriggerRef
    appInB <- hold b0 appInHoldE
    (out, FireCommand fire) <- hostPerformEventT $ app $ AppIn
      { _appIn_event = appInE
      , _appIn_behavior = appInB
      }
    hnd <- subscribeEvent (_appOut_event out)
    mpulseB <- readRef pulseHoldTriggerRef
    mpulseE <- readRef pulseEventTriggerRef
    let readPhase = do
          b <- sample (_appOut_behavior out)
          frames <- sequence =<< readEvent hnd
          return (b, frames)
    forM input $ \case
      Nothing ->
        fire [] $ readPhase
      Just i -> case i of
        This b' -> case mpulseB of
          Nothing -> error "tried to fire in-behavior but ref was empty"
          Just pulseB -> fire [ pulseB :=> Identity b' ] $ readPhase
        That e' -> case mpulseE of
          Nothing -> error "tried to fire in-event but ref was empty"
          Just pulseE -> fire [ pulseE :=> Identity e' ] $ readPhase
        These b' e' -> case mpulseB of
          Nothing -> error "tried to fire in-behavior but ref was empty"
          Just pulseB -> case mpulseE of
            Nothing -> error "tried to fire in-event but ref was empty"
            Just pulseE -> fire [ pulseB :=> Identity b', pulseE :=> Identity e' ] $ readPhase
  
  runApp' :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)
          => (Event t eIn -> PerformEventT t m (Event t eOut))
          -> [Maybe eIn]
          -> IO [[Maybe eOut]]
  runApp' app input = do
    let app' = fmap (AppOut (pure ())) . app
    map (map snd) <$> runApp (app' . _appIn_event) () (map (fmap That) input)
  
  runAppB :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)
          => (Event t eIn -> PerformEventT t m (Behavior t bOut))
          -> [Maybe eIn]
          -> IO [[bOut]]
  runAppB app input = do
    let app' = fmap (flip AppOut never) . app
    map (map fst) <$> runApp (app' . _appIn_event) () (map (fmap That) input)
  