module Graphics.Vty.ReactiveBanana where

import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import Data.Maybe
import Graphics.Vty hiding (Event)
import Reactive.Banana
import Reactive.Banana.Frameworks
import qualified Graphics.Vty as V

type VEvent = V.Event

eventChan :: Vty -> IO (TChan VEvent)
eventChan v = do
    eventChan <- newTChanIO
    forkIO $ forever $ do
        e <- nextEvent v 
        atomically $ writeTChan eventChan e
    return eventChan

eventFromChan :: TChan a -> MomentIO (Event a)
eventFromChan chan = do
    (event, handle) <- newEvent
    liftIO $ forkIO $ forever $ do
        a <- atomically $ tryReadTChan chan
        case a of
            Just x -> handle x
            _ -> return ()
        threadDelay $ 10 ^ 5
    return event

tickEvent :: MomentIO (Event ())
tickEvent = do
    (event, handle) <- newEvent
    liftIO $ forkIO $ forever $ handle () >> threadDelay (3*10^4)
    return event

blocking :: TChan Bool -> IO ()
blocking bChan = do
    bool <- atomically $ tryReadTChan bChan
    case bool of
        Just True -> return ()
        _ -> threadDelay (10^4) >> blocking bChan

drawChan :: Vty -> TChan (Maybe Picture) -> IO ()
drawChan v dChan = void $ forkIO $ forever $ do
    pic <- atomically $ tryReadTChan dChan
    case pic of
        Just (Just x) -> update v x
        _ -> return ()
    threadDelay $ 10^5
        
makeVtyNetwork :: Vty -> (Event VEvent -> MomentIO (Behavior (Maybe Picture))) 
    -> IO ()
makeVtyNetwork v func = do
    stopChan <- newTChanIO
    updateChan <- newTChanIO
    network <- compile $ do
        events <- liftIO (eventChan v) >>= eventFromChan 
        outPic <- func events
        tickE <- tickEvent
        reactimate $ (atomically . writeTChan stopChan . isNothing) <$> (outPic <@ tickE)
        reactimate $ (updateMaybe v) <$> (outPic <@ tickE)
    actuate network
    drawChan v updateChan
    blocking stopChan
    shutdown v

isKey :: Key -> VEvent -> Bool
isKey b (EvKey a _) = a == b

updateMaybe v (Just x) = update v x
updateMaybe _ _ = return ()

