{-# LANGUAGE FlexibleInstances #-}

module Nes.APU.Monad (
    APU (..),
    runAPU,
    modifyDMCAndInterrupt,
) where

import Control.Monad.IO.Class
import Nes.APU.State
import Nes.APU.State.DMC
import Nes.Internal.MonadState
import Nes.Interrupt

newtype APU r a = MkAPU
    { forall r a.
APU r a
-> APUState
-> InterruptStatus
-> (APUState -> InterruptStatus -> a -> IO r)
-> IO r
unAPU :: APUState -> InterruptStatus -> (APUState -> InterruptStatus -> a -> IO r) -> IO r
    }
    deriving ((forall a b. (a -> b) -> APU r a -> APU r b)
-> (forall a b. a -> APU r b -> APU r a) -> Functor (APU r)
forall a b. a -> APU r b -> APU r a
forall a b. (a -> b) -> APU r a -> APU r b
forall r a b. a -> APU r b -> APU r a
forall r a b. (a -> b) -> APU r a -> APU r b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall r a b. (a -> b) -> APU r a -> APU r b
fmap :: forall a b. (a -> b) -> APU r a -> APU r b
$c<$ :: forall r a b. a -> APU r b -> APU r a
<$ :: forall a b. a -> APU r b -> APU r a
Functor)

instance Applicative (APU r) where
    {-# INLINE pure #-}
    pure :: forall a. a -> APU r a
pure a
a = (APUState
 -> InterruptStatus
 -> (APUState -> InterruptStatus -> a -> IO r)
 -> IO r)
-> APU r a
forall r a.
(APUState
 -> InterruptStatus
 -> (APUState -> InterruptStatus -> a -> IO r)
 -> IO r)
-> APU r a
MkAPU ((APUState
  -> InterruptStatus
  -> (APUState -> InterruptStatus -> a -> IO r)
  -> IO r)
 -> APU r a)
-> (APUState
    -> InterruptStatus
    -> (APUState -> InterruptStatus -> a -> IO r)
    -> IO r)
-> APU r a
forall a b. (a -> b) -> a -> b
$ \(!APUState
st) (!InterruptStatus
interr) APUState -> InterruptStatus -> a -> IO r
cont -> APUState -> InterruptStatus -> a -> IO r
cont APUState
st InterruptStatus
interr a
a

    {-# INLINE liftA2 #-}
    liftA2 :: forall a b c. (a -> b -> c) -> APU r a -> APU r b -> APU r c
liftA2 a -> b -> c
f (MkAPU APUState
-> InterruptStatus
-> (APUState -> InterruptStatus -> a -> IO r)
-> IO r
a) (MkAPU APUState
-> InterruptStatus
-> (APUState -> InterruptStatus -> b -> IO r)
-> IO r
b) = (APUState
 -> InterruptStatus
 -> (APUState -> InterruptStatus -> c -> IO r)
 -> IO r)
-> APU r c
forall r a.
(APUState
 -> InterruptStatus
 -> (APUState -> InterruptStatus -> a -> IO r)
 -> IO r)
-> APU r a
MkAPU ((APUState
  -> InterruptStatus
  -> (APUState -> InterruptStatus -> c -> IO r)
  -> IO r)
 -> APU r c)
-> (APUState
    -> InterruptStatus
    -> (APUState -> InterruptStatus -> c -> IO r)
    -> IO r)
-> APU r c
forall a b. (a -> b) -> a -> b
$ \(!APUState
st) (!InterruptStatus
interr) APUState -> InterruptStatus -> c -> IO r
cont ->
        APUState
-> InterruptStatus
-> (APUState -> InterruptStatus -> a -> IO r)
-> IO r
a APUState
st InterruptStatus
interr ((APUState -> InterruptStatus -> a -> IO r) -> IO r)
-> (APUState -> InterruptStatus -> a -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \(!APUState
st') (!InterruptStatus
interr') !a
a' -> APUState
-> InterruptStatus
-> (APUState -> InterruptStatus -> b -> IO r)
-> IO r
b APUState
st' InterruptStatus
interr' ((APUState -> InterruptStatus -> b -> IO r) -> IO r)
-> (APUState -> InterruptStatus -> b -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \(!APUState
st'') (!InterruptStatus
interr'') !b
b' -> APUState -> InterruptStatus -> c -> IO r
cont APUState
st'' InterruptStatus
interr'' (a -> b -> c
f a
a' b
b')

instance Monad (APU r) where
    {-# INLINE (>>=) #-}
    (MkAPU APUState
-> InterruptStatus
-> (APUState -> InterruptStatus -> a -> IO r)
-> IO r
a) >>= :: forall a b. APU r a -> (a -> APU r b) -> APU r b
>>= a -> APU r b
next = (APUState
 -> InterruptStatus
 -> (APUState -> InterruptStatus -> b -> IO r)
 -> IO r)
-> APU r b
forall r a.
(APUState
 -> InterruptStatus
 -> (APUState -> InterruptStatus -> a -> IO r)
 -> IO r)
-> APU r a
MkAPU ((APUState
  -> InterruptStatus
  -> (APUState -> InterruptStatus -> b -> IO r)
  -> IO r)
 -> APU r b)
-> (APUState
    -> InterruptStatus
    -> (APUState -> InterruptStatus -> b -> IO r)
    -> IO r)
-> APU r b
forall a b. (a -> b) -> a -> b
$ \APUState
st InterruptStatus
interr APUState -> InterruptStatus -> b -> IO r
cont ->
        APUState
-> InterruptStatus
-> (APUState -> InterruptStatus -> a -> IO r)
-> IO r
a APUState
st InterruptStatus
interr ((APUState -> InterruptStatus -> a -> IO r) -> IO r)
-> (APUState -> InterruptStatus -> a -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \(!APUState
st') (!InterruptStatus
interr') (!a
a') -> APU r b
-> APUState
-> InterruptStatus
-> (APUState -> InterruptStatus -> b -> IO r)
-> IO r
forall r a.
APU r a
-> APUState
-> InterruptStatus
-> (APUState -> InterruptStatus -> a -> IO r)
-> IO r
unAPU (a -> APU r b
next a
a') APUState
st' InterruptStatus
interr' APUState -> InterruptStatus -> b -> IO r
cont

instance MonadIO (APU r) where
    {-# INLINE liftIO #-}
    liftIO :: forall a. IO a -> APU r a
liftIO IO a
io = (APUState
 -> InterruptStatus
 -> (APUState -> InterruptStatus -> a -> IO r)
 -> IO r)
-> APU r a
forall r a.
(APUState
 -> InterruptStatus
 -> (APUState -> InterruptStatus -> a -> IO r)
 -> IO r)
-> APU r a
MkAPU ((APUState
  -> InterruptStatus
  -> (APUState -> InterruptStatus -> a -> IO r)
  -> IO r)
 -> APU r a)
-> (APUState
    -> InterruptStatus
    -> (APUState -> InterruptStatus -> a -> IO r)
    -> IO r)
-> APU r a
forall a b. (a -> b) -> a -> b
$ \APUState
st InterruptStatus
interr APUState -> InterruptStatus -> a -> IO r
cont -> IO a
io IO a -> (a -> IO r) -> IO r
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= APUState -> InterruptStatus -> a -> IO r
cont APUState
st InterruptStatus
interr

instance MonadFail (APU r) where
    {-# INLINE fail #-}
    fail :: forall a. String -> APU r a
fail = IO a -> APU r a
forall a. IO a -> APU r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> APU r a) -> (String -> IO a) -> String -> APU r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO a
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail

{-# INLINE runAPU #-}
runAPU :: APUState -> InterruptStatus -> APU (a, APUState, InterruptStatus) a -> IO (a, APUState, InterruptStatus)
runAPU :: forall a.
APUState
-> InterruptStatus
-> APU (a, APUState, InterruptStatus) a
-> IO (a, APUState, InterruptStatus)
runAPU !APUState
st !InterruptStatus
s APU (a, APUState, InterruptStatus) a
f = APU (a, APUState, InterruptStatus) a
-> APUState
-> InterruptStatus
-> (APUState
    -> InterruptStatus -> a -> IO (a, APUState, InterruptStatus))
-> IO (a, APUState, InterruptStatus)
forall r a.
APU r a
-> APUState
-> InterruptStatus
-> (APUState -> InterruptStatus -> a -> IO r)
-> IO r
unAPU APU (a, APUState, InterruptStatus) a
f APUState
st InterruptStatus
s ((APUState
  -> InterruptStatus -> a -> IO (a, APUState, InterruptStatus))
 -> IO (a, APUState, InterruptStatus))
-> (APUState
    -> InterruptStatus -> a -> IO (a, APUState, InterruptStatus))
-> IO (a, APUState, InterruptStatus)
forall a b. (a -> b) -> a -> b
$ \(!APUState
st') (!InterruptStatus
interr) a
a -> (a, APUState, InterruptStatus) -> IO (a, APUState, InterruptStatus)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, APUState
st', InterruptStatus
interr)

instance MonadState APUState (APU r) where
    {-# INLINE get #-}
    get :: APU r APUState
get = (APUState
 -> InterruptStatus
 -> (APUState -> InterruptStatus -> APUState -> IO r)
 -> IO r)
-> APU r APUState
forall r a.
(APUState
 -> InterruptStatus
 -> (APUState -> InterruptStatus -> a -> IO r)
 -> IO r)
-> APU r a
MkAPU ((APUState
  -> InterruptStatus
  -> (APUState -> InterruptStatus -> APUState -> IO r)
  -> IO r)
 -> APU r APUState)
-> (APUState
    -> InterruptStatus
    -> (APUState -> InterruptStatus -> APUState -> IO r)
    -> IO r)
-> APU r APUState
forall a b. (a -> b) -> a -> b
$ \APUState
st InterruptStatus
interr APUState -> InterruptStatus -> APUState -> IO r
cont -> APUState -> InterruptStatus -> APUState -> IO r
cont APUState
st InterruptStatus
interr APUState
st
    {-# INLINE set #-}
    set :: APUState -> APU r ()
set APUState
st' = (APUState
 -> InterruptStatus
 -> (APUState -> InterruptStatus -> () -> IO r)
 -> IO r)
-> APU r ()
forall r a.
(APUState
 -> InterruptStatus
 -> (APUState -> InterruptStatus -> a -> IO r)
 -> IO r)
-> APU r a
MkAPU ((APUState
  -> InterruptStatus
  -> (APUState -> InterruptStatus -> () -> IO r)
  -> IO r)
 -> APU r ())
-> (APUState
    -> InterruptStatus
    -> (APUState -> InterruptStatus -> () -> IO r)
    -> IO r)
-> APU r ()
forall a b. (a -> b) -> a -> b
$ \APUState
_ (!InterruptStatus
interr) APUState -> InterruptStatus -> () -> IO r
cont -> APUState -> InterruptStatus -> () -> IO r
cont APUState
st' InterruptStatus
interr ()

instance MonadState InterruptStatus (APU r) where
    {-# INLINE get #-}
    get :: APU r InterruptStatus
get = (APUState
 -> InterruptStatus
 -> (APUState -> InterruptStatus -> InterruptStatus -> IO r)
 -> IO r)
-> APU r InterruptStatus
forall r a.
(APUState
 -> InterruptStatus
 -> (APUState -> InterruptStatus -> a -> IO r)
 -> IO r)
-> APU r a
MkAPU ((APUState
  -> InterruptStatus
  -> (APUState -> InterruptStatus -> InterruptStatus -> IO r)
  -> IO r)
 -> APU r InterruptStatus)
-> (APUState
    -> InterruptStatus
    -> (APUState -> InterruptStatus -> InterruptStatus -> IO r)
    -> IO r)
-> APU r InterruptStatus
forall a b. (a -> b) -> a -> b
$ \APUState
st InterruptStatus
interr APUState -> InterruptStatus -> InterruptStatus -> IO r
cont -> APUState -> InterruptStatus -> InterruptStatus -> IO r
cont APUState
st InterruptStatus
interr InterruptStatus
interr
    {-# INLINE set #-}
    set :: InterruptStatus -> APU r ()
set InterruptStatus
interr' = (APUState
 -> InterruptStatus
 -> (APUState -> InterruptStatus -> () -> IO r)
 -> IO r)
-> APU r ()
forall r a.
(APUState
 -> InterruptStatus
 -> (APUState -> InterruptStatus -> a -> IO r)
 -> IO r)
-> APU r a
MkAPU ((APUState
  -> InterruptStatus
  -> (APUState -> InterruptStatus -> () -> IO r)
  -> IO r)
 -> APU r ())
-> (APUState
    -> InterruptStatus
    -> (APUState -> InterruptStatus -> () -> IO r)
    -> IO r)
-> APU r ()
forall a b. (a -> b) -> a -> b
$ \APUState
st InterruptStatus
_ APUState -> InterruptStatus -> () -> IO r
cont -> APUState -> InterruptStatus -> () -> IO r
cont APUState
st InterruptStatus
interr' ()

{-# INLINE modifyDMCAndInterrupt #-}
modifyDMCAndInterrupt :: (DMC -> InterruptStatus -> (DMC, InterruptStatus)) -> APU r ()
modifyDMCAndInterrupt :: forall r.
(DMC -> InterruptStatus -> (DMC, InterruptStatus)) -> APU r ()
modifyDMCAndInterrupt DMC -> InterruptStatus -> (DMC, InterruptStatus)
f = do
    DMC
dmc' <- Getting DMC APUState DMC -> APU r DMC
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting DMC APUState DMC
Lens' APUState DMC
dmc
    InterruptStatus
i <- APU r InterruptStatus
forall s (m :: * -> *). MonadState s m => m s
get
    let (DMC
dmc'', InterruptStatus
i') = DMC -> InterruptStatus -> (DMC, InterruptStatus)
f DMC
dmc' InterruptStatus
i
    (DMC -> Identity DMC) -> APUState -> Identity APUState
Lens' APUState DMC
dmc ((DMC -> Identity DMC) -> APUState -> Identity APUState)
-> DMC -> APU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= DMC
dmc''
    InterruptStatus -> APU r ()
forall s (m :: * -> *). MonadState s m => s -> m ()
set InterruptStatus
i'