module Graphics.GPipe.Context.GLFW.RPC where

-- stdlib
import Data.Sequence (Seq, (|>), empty)
import Control.Concurrent (ThreadId, myThreadId)
import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)
import Control.Concurrent.STM (STM, atomically)
import Control.Concurrent.STM.TQueue
    ( TQueue, newTQueue, writeTQueue, tryReadTQueue, peekTQueue
    )
-- local
--import qualified Graphics.GPipe.Context.GLFW.Calls as Call

data Handle = Handle ThreadId (TQueue RPC)
    deriving
    ( Eq
    )

-- TODO: change RPC to a chan of `IO ()` and collapse `runActions`
data RPC
    = Execute (IO ())
    | Noop

-- | Create an RPC handle bound to the current thread. Actions sent from the
-- bound thread will just be run w/o doing an RPC.
newBound :: IO Handle
newBound = do
    tid <- myThreadId
    comm <- atomically $ newTQueue
    return $ Handle tid comm

-- XXX: consider pushing thread-check to all callsites of sendEffect, fetchResult
-- TODO: dry-up thread id check
sendEffect :: Handle -> IO () -> IO ()
sendEffect (Handle boundTid comm) action = do
    tid <- myThreadId
    if boundTid == tid
        then action
        else atomically $ writeTQueue comm (Execute action)

fetchResult :: Handle -> IO a -> IO a
fetchResult (Handle boundTid comm) action = do
    tid <- myThreadId
    if boundTid == tid
        then action
        else do
            reply <- newEmptyMVar
            -- XXX: Make sure the value put in the MVar is evaluated first
            atomically$ writeTQueue comm (Execute $ action >>= putMVar reply)
            takeMVar reply

drainComm :: TQueue a -> STM (Seq a)
drainComm queue = go empty
    where
        go rpcs = do
            result <- tryReadTQueue queue
            case result of
                Just rpc -> go $ rpcs |> rpc
                Nothing -> return rpcs

runActions :: Foldable t => t RPC -> IO ()
runActions actions = mapM_ go actions
    where
        go Noop = print "noop"
        go (Execute action) = action

awaitActions :: Handle -> IO RPC
awaitActions (Handle _ comm) = atomically . peekTQueue $ comm

processActions :: Handle -> IO ()
processActions (Handle _ comm) = (atomically . drainComm $ comm) >>= runActions