{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE BlockArguments #-}

-- | MVar Transport Instance. New items overwrite the current queued item.
-- 
-- Useful in subscription-like contexts where you don't care about outdated values.
-- 
-- This is surprisingly useful since it doesn't block sources, but also doesn't accumulate items.
-- 
-- WARNING: Don't use if you want to ensure that all produced items are consumed!
-- 
module Control.Churro.Transport.MVar.Latest where
    
import Control.Churro.Types
import Control.Churro.Prelude

import Control.Concurrent
import Data.Void

data Latest a where

instance Transport Latest where
    data In  Latest a    = ChanIn  (MVar a)
    data Out Latest a    = ChanOut (MVar a)
    yank :: forall a. Out Latest a -> IO a
yank (ChanOut MVar a
c)   = forall a. MVar a -> IO a
takeMVar MVar a
c
    yeet :: forall a. In Latest a -> a -> IO ()
yeet (ChanIn  MVar a
c) a
v = forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar a
c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. MVar a -> a -> IO ()
putMVar  MVar a
c a
v
    flex :: forall a. IO (In Latest a, Out Latest a)
flex = do 
        MVar a
c <- forall a. IO (MVar a)
newEmptyMVar
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. MVar a -> In Latest a
ChanIn MVar a
c, forall a. MVar a -> Out Latest a
ChanOut MVar a
c)

type ChurroLatest a = Churro a Latest

-- | Convenience function for running a Churro with a MVar backed Latest Transport.
-- 
runWaitLatest :: ChurroLatest a Void Void -> IO a
runWaitLatest :: forall a. ChurroLatest a Void Void -> IO a
runWaitLatest = forall (t :: * -> *) a. Transport t => Churro a t Void Void -> IO a
runWait

-- | Convenience function for running a Churro into a List with a MVar backed Latest Transport.
-- 
runWaitListLatest :: ChurroLatest () Void o -> IO [o]
runWaitListLatest :: forall o. ChurroLatest () Void o -> IO [o]
runWaitListLatest = forall (t :: * -> *) a b.
(Transport t, Monoid a) =>
Churro a t Void b -> IO [b]
runWaitList