module Nes.APU.State.Filter.Thread (
    -- * Definition
    FilterThread (..),

    -- * Constructor
    newNoopFilterThread,
    newFilterThread,

    -- * Destructor
    killFilterThread,
) where

import Control.Concurrent
import Control.Monad
import Data.IORef
import Nes.APU.State.Filter.Chain
import Nes.APU.State.Filter.Class
import Nes.APU.State.Filter.Constants

data FilterThread = MkFT
    { FilterThread -> Sample -> IO ()
consumeSample :: Sample -> IO ()
    , FilterThread -> IO Sample
outputSample :: !(IO Sample)
    , FilterThread -> Maybe ThreadId
threadId :: {-# UNPACK #-} !(Maybe ThreadId)
    }

-- | A FilterThread that does nothing and always returns 0
newNoopFilterThread :: FilterThread
newNoopFilterThread :: FilterThread
newNoopFilterThread = (Sample -> IO ()) -> IO Sample -> Maybe ThreadId -> FilterThread
MkFT (IO () -> Sample -> IO ()
forall a b. a -> b -> a
const (IO () -> Sample -> IO ()) -> IO () -> Sample -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Sample -> IO Sample
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Sample
0) Maybe ThreadId
forall a. Maybe a
Nothing

-- | A FilterThread that spawns a process to run the filter chain in the backgroun
newFilterThread :: IO FilterThread
newFilterThread :: IO FilterThread
newFilterThread = do
    IORef FilterChain
filtersRef <- FilterChain -> IO (IORef FilterChain)
forall a. a -> IO (IORef a)
newIORef (FilterChain -> IO (IORef FilterChain))
-> IO FilterChain -> IO (IORef FilterChain)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sample -> IO FilterChain
newFilterChain Sample
defaultOutputRate
    IORef (Maybe Sample)
inputVar <- Maybe Sample -> IO (IORef (Maybe Sample))
forall a. a -> IO (IORef a)
newIORef Maybe Sample
forall a. Maybe a
Nothing
    IORef Bool
getInputVar <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
    MVar Sample
postOutputVar <- IO (MVar Sample)
forall a. IO (MVar a)
newEmptyMVar
    Maybe ThreadId
threadId <- ThreadId -> Maybe ThreadId
forall a. a -> Maybe a
Just (ThreadId -> Maybe ThreadId) -> IO ThreadId -> IO (Maybe ThreadId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO () -> IO ThreadId
forkIO (IORef FilterChain
-> IORef (Maybe Sample) -> IORef Bool -> MVar Sample -> IO ()
thread IORef FilterChain
filtersRef IORef (Maybe Sample)
inputVar IORef Bool
getInputVar MVar Sample
postOutputVar)
    let consumeSample :: Sample -> IO ()
consumeSample = IORef (Maybe Sample) -> Maybe Sample -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Sample)
inputVar (Maybe Sample -> IO ())
-> (Sample -> Maybe Sample) -> Sample -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sample -> Maybe Sample
forall a. a -> Maybe a
Just
        outputSample :: IO Sample
outputSample = IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
getInputVar Bool
True IO () -> IO Sample -> IO Sample
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVar Sample -> IO Sample
forall a. MVar a -> IO a
takeMVar MVar Sample
postOutputVar
    FilterThread -> IO FilterThread
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilterThread -> IO FilterThread)
-> FilterThread -> IO FilterThread
forall a b. (a -> b) -> a -> b
$ MkFT{Maybe ThreadId
IO Sample
Sample -> IO ()
consumeSample :: Sample -> IO ()
outputSample :: IO Sample
threadId :: Maybe ThreadId
threadId :: Maybe ThreadId
consumeSample :: Sample -> IO ()
outputSample :: IO Sample
..}

thread :: IORef FilterChain -> IORef (Maybe Sample) -> IORef Bool -> MVar Sample -> IO ()
thread :: IORef FilterChain
-> IORef (Maybe Sample) -> IORef Bool -> MVar Sample -> IO ()
thread IORef FilterChain
filterRef IORef (Maybe Sample)
inV IORef Bool
getV MVar Sample
postV = do
    Maybe Sample
msample <- IORef (Maybe Sample) -> IO (Maybe Sample)
forall a. IORef a -> IO a
readIORef IORef (Maybe Sample)
inV
    case Maybe Sample
msample of
        Maybe Sample
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just Sample
sample -> IORef FilterChain -> IO FilterChain
forall a. IORef a -> IO a
readIORef IORef FilterChain
filterRef IO FilterChain -> (FilterChain -> IO FilterChain) -> IO FilterChain
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Sample -> FilterChain -> IO FilterChain
forall (m :: * -> *) a. Filter m a => Sample -> a -> m a
consume Sample
sample IO FilterChain -> (FilterChain -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef FilterChain -> FilterChain -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef FilterChain
filterRef

    Bool
needOutput <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
getV
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needOutput (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Sample
filterOutput <- FilterChain -> IO Sample
forall (m :: * -> *) a. Filter m a => a -> m Sample
output (FilterChain -> IO Sample) -> IO FilterChain -> IO Sample
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef FilterChain -> IO FilterChain
forall a. IORef a -> IO a
readIORef IORef FilterChain
filterRef
        Bool
postIsFull <- MVar Sample -> Sample -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar MVar Sample
postV Sample
filterOutput
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
postIsFull (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- NOTE Shouldn't happen
    IORef FilterChain
-> IORef (Maybe Sample) -> IORef Bool -> MVar Sample -> IO ()
thread IORef FilterChain
filterRef IORef (Maybe Sample)
inV IORef Bool
getV MVar Sample
postV

killFilterThread :: FilterThread -> IO ()
killFilterThread :: FilterThread -> IO ()
killFilterThread FilterThread
ft = IO () -> (ThreadId -> IO ()) -> Maybe ThreadId -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ThreadId -> IO ()
killThread (Maybe ThreadId -> IO ()) -> Maybe ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ FilterThread -> Maybe ThreadId
threadId FilterThread
ft