{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Sound.ALSA.Sequencer.Event.RemoveMonad (
T,
run,
setInput, putInput, getInput,
setOutput, putOutput, getOutput,
setChannel, putChannel, getChannel,
setEventType, putEventType,
setTag, putTag, getTag,
setDest, putDest, getDest,
setTime, putTime, getTime,
setIgnoreOff, putIgnoreOff, getIgnoreOff,
) where
import qualified Sound.ALSA.Sequencer.Event.Remove as Remove
import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq
import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr
import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue
import qualified Sound.ALSA.Sequencer.Marshal.Event as Event
import qualified Sound.ALSA.Sequencer.Marshal.Time as Time
import qualified Control.Monad.Trans.Reader as MR
import qualified Control.Monad.Trans.State as MS
import qualified Control.Monad.Trans.Class as MT
import Control.Applicative (Applicative, )
import qualified Data.EnumBitSet as EnumSet
import Data.EnumBitSet ((.-.), (.|.), )
import Control.Monad (liftM2, )
import Data.Monoid (mempty, mappend, )
newtype T a = Cons (MR.ReaderT Remove.T (MS.StateT Remove.Condition IO) a)
deriving (forall a b. a -> T b -> T a
forall a b. (a -> b) -> T a -> T b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> T b -> T a
$c<$ :: forall a b. a -> T b -> T a
fmap :: forall a b. (a -> b) -> T a -> T b
$cfmap :: forall a b. (a -> b) -> T a -> T b
Functor, Functor T
forall a. a -> T a
forall a b. T a -> T b -> T a
forall a b. T a -> T b -> T b
forall a b. T (a -> b) -> T a -> T b
forall a b c. (a -> b -> c) -> T a -> T b -> T c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. T a -> T b -> T a
$c<* :: forall a b. T a -> T b -> T a
*> :: forall a b. T a -> T b -> T b
$c*> :: forall a b. T a -> T b -> T b
liftA2 :: forall a b c. (a -> b -> c) -> T a -> T b -> T c
$cliftA2 :: forall a b c. (a -> b -> c) -> T a -> T b -> T c
<*> :: forall a b. T (a -> b) -> T a -> T b
$c<*> :: forall a b. T (a -> b) -> T a -> T b
pure :: forall a. a -> T a
$cpure :: forall a. a -> T a
Applicative, Applicative T
forall a. a -> T a
forall a b. T a -> T b -> T b
forall a b. T a -> (a -> T b) -> T b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> T a
$creturn :: forall a. a -> T a
>> :: forall a b. T a -> T b -> T b
$c>> :: forall a b. T a -> T b -> T b
>>= :: forall a b. T a -> (a -> T b) -> T b
$c>>= :: forall a b. T a -> (a -> T b) -> T b
Monad)
unpack :: T a -> Remove.T -> Remove.Condition -> IO (a, Remove.Condition)
unpack :: forall a. T a -> T -> Condition -> IO (a, Condition)
unpack (Cons ReaderT T (StateT Condition IO) a
m) T
r = forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
MS.runStateT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
MR.runReaderT ReaderT T (StateT Condition IO) a
m T
r)
_apply :: T a -> Remove.T -> IO a
_apply :: forall a. T a -> T -> IO a
_apply T a
m T
r = do
Condition
c0 <- T -> IO Condition
Remove.getCondition T
r
(a
a,Condition
c1) <- forall a. T a -> T -> Condition -> IO (a, Condition)
unpack T a
m T
r Condition
c0
T -> Condition -> IO ()
Remove.setCondition T
r Condition
c1
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
run :: Seq.T mode -> T a -> IO a
run :: forall mode a. T mode -> T a -> IO a
run T mode
h T a
m = do
T
r <- IO T
Remove.malloc
(a
a,Condition
c) <- forall a. T a -> T -> Condition -> IO (a, Condition)
unpack T a
m T
r forall a w. (Enum a, Bits w) => T w a
EnumSet.empty
T -> Condition -> IO ()
Remove.setCondition T
r Condition
c
forall mode. T mode -> T -> IO ()
Remove.run T mode
h T
r
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
liftGet :: (Remove.T -> IO a) -> T a
liftGet :: forall a. (T -> IO a) -> T a
liftGet T -> IO a
f = forall a. ReaderT T (StateT Condition IO) a -> T a
Cons forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
MR.ReaderT forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> IO a
f
liftGetCond :: (Remove.T -> IO a) -> Remove.Condition -> T (Maybe a)
liftGetCond :: forall a. (T -> IO a) -> Condition -> T (Maybe a)
liftGetCond T -> IO a
f Condition
cond = do
Bool
b <- Condition -> T Bool
getCond Condition
cond
if Bool
b
then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. (T -> IO a) -> T a
liftGet T -> IO a
f
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
liftSet :: (Remove.T -> b -> IO a) -> b -> T a
liftSet :: forall b a. (T -> b -> IO a) -> b -> T a
liftSet T -> b -> IO a
f b
x = forall a. ReaderT T (StateT Condition IO) a -> T a
Cons forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
MR.ReaderT forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip T -> b -> IO a
f b
x
liftSetCond :: (Remove.T -> a -> IO b) -> Remove.Condition -> a -> T b
liftSetCond :: forall a b. (T -> a -> IO b) -> Condition -> a -> T b
liftSetCond T -> a -> IO b
f Condition
cond a
x = do
(Condition -> Condition) -> T ()
modifyCond forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a -> a -> a
mappend Condition
cond
forall b a. (T -> b -> IO a) -> b -> T a
liftSet T -> a -> IO b
f a
x
liftPutCond :: (Remove.T -> a -> IO ()) -> Remove.Condition -> Maybe a -> T ()
liftPutCond :: forall a. (T -> a -> IO ()) -> Condition -> Maybe a -> T ()
liftPutCond T -> a -> IO ()
f Condition
cond Maybe a
mx =
case Maybe a
mx of
Maybe a
Nothing -> (Condition -> Condition) -> T ()
modifyCond forall a b. (a -> b) -> a -> b
$ (forall a w. (Enum a, Bits w) => T w a -> T w a -> T w a
.-. Condition
cond)
Just a
x -> forall a b. (T -> a -> IO b) -> Condition -> a -> T b
liftSetCond T -> a -> IO ()
f Condition
cond a
x
getCond :: Remove.Condition -> T Bool
getCond :: Condition -> T Bool
getCond Condition
cond =
forall a. ReaderT T (StateT Condition IO) a -> T a
Cons forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
MS.gets forall a b. (a -> b) -> a -> b
$ forall a w. (Enum a, Bits w) => T w a -> T w a -> Bool
EnumSet.subset Condition
cond
setCond :: Remove.Condition -> T ()
setCond :: Condition -> T ()
setCond Condition
cond =
(Condition -> Condition) -> T ()
modifyCond forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a -> a -> a
mappend Condition
cond
putCond :: Remove.Condition -> Bool -> T ()
putCond :: Condition -> Bool -> T ()
putCond Condition
cond Bool
b =
(Condition -> Condition) -> T ()
modifyCond forall a b. (a -> b) -> a -> b
$ (if Bool
b then forall a w. (Enum a, Bits w) => T w a -> T w a -> T w a
(.|.) else forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a w. (Enum a, Bits w) => T w a -> T w a -> T w a
(.-.)) Condition
cond
modifyCond :: (Remove.Condition -> Remove.Condition) -> T ()
modifyCond :: (Condition -> Condition) -> T ()
modifyCond Condition -> Condition
f =
forall a. ReaderT T (StateT Condition IO) a -> T a
Cons forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
MS.modify Condition -> Condition
f
setInput :: T ()
putInput :: Bool -> T ()
getInput :: T Bool
setOutput :: T ()
putOutput :: Bool -> T ()
getOutput :: T Bool
setChannel :: Event.Channel -> T ()
putChannel :: Maybe Event.Channel -> T ()
getChannel :: T (Maybe Event.Channel)
_setEventType :: Event.EType -> T ()
_getEventType :: T Event.EType
setEventType :: Event.Type e => e -> T ()
putEventType :: Event.Type e => Maybe e -> T ()
setTag :: Event.Tag -> T ()
putTag :: Maybe Event.Tag -> T ()
getTag :: T (Maybe Event.Tag)
setDest :: (Addr.T, Queue.T) -> T ()
putDest :: Maybe (Addr.T, Queue.T) -> T ()
getDest :: T (Maybe (Addr.T, Queue.T))
setIgnoreOff :: T ()
putIgnoreOff :: Bool -> T ()
getIgnoreOff :: T Bool
getInput :: T Bool
getInput = Condition -> T Bool
getCond Condition
Remove.condInput
setInput :: T ()
setInput = Condition -> T ()
setCond Condition
Remove.condInput
putInput :: Bool -> T ()
putInput = Condition -> Bool -> T ()
putCond Condition
Remove.condInput
getOutput :: T Bool
getOutput = Condition -> T Bool
getCond Condition
Remove.condOutput
setOutput :: T ()
setOutput = Condition -> T ()
setCond Condition
Remove.condOutput
putOutput :: Bool -> T ()
putOutput = Condition -> Bool -> T ()
putCond Condition
Remove.condOutput
getChannel :: T (Maybe Channel)
getChannel = forall a. (T -> IO a) -> Condition -> T (Maybe a)
liftGetCond T -> IO Channel
Remove.getChannel Condition
Remove.condDestChannel
setChannel :: Channel -> T ()
setChannel = forall a b. (T -> a -> IO b) -> Condition -> a -> T b
liftSetCond T -> Channel -> IO ()
Remove.setChannel Condition
Remove.condDestChannel
putChannel :: Maybe Channel -> T ()
putChannel = forall a. (T -> a -> IO ()) -> Condition -> Maybe a -> T ()
liftPutCond T -> Channel -> IO ()
Remove.setChannel Condition
Remove.condDestChannel
_getEventType :: T EType
_getEventType = forall a. (T -> IO a) -> T a
liftGet T -> IO EType
Remove.getEventType
_setEventType :: EType -> T ()
_setEventType = forall a b. (T -> a -> IO b) -> Condition -> a -> T b
liftSetCond T -> EType -> IO ()
Remove.setEventType Condition
Remove.condEventType
setEventType :: forall e. Type e => e -> T ()
setEventType =
forall a b. (T -> a -> IO b) -> Condition -> a -> T b
liftSetCond T -> EType -> IO ()
Remove.setEventType Condition
Remove.condEventType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Type e => e -> EType
Event.expEv
putEventType :: forall e. Type e => Maybe e -> T ()
putEventType =
forall a. (T -> a -> IO ()) -> Condition -> Maybe a -> T ()
liftPutCond T -> EType -> IO ()
Remove.setEventType Condition
Remove.condEventType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e. Type e => e -> EType
Event.expEv
getTag :: T (Maybe Tag)
getTag = forall a. (T -> IO a) -> Condition -> T (Maybe a)
liftGetCond T -> IO Tag
Remove.getTag Condition
Remove.condTagMatch
setTag :: Tag -> T ()
setTag = forall a b. (T -> a -> IO b) -> Condition -> a -> T b
liftSetCond T -> Tag -> IO ()
Remove.setTag Condition
Remove.condTagMatch
putTag :: Maybe Tag -> T ()
putTag = forall a. (T -> a -> IO ()) -> Condition -> Maybe a -> T ()
liftPutCond T -> Tag -> IO ()
Remove.setTag Condition
Remove.condTagMatch
getDestQueue :: Remove.T -> IO (Addr.T, Queue.T)
getDestQueue :: T -> IO (T, T)
getDestQueue T
r = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (T -> IO T
Remove.getDest T
r) (T -> IO T
Remove.getQueue T
r)
setDestQueue :: Remove.T -> (Addr.T, Queue.T) -> IO ()
setDestQueue :: T -> (T, T) -> IO ()
setDestQueue T
r (T
a,T
q) = T -> T -> IO ()
Remove.setDest T
r T
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> T -> T -> IO ()
Remove.setQueue T
r T
q
getDest :: T (Maybe (T, T))
getDest = forall a. (T -> IO a) -> Condition -> T (Maybe a)
liftGetCond T -> IO (T, T)
getDestQueue Condition
Remove.condDest
setDest :: (T, T) -> T ()
setDest = forall a b. (T -> a -> IO b) -> Condition -> a -> T b
liftSetCond T -> (T, T) -> IO ()
setDestQueue Condition
Remove.condDest
putDest :: Maybe (T, T) -> T ()
putDest = forall a. (T -> a -> IO ()) -> Condition -> Maybe a -> T ()
liftPutCond T -> (T, T) -> IO ()
setDestQueue Condition
Remove.condDest
getIgnoreOff :: T Bool
getIgnoreOff = Condition -> T Bool
getCond Condition
Remove.condIgnoreOff
setIgnoreOff :: T ()
setIgnoreOff = Condition -> T ()
setCond Condition
Remove.condIgnoreOff
putIgnoreOff :: Bool -> T ()
putIgnoreOff = Condition -> Bool -> T ()
putCond Condition
Remove.condIgnoreOff
getTime :: T (Maybe Ordering, Time.Stamp)
getTime :: T (Maybe Ordering, Stamp)
getTime = do
Bool
ticks <- Condition -> T Bool
getCond Condition
Remove.condTimeTick
Stamp
stamp <-
if Bool
ticks
then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tick -> Stamp
Time.Tick forall a b. (a -> b) -> a -> b
$ forall a. (T -> IO a) -> T a
liftGet T -> IO Tick
Remove.getTickTime
else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T -> Stamp
Time.Real forall a b. (a -> b) -> a -> b
$ forall a. (T -> IO a) -> T a
liftGet T -> IO T
Remove.getRealTime
Bool
after <- Condition -> T Bool
getCond Condition
Remove.condTimeAfter
Bool
before <- Condition -> T Bool
getCond Condition
Remove.condTimeBefore
let mo :: Maybe Ordering
mo =
case (Bool
after, Bool
before) of
(Bool
False, Bool
False) -> forall a. Maybe a
Nothing
(Bool
True, Bool
False) -> forall a. a -> Maybe a
Just Ordering
GT
(Bool
False, Bool
True ) -> forall a. a -> Maybe a
Just Ordering
LT
(Bool
True, Bool
True ) -> forall a. a -> Maybe a
Just Ordering
EQ
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Ordering
mo, Stamp
stamp)
setTime :: Ordering -> Time.Stamp -> T ()
setTime :: Ordering -> Stamp -> T ()
setTime Ordering
o = Maybe Ordering -> Stamp -> T ()
putTime forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Ordering
o
putTime :: Maybe Ordering -> Time.Stamp -> T ()
putTime :: Maybe Ordering -> Stamp -> T ()
putTime Maybe Ordering
mo Stamp
t = do
(Condition -> Condition) -> T ()
modifyCond ( forall a w. (Enum a, Bits w) => T w a -> T w a -> T w a
.-. (Condition
Remove.condTimeAfter forall a w. (Enum a, Bits w) => T w a -> T w a -> T w a
.|. Condition
Remove.condTimeBefore))
(Condition -> Condition) -> T ()
modifyCond forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a -> a -> a
mappend forall a b. (a -> b) -> a -> b
$
case Maybe Ordering
mo of
Maybe Ordering
Nothing -> forall a. Monoid a => a
mempty
Just Ordering
LT -> Condition
Remove.condTimeBefore
Just Ordering
GT -> Condition
Remove.condTimeAfter
Just Ordering
EQ -> forall a. Monoid a => a -> a -> a
mappend Condition
Remove.condTimeBefore Condition
Remove.condTimeAfter
case Stamp
t of
Time.Tick Tick
x -> do
(Condition -> Condition) -> T ()
modifyCond forall a b. (a -> b) -> a -> b
$ (forall a w. (Enum a, Bits w) => T w a -> T w a -> T w a
.-. Condition
Remove.condTimeTick)
forall b a. (T -> b -> IO a) -> b -> T a
liftSet T -> Tick -> IO ()
Remove.setTickTime Tick
x
Time.Real T
x -> do
(Condition -> Condition) -> T ()
modifyCond forall a b. (a -> b) -> a -> b
$ (forall a w. (Enum a, Bits w) => T w a -> T w a -> T w a
.|. Condition
Remove.condTimeTick)
forall b a. (T -> b -> IO a) -> b -> T a
liftSet T -> T -> IO ()
Remove.setRealTime T
x