module Midi.StubMidi (initialize, interface) where
import qualified Control.Concurrent.STM as STM
import qualified Data.Time as Time
import qualified Midi.Interface as Interface
import qualified Perform.RealTime as RealTime
initialize :: Interface.Initialize a
initialize :: forall a. Initialize a
initialize String
_app_name WantMessage
_want_message Either Error (RawInterface WriteMessage) -> IO a
app = Either Error (RawInterface WriteMessage) -> IO a
app forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IO (RawInterface a)
interface
interface :: IO (Interface.RawInterface a)
interface :: forall a. IO (RawInterface a)
interface = do
TChan ReadMessage
chan <- forall a. IO (TChan a)
STM.newTChanIO
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Interface.Interface
{ name :: String
Interface.name = String
"Stub"
, read_channel :: TChan ReadMessage
Interface.read_channel = TChan ReadMessage
chan
, read_devices :: IO [(ReadDevice, [ReadDevice])]
Interface.read_devices = forall (m :: * -> *) a. Monad m => a -> m a
return []
, write_devices :: IO [(WriteDevice, [WriteDevice])]
Interface.write_devices = forall (m :: * -> *) a. Monad m => a -> m a
return []
, connect_read_device :: ReadDevice -> IO Bool
Interface.connect_read_device = forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
, disconnect_read_device :: ReadDevice -> IO Bool
Interface.disconnect_read_device = forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
, connect_write_device :: WriteDevice -> IO Bool
Interface.connect_write_device = forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
, write_message :: a -> IO (Maybe Error)
Interface.write_message = forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
, abort :: IO ()
Interface.abort = forall (m :: * -> *) a. Monad m => a -> m a
return ()
, now :: IO RealTime
Interface.now = do
UTCTime
t <- IO UTCTime
Time.getCurrentTime
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Double -> RealTime
RealTime.seconds (forall a b. (Real a, Fractional b) => a -> b
realToFrac (UTCTime -> DiffTime
Time.utctDayTime UTCTime
t))
}