essence-of-live-coding-PortMidi-0.2.7: General purpose live coding framework - PortMidi backend
Safe HaskellSafe-Inferred
LanguageHaskell2010

LiveCoding.PortMidi

Description

With this module, you can add cells which receive and send MIDI events.

You don't need to initialise PortMidi, or open devices, this is all done by essence-of-live-coding using the LiveCoding.Handle mechanism.

Synopsis

The PortMidiT monad transformer

newtype PortMidiT m a Source #

Monad transformer adding PortMidi-related effects to your monad.

This transformer adds two kinds of effects to your stack:

Instances

Instances details
MonadTrans PortMidiT Source # 
Instance details

Defined in LiveCoding.PortMidi

Methods

lift :: Monad m => m a -> PortMidiT m a #

MonadIO m => MonadIO (PortMidiT m) Source # 
Instance details

Defined in LiveCoding.PortMidi

Methods

liftIO :: IO a -> PortMidiT m a #

Monad m => Applicative (PortMidiT m) Source # 
Instance details

Defined in LiveCoding.PortMidi

Methods

pure :: a -> PortMidiT m a #

(<*>) :: PortMidiT m (a -> b) -> PortMidiT m a -> PortMidiT m b #

liftA2 :: (a -> b -> c) -> PortMidiT m a -> PortMidiT m b -> PortMidiT m c #

(*>) :: PortMidiT m a -> PortMidiT m b -> PortMidiT m b #

(<*) :: PortMidiT m a -> PortMidiT m b -> PortMidiT m a #

Functor m => Functor (PortMidiT m) Source # 
Instance details

Defined in LiveCoding.PortMidi

Methods

fmap :: (a -> b) -> PortMidiT m a -> PortMidiT m b #

(<$) :: a -> PortMidiT m b -> PortMidiT m a #

Monad m => Monad (PortMidiT m) Source # 
Instance details

Defined in LiveCoding.PortMidi

Methods

(>>=) :: PortMidiT m a -> (a -> PortMidiT m b) -> PortMidiT m b #

(>>) :: PortMidiT m a -> PortMidiT m b -> PortMidiT m b #

return :: a -> PortMidiT m a #

data EOLCPortMidiError Source #

Exceptions that can occur while doing livecoding with PortMidi.

There are two kinds of exceptions:

  • Internal PortMidi exceptions (see EOLCPortMidiError)
  • When a device is not correctly specified by name and input/output configuration

Constructors

PMError PMError

An internal error occurred in the PortMidi library

NoSuchDevice

There is no device of that name

NotAnInputDevice

There is a device of that name, but it doesn't support input

NotAnOutputDevice

There is a device of that name, but it doesn't support output

MultipleDevices

There are multiple devices of the same name

Instances

Instances details
Data EOLCPortMidiError Source # 
Instance details

Defined in LiveCoding.PortMidi

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> EOLCPortMidiError -> c EOLCPortMidiError #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c EOLCPortMidiError #

toConstr :: EOLCPortMidiError -> Constr #

dataTypeOf :: EOLCPortMidiError -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c EOLCPortMidiError) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EOLCPortMidiError) #

gmapT :: (forall b. Data b => b -> b) -> EOLCPortMidiError -> EOLCPortMidiError #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> EOLCPortMidiError -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> EOLCPortMidiError -> r #

gmapQ :: (forall d. Data d => d -> u) -> EOLCPortMidiError -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> EOLCPortMidiError -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> EOLCPortMidiError -> m EOLCPortMidiError #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> EOLCPortMidiError -> m EOLCPortMidiError #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> EOLCPortMidiError -> m EOLCPortMidiError #

Generic EOLCPortMidiError Source # 
Instance details

Defined in LiveCoding.PortMidi

Associated Types

type Rep EOLCPortMidiError :: Type -> Type #

Show EOLCPortMidiError Source # 
Instance details

Defined in LiveCoding.PortMidi

Finite EOLCPortMidiError Source # 
Instance details

Defined in LiveCoding.PortMidi

Methods

commute :: forall (m :: Type -> Type) a b. Monad m => (EOLCPortMidiError -> Cell m a b) -> Cell (ReaderT EOLCPortMidiError m) a b #

type Rep EOLCPortMidiError Source # 
Instance details

Defined in LiveCoding.PortMidi

type Rep EOLCPortMidiError = D1 ('MetaData "EOLCPortMidiError" "LiveCoding.PortMidi" "essence-of-live-coding-PortMidi-0.2.7-1wtHpgEUxUPLLxoxLaZSGP" 'False) ((C1 ('MetaCons "PMError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PMError)) :+: C1 ('MetaCons "NoSuchDevice" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "NotAnInputDevice" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "NotAnOutputDevice" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "MultipleDevices" 'PrefixI 'False) (U1 :: Type -> Type))))

Constructing values in PortMidiT

throwPortMidi :: Monad m => EOLCPortMidiError -> PortMidiT m arbitrary Source #

Given an exception value, throw it immediately.

liftPMError :: Monad m => m (Either PMError a) -> PortMidiT m a Source #

Given a monadic action that produces a value or a EOLCPortMidiError, run it as an action in PortMidiT. Typically needed to lift PortMidi backend functions.

liftHandlingState :: Monad m => Cell (HandlingStateT m) a b -> Cell (PortMidiT m) a b Source #

Given a cell with existing handles, lift it into PortMidiT.

Running values in PortMidiT

runPortMidiC :: MonadIO m => Cell (PortMidiT m) a b -> CellExcept a b (HandlingStateT m) EOLCPortMidiError Source #

Run a cell containing PortMidi effects.

runPortMidiC cell goes through the following steps:

  1. Initialize the MIDI system
  2. Run cell, until possibly an exception occurs
  3. Shut the MIDI system down
  4. Throw the exception in CellExcept

loopPortMidiC :: MonadIO m => Cell (PortMidiT m) a b -> Cell (HandlingStateT m) a b Source #

Repeatedly run a cell containing PortMidi effects.

Effectively loops over runPortMidiC, and prints the exception after it occurred.

runPortMidiT :: PortMidiT m a -> HandlingStateT m (Either EOLCPortMidiError a) Source #

Execute the PortMidiT effects'.

This returns the first occurring exception. For details on how to automatically start and garbage collect handles, such as the PortMidi backend and devices, see LiveCoding.HandlingState.

You will rarely need this function. Look at runPortMidiC and loopPortMidiC instead.

Input- and output streams

newtype PortMidiInputStream Source #

A stream associated to a PortMidi input device

newtype PortMidiOutputStream Source #

A stream associated to a PortMidi output device

data DeviceDirection Source #

A marker to specify which kind of device to search

Constructors

Input 
Output 

lookupDeviceID :: MonadIO m => String -> DeviceDirection -> m (Either EOLCPortMidiError DeviceID) Source #

Look up a PortMidi device by its name and direction.

You will rarely need this function. Consider readEventsC and writeEventsC instead.

readEventsFrom :: MonadIO m => Cell (PortMidiT m) PortMidiInputStream [PMEvent] Source #

Read all events from the PortMidiInputStream that accumulated since the last tick.

readEventsC :: MonadIO m => String -> Cell (PortMidiT m) arbitrary [PMEvent] Source #

Read all events from the input device of the given name.

Automatically opens the device.

This is basically a convenient combination of portMidiInputStreamHandle and readEventsFrom.

writeEventsC :: MonadIO m => String -> Cell (PortMidiT m) [PMEvent] () Source #

Write all events to the output device of the given name.

Automatically opens the device.

This is basically a convenient combination of portMidiOutputStreamHandle and writeEventsTo.

data PortMidiDevices Source #

All devices that the PortMidi backend has connected.

getPortMidiDevices :: IO PortMidiDevices Source #

Retrieve all PortMidi devices.

prettyPrintPortMidiDevices :: PortMidiDevices -> IO () Source #

Print input and output devices separately, one device per line.

Orphan instances

Data PMError Source # 
Instance details

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> PMError -> c PMError #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c PMError #

toConstr :: PMError -> Constr #

dataTypeOf :: PMError -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c PMError) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PMError) #

gmapT :: (forall b. Data b => b -> b) -> PMError -> PMError #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PMError -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PMError -> r #

gmapQ :: (forall d. Data d => d -> u) -> PMError -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> PMError -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> PMError -> m PMError #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> PMError -> m PMError #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> PMError -> m PMError #

Generic PMError Source # 
Instance details

Associated Types

type Rep PMError :: Type -> Type #

Methods

from :: PMError -> Rep PMError x #

to :: Rep PMError x -> PMError #

Finite PMError Source # 
Instance details

Methods

commute :: forall (m :: Type -> Type) a b. Monad m => (PMError -> Cell m a b) -> Cell (ReaderT PMError m) a b #