{-# LANGUAGE Arrows #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}

{- | * Support for [PortMidi](http://hackage.haskell.org/package/PortMidi)

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.
-}
module LiveCoding.PortMidi where

-- base
import Control.Concurrent (threadDelay)
import Control.Monad (forM, join, void)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Either (fromRight)
import Data.Foldable (find, traverse_)
import Data.Function ((&))
import Data.Maybe (catMaybes)
import GHC.Generics
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)

-- transformers
import Control.Monad.Trans.Class

-- PortMidi
import Sound.PortMidi

-- essence-of-live-coding
import LiveCoding

-- essence-of-live-coding-PortMidi
import LiveCoding.PortMidi.Internal

-- * The 'PortMidiT' monad transformer

{- | Monad transformer adding PortMidi-related effects to your monad.

This transformer adds two kinds of effects to your stack:

* PortMidi exceptions (See 'EOLCPortMidiError')
* Automatic initialisation of PortMidi devices (using 'HandlingStateT')
-}
newtype PortMidiT m a = PortMidiT
  {forall (m :: * -> *) a.
PortMidiT m a -> ExceptT EOLCPortMidiError (HandlingStateT m) a
unPortMidiT :: ExceptT EOLCPortMidiError (HandlingStateT m) a}
  deriving ((forall a b. (a -> b) -> PortMidiT m a -> PortMidiT m b)
-> (forall a b. a -> PortMidiT m b -> PortMidiT m a)
-> Functor (PortMidiT m)
forall a b. a -> PortMidiT m b -> PortMidiT m a
forall a b. (a -> b) -> PortMidiT m a -> PortMidiT m b
forall (m :: * -> *) a b.
Functor m =>
a -> PortMidiT m b -> PortMidiT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> PortMidiT m a -> PortMidiT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> PortMidiT m a -> PortMidiT m b
fmap :: forall a b. (a -> b) -> PortMidiT m a -> PortMidiT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> PortMidiT m b -> PortMidiT m a
<$ :: forall a b. a -> PortMidiT m b -> PortMidiT m a
Functor, Functor (PortMidiT m)
Functor (PortMidiT m) =>
(forall a. a -> PortMidiT m a)
-> (forall a b.
    PortMidiT m (a -> b) -> PortMidiT m a -> PortMidiT m b)
-> (forall a b c.
    (a -> b -> c) -> PortMidiT m a -> PortMidiT m b -> PortMidiT m c)
-> (forall a b. PortMidiT m a -> PortMidiT m b -> PortMidiT m b)
-> (forall a b. PortMidiT m a -> PortMidiT m b -> PortMidiT m a)
-> Applicative (PortMidiT m)
forall a. a -> PortMidiT m a
forall a b. PortMidiT m a -> PortMidiT m b -> PortMidiT m a
forall a b. PortMidiT m a -> PortMidiT m b -> PortMidiT m b
forall a b. PortMidiT m (a -> b) -> PortMidiT m a -> PortMidiT m b
forall a b c.
(a -> b -> c) -> PortMidiT m a -> PortMidiT m b -> PortMidiT m c
forall (m :: * -> *). Monad m => Functor (PortMidiT m)
forall (m :: * -> *) a. Monad m => a -> PortMidiT m a
forall (m :: * -> *) a b.
Monad m =>
PortMidiT m a -> PortMidiT m b -> PortMidiT m a
forall (m :: * -> *) a b.
Monad m =>
PortMidiT m a -> PortMidiT m b -> PortMidiT m b
forall (m :: * -> *) a b.
Monad m =>
PortMidiT m (a -> b) -> PortMidiT m a -> PortMidiT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> PortMidiT m a -> PortMidiT m b -> PortMidiT m 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
$cpure :: forall (m :: * -> *) a. Monad m => a -> PortMidiT m a
pure :: forall a. a -> PortMidiT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
PortMidiT m (a -> b) -> PortMidiT m a -> PortMidiT m b
<*> :: forall a b. PortMidiT m (a -> b) -> PortMidiT m a -> PortMidiT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> PortMidiT m a -> PortMidiT m b -> PortMidiT m c
liftA2 :: forall a b c.
(a -> b -> c) -> PortMidiT m a -> PortMidiT m b -> PortMidiT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
PortMidiT m a -> PortMidiT m b -> PortMidiT m b
*> :: forall a b. PortMidiT m a -> PortMidiT m b -> PortMidiT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
PortMidiT m a -> PortMidiT m b -> PortMidiT m a
<* :: forall a b. PortMidiT m a -> PortMidiT m b -> PortMidiT m a
Applicative, Applicative (PortMidiT m)
Applicative (PortMidiT m) =>
(forall a b.
 PortMidiT m a -> (a -> PortMidiT m b) -> PortMidiT m b)
-> (forall a b. PortMidiT m a -> PortMidiT m b -> PortMidiT m b)
-> (forall a. a -> PortMidiT m a)
-> Monad (PortMidiT m)
forall a. a -> PortMidiT m a
forall a b. PortMidiT m a -> PortMidiT m b -> PortMidiT m b
forall a b. PortMidiT m a -> (a -> PortMidiT m b) -> PortMidiT m b
forall (m :: * -> *). Monad m => Applicative (PortMidiT m)
forall (m :: * -> *) a. Monad m => a -> PortMidiT m a
forall (m :: * -> *) a b.
Monad m =>
PortMidiT m a -> PortMidiT m b -> PortMidiT m b
forall (m :: * -> *) a b.
Monad m =>
PortMidiT m a -> (a -> PortMidiT m b) -> PortMidiT m 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
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
PortMidiT m a -> (a -> PortMidiT m b) -> PortMidiT m b
>>= :: forall a b. PortMidiT m a -> (a -> PortMidiT m b) -> PortMidiT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
PortMidiT m a -> PortMidiT m b -> PortMidiT m b
>> :: forall a b. PortMidiT m a -> PortMidiT m b -> PortMidiT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> PortMidiT m a
return :: forall a. a -> PortMidiT m a
Monad, Monad (PortMidiT m)
Monad (PortMidiT m) =>
(forall a. IO a -> PortMidiT m a) -> MonadIO (PortMidiT m)
forall a. IO a -> PortMidiT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (PortMidiT m)
forall (m :: * -> *) a. MonadIO m => IO a -> PortMidiT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> PortMidiT m a
liftIO :: forall a. IO a -> PortMidiT m a
MonadIO)

instance MonadTrans PortMidiT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> PortMidiT m a
lift = ExceptT EOLCPortMidiError (HandlingStateT m) a -> PortMidiT m a
forall (m :: * -> *) a.
ExceptT EOLCPortMidiError (HandlingStateT m) a -> PortMidiT m a
PortMidiT (ExceptT EOLCPortMidiError (HandlingStateT m) a -> PortMidiT m a)
-> (m a -> ExceptT EOLCPortMidiError (HandlingStateT m) a)
-> m a
-> PortMidiT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlingStateT m a
-> ExceptT EOLCPortMidiError (HandlingStateT m) a
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT EOLCPortMidiError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (HandlingStateT m a
 -> ExceptT EOLCPortMidiError (HandlingStateT m) a)
-> (m a -> HandlingStateT m a)
-> m a
-> ExceptT EOLCPortMidiError (HandlingStateT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> HandlingStateT m a
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (HandlingState m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

{- | Exceptions that can occur while doing livecoding with PortMidi.

There are two kinds of exceptions:

* Internal PortMidi exceptions (see 'PMError')
* When a device is not correctly specified by name and input/output configuration
-}
data EOLCPortMidiError
  = -- | An internal error occurred in the PortMidi library
    PMError PMError
  | -- | There is no device of that name
    NoSuchDevice
  | -- | There is a device of that name, but it doesn't support input
    NotAnInputDevice
  | -- | There is a device of that name, but it doesn't support output
    NotAnOutputDevice
  | -- | There are multiple devices of the same name
    MultipleDevices
  deriving (Typeable EOLCPortMidiError
Typeable EOLCPortMidiError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> EOLCPortMidiError
 -> c EOLCPortMidiError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EOLCPortMidiError)
-> (EOLCPortMidiError -> Constr)
-> (EOLCPortMidiError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c EOLCPortMidiError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c EOLCPortMidiError))
-> ((forall b. Data b => b -> b)
    -> EOLCPortMidiError -> EOLCPortMidiError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> EOLCPortMidiError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> EOLCPortMidiError -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> EOLCPortMidiError -> [u])
-> (forall u.
    DeviceID -> (forall d. Data d => d -> u) -> EOLCPortMidiError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> EOLCPortMidiError -> m EOLCPortMidiError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> EOLCPortMidiError -> m EOLCPortMidiError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> EOLCPortMidiError -> m EOLCPortMidiError)
-> Data EOLCPortMidiError
EOLCPortMidiError -> Constr
EOLCPortMidiError -> DataType
(forall b. Data b => b -> b)
-> EOLCPortMidiError -> EOLCPortMidiError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. DeviceID -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
DeviceID -> (forall d. Data d => d -> u) -> EOLCPortMidiError -> u
forall u. (forall d. Data d => d -> u) -> EOLCPortMidiError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EOLCPortMidiError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EOLCPortMidiError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> EOLCPortMidiError -> m EOLCPortMidiError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EOLCPortMidiError -> m EOLCPortMidiError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EOLCPortMidiError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EOLCPortMidiError -> c EOLCPortMidiError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EOLCPortMidiError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EOLCPortMidiError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EOLCPortMidiError -> c EOLCPortMidiError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EOLCPortMidiError -> c EOLCPortMidiError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EOLCPortMidiError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EOLCPortMidiError
$ctoConstr :: EOLCPortMidiError -> Constr
toConstr :: EOLCPortMidiError -> Constr
$cdataTypeOf :: EOLCPortMidiError -> DataType
dataTypeOf :: EOLCPortMidiError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EOLCPortMidiError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EOLCPortMidiError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EOLCPortMidiError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EOLCPortMidiError)
$cgmapT :: (forall b. Data b => b -> b)
-> EOLCPortMidiError -> EOLCPortMidiError
gmapT :: (forall b. Data b => b -> b)
-> EOLCPortMidiError -> EOLCPortMidiError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EOLCPortMidiError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EOLCPortMidiError -> r
$cgmapQr :: forall r r'.
(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
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EOLCPortMidiError -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> EOLCPortMidiError -> [u]
$cgmapQi :: forall u.
DeviceID -> (forall d. Data d => d -> u) -> EOLCPortMidiError -> u
gmapQi :: forall u.
DeviceID -> (forall d. Data d => d -> u) -> EOLCPortMidiError -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> EOLCPortMidiError -> m EOLCPortMidiError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> EOLCPortMidiError -> m EOLCPortMidiError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EOLCPortMidiError -> m EOLCPortMidiError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EOLCPortMidiError -> m EOLCPortMidiError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EOLCPortMidiError -> m EOLCPortMidiError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EOLCPortMidiError -> m EOLCPortMidiError
Data, (forall x. EOLCPortMidiError -> Rep EOLCPortMidiError x)
-> (forall x. Rep EOLCPortMidiError x -> EOLCPortMidiError)
-> Generic EOLCPortMidiError
forall x. Rep EOLCPortMidiError x -> EOLCPortMidiError
forall x. EOLCPortMidiError -> Rep EOLCPortMidiError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EOLCPortMidiError -> Rep EOLCPortMidiError x
from :: forall x. EOLCPortMidiError -> Rep EOLCPortMidiError x
$cto :: forall x. Rep EOLCPortMidiError x -> EOLCPortMidiError
to :: forall x. Rep EOLCPortMidiError x -> EOLCPortMidiError
Generic, DeviceID -> EOLCPortMidiError -> ShowS
[EOLCPortMidiError] -> ShowS
EOLCPortMidiError -> String
(DeviceID -> EOLCPortMidiError -> ShowS)
-> (EOLCPortMidiError -> String)
-> ([EOLCPortMidiError] -> ShowS)
-> Show EOLCPortMidiError
forall a.
(DeviceID -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: DeviceID -> EOLCPortMidiError -> ShowS
showsPrec :: DeviceID -> EOLCPortMidiError -> ShowS
$cshow :: EOLCPortMidiError -> String
show :: EOLCPortMidiError -> String
$cshowList :: [EOLCPortMidiError] -> ShowS
showList :: [EOLCPortMidiError] -> ShowS
Show)

instance Finite EOLCPortMidiError

deriving instance Data PMError
deriving instance Generic PMError
instance Finite PMError

-- ** Constructing values in 'PortMidiT'

-- | Given an exception value, throw it immediately.
throwPortMidi :: (Monad m) => EOLCPortMidiError -> PortMidiT m arbitrary
throwPortMidi :: forall (m :: * -> *) arbitrary.
Monad m =>
EOLCPortMidiError -> PortMidiT m arbitrary
throwPortMidi = ExceptT EOLCPortMidiError (HandlingStateT m) arbitrary
-> PortMidiT m arbitrary
forall (m :: * -> *) a.
ExceptT EOLCPortMidiError (HandlingStateT m) a -> PortMidiT m a
PortMidiT (ExceptT EOLCPortMidiError (HandlingStateT m) arbitrary
 -> PortMidiT m arbitrary)
-> (EOLCPortMidiError
    -> ExceptT EOLCPortMidiError (HandlingStateT m) arbitrary)
-> EOLCPortMidiError
-> PortMidiT m arbitrary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EOLCPortMidiError
-> ExceptT EOLCPortMidiError (HandlingStateT m) arbitrary
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE

-- | Like 'throwPortMidi', but as a 'Cell'.
throwPortMidiC :: (Monad m) => Cell (PortMidiT m) EOLCPortMidiError arbitrary
throwPortMidiC :: forall (m :: * -> *) arbitrary.
Monad m =>
Cell (PortMidiT m) EOLCPortMidiError arbitrary
throwPortMidiC = (EOLCPortMidiError -> PortMidiT m arbitrary)
-> Cell (PortMidiT m) EOLCPortMidiError arbitrary
forall a (m :: * -> *) b. (a -> m b) -> Cell m a b
arrM EOLCPortMidiError -> PortMidiT m arbitrary
forall (m :: * -> *) arbitrary.
Monad m =>
EOLCPortMidiError -> PortMidiT m arbitrary
throwPortMidi

{- | Given a monadic action that produces a value or a 'PMError',
   run it as an action in 'PortMidiT'.
   Typically needed to lift PortMidi backend functions.
-}
liftPMError :: (Monad m) => m (Either PMError a) -> PortMidiT m a
liftPMError :: forall (m :: * -> *) a.
Monad m =>
m (Either PMError a) -> PortMidiT m a
liftPMError = ExceptT EOLCPortMidiError (StateT (HandlingState m) m) a
-> PortMidiT m a
forall (m :: * -> *) a.
ExceptT EOLCPortMidiError (HandlingStateT m) a -> PortMidiT m a
PortMidiT (ExceptT EOLCPortMidiError (StateT (HandlingState m) m) a
 -> PortMidiT m a)
-> (m (Either PMError a)
    -> ExceptT EOLCPortMidiError (StateT (HandlingState m) m) a)
-> m (Either PMError a)
-> PortMidiT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlingStateT m (Either EOLCPortMidiError a)
-> ExceptT EOLCPortMidiError (StateT (HandlingState m) m) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (HandlingStateT m (Either EOLCPortMidiError a)
 -> ExceptT EOLCPortMidiError (StateT (HandlingState m) m) a)
-> (m (Either PMError a)
    -> HandlingStateT m (Either EOLCPortMidiError a))
-> m (Either PMError a)
-> ExceptT EOLCPortMidiError (StateT (HandlingState m) m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either PMError a -> Either EOLCPortMidiError a)
-> StateT (HandlingState m) m (Either PMError a)
-> HandlingStateT m (Either EOLCPortMidiError a)
forall a b.
(a -> b)
-> StateT (HandlingState m) m a -> StateT (HandlingState m) m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PMError -> EOLCPortMidiError)
-> Either PMError a -> Either EOLCPortMidiError a
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left PMError -> EOLCPortMidiError
PMError) (StateT (HandlingState m) m (Either PMError a)
 -> HandlingStateT m (Either EOLCPortMidiError a))
-> (m (Either PMError a)
    -> StateT (HandlingState m) m (Either PMError a))
-> m (Either PMError a)
-> HandlingStateT m (Either EOLCPortMidiError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either PMError a)
-> StateT (HandlingState m) m (Either PMError a)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (HandlingState m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Given a cell with existing handles, lift it into 'PortMidiT'.
liftHandlingState :: (Monad m) => Cell (HandlingStateT m) a b -> Cell (PortMidiT m) a b
liftHandlingState :: forall (m :: * -> *) a b.
Monad m =>
Cell (HandlingStateT m) a b -> Cell (PortMidiT m) a b
liftHandlingState = (forall x. HandlingStateT m x -> PortMidiT m x)
-> Cell (HandlingStateT m) a b -> Cell (PortMidiT m) a b
forall (m1 :: * -> *) (m2 :: * -> *) a b.
(forall x. m1 x -> m2 x) -> Cell m1 a b -> Cell m2 a b
hoistCell ((forall x. HandlingStateT m x -> PortMidiT m x)
 -> Cell (HandlingStateT m) a b -> Cell (PortMidiT m) a b)
-> (forall x. HandlingStateT m x -> PortMidiT m x)
-> Cell (HandlingStateT m) a b
-> Cell (PortMidiT m) a b
forall a b. (a -> b) -> a -> b
$ ExceptT EOLCPortMidiError (HandlingStateT m) x -> PortMidiT m x
forall (m :: * -> *) a.
ExceptT EOLCPortMidiError (HandlingStateT m) a -> PortMidiT m a
PortMidiT (ExceptT EOLCPortMidiError (HandlingStateT m) x -> PortMidiT m x)
-> (HandlingStateT m x
    -> ExceptT EOLCPortMidiError (HandlingStateT m) x)
-> HandlingStateT m x
-> PortMidiT m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlingStateT m x
-> ExceptT EOLCPortMidiError (HandlingStateT m) x
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT EOLCPortMidiError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- ** Running values in 'PortMidiT'

{- | 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'
-}
runPortMidiC :: (MonadIO m) => Cell (PortMidiT m) a b -> CellExcept a b (HandlingStateT m) EOLCPortMidiError
runPortMidiC :: forall (m :: * -> *) a b.
MonadIO m =>
Cell (PortMidiT m) a b
-> CellExcept a b (HandlingStateT m) EOLCPortMidiError
runPortMidiC Cell (PortMidiT m) a b
cell = Cell (ExceptT EOLCPortMidiError (HandlingStateT m)) a b
-> CellExcept a b (HandlingStateT m) EOLCPortMidiError
forall e (m :: * -> *) a b.
(Data e, Finite e) =>
Cell (ExceptT e m) a b -> CellExcept a b m e
try (Cell (ExceptT EOLCPortMidiError (HandlingStateT m)) a b
 -> CellExcept a b (HandlingStateT m) EOLCPortMidiError)
-> Cell (ExceptT EOLCPortMidiError (HandlingStateT m)) a b
-> CellExcept a b (HandlingStateT m) EOLCPortMidiError
forall a b. (a -> b) -> a -> b
$ proc a
a -> do
  PortMidiHandle
_ <- Cell (HandlingStateT m) () PortMidiHandle
-> Cell
     (ExceptT EOLCPortMidiError (HandlingStateT m)) () PortMidiHandle
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a b.
(Monad m, MonadTrans t) =>
Cell m a b -> Cell (t m) a b
liftCell (Cell (HandlingStateT m) () PortMidiHandle
 -> Cell
      (ExceptT EOLCPortMidiError (HandlingStateT m)) () PortMidiHandle)
-> Cell (HandlingStateT m) () PortMidiHandle
-> Cell
     (ExceptT EOLCPortMidiError (HandlingStateT m)) () PortMidiHandle
forall a b. (a -> b) -> a -> b
$ Handle m PortMidiHandle
-> Cell (HandlingStateT m) () PortMidiHandle
forall h (m :: * -> *) arbitrary.
(Typeable h, Monad m) =>
Handle m h -> Cell (HandlingStateT m) arbitrary h
handling Handle m PortMidiHandle
forall (m :: * -> *). MonadIO m => Handle m PortMidiHandle
portMidiHandle -< ()
  (forall x.
 PortMidiT m x -> ExceptT EOLCPortMidiError (HandlingStateT m) x)
-> Cell (PortMidiT m) a b
-> Cell (ExceptT EOLCPortMidiError (HandlingStateT m)) a b
forall (m1 :: * -> *) (m2 :: * -> *) a b.
(forall x. m1 x -> m2 x) -> Cell m1 a b -> Cell m2 a b
hoistCell PortMidiT m x -> ExceptT EOLCPortMidiError (HandlingStateT m) x
forall x.
PortMidiT m x -> ExceptT EOLCPortMidiError (HandlingStateT m) x
forall (m :: * -> *) a.
PortMidiT m a -> ExceptT EOLCPortMidiError (HandlingStateT m) a
unPortMidiT Cell (PortMidiT m) a b
cell -< a
a

{- | Repeatedly run a cell containing PortMidi effects.

Effectively loops over 'runPortMidiC',
and prints the exception after it occurred.
-}
loopPortMidiC :: (MonadIO m) => Cell (PortMidiT m) a b -> Cell (HandlingStateT m) a b
loopPortMidiC :: forall (m :: * -> *) a b.
MonadIO m =>
Cell (PortMidiT m) a b -> Cell (HandlingStateT m) a b
loopPortMidiC Cell (PortMidiT m) a b
cell = Cell (ExceptT EOLCPortMidiError (HandlingStateT m)) a b
-> Cell (HandlingStateT m) a b
forall e (m :: * -> *) a b.
(Data e, Monad m) =>
Cell (ExceptT e m) a b -> Cell m a b
foreverC (Cell (ExceptT EOLCPortMidiError (HandlingStateT m)) a b
 -> Cell (HandlingStateT m) a b)
-> Cell (ExceptT EOLCPortMidiError (HandlingStateT m)) a b
-> Cell (HandlingStateT m) a b
forall a b. (a -> b) -> a -> b
$ CellExcept a b (HandlingStateT m) EOLCPortMidiError
-> Cell (ExceptT EOLCPortMidiError (HandlingStateT m)) a b
forall (m :: * -> *) a b e.
Monad m =>
CellExcept a b m e -> Cell (ExceptT e m) a b
runCellExcept (CellExcept a b (HandlingStateT m) EOLCPortMidiError
 -> Cell (ExceptT EOLCPortMidiError (HandlingStateT m)) a b)
-> CellExcept a b (HandlingStateT m) EOLCPortMidiError
-> Cell (ExceptT EOLCPortMidiError (HandlingStateT m)) a b
forall a b. (a -> b) -> a -> b
$ do
  EOLCPortMidiError
e <- Cell (PortMidiT m) a b
-> CellExcept a b (HandlingStateT m) EOLCPortMidiError
forall (m :: * -> *) a b.
MonadIO m =>
Cell (PortMidiT m) a b
-> CellExcept a b (HandlingStateT m) EOLCPortMidiError
runPortMidiC Cell (PortMidiT m) a b
cell
  HandlingStateT m () -> CellExcept a b (HandlingStateT m) ()
forall (m :: * -> *) e a arbitrary.
(Monad m, Data e, Finite e) =>
m e -> CellExcept a arbitrary m e
once_ (HandlingStateT m () -> CellExcept a b (HandlingStateT m) ())
-> HandlingStateT m () -> CellExcept a b (HandlingStateT m) ()
forall a b. (a -> b) -> a -> b
$ IO () -> HandlingStateT m ()
forall a. IO a -> StateT (HandlingState m) m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HandlingStateT m ()) -> IO () -> HandlingStateT m ()
forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
putStrLn String
"Encountered PortMidi exception:"
    EOLCPortMidiError -> IO ()
forall a. Show a => a -> IO ()
print EOLCPortMidiError
e
    DeviceID -> IO ()
threadDelay DeviceID
1000
  EOLCPortMidiError
-> CellExcept a b (HandlingStateT m) EOLCPortMidiError
forall a. a -> CellExcept a b (HandlingStateT m) a
forall (m :: * -> *) a. Monad m => a -> m a
return EOLCPortMidiError
e

{- | 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.
-}
runPortMidiT :: PortMidiT m a -> HandlingStateT m (Either EOLCPortMidiError a)
runPortMidiT :: forall (m :: * -> *) a.
PortMidiT m a -> HandlingStateT m (Either EOLCPortMidiError a)
runPortMidiT PortMidiT {ExceptT EOLCPortMidiError (HandlingStateT m) a
unPortMidiT :: forall (m :: * -> *) a.
PortMidiT m a -> ExceptT EOLCPortMidiError (HandlingStateT m) a
unPortMidiT :: ExceptT EOLCPortMidiError (HandlingStateT m) a
..} = ExceptT EOLCPortMidiError (HandlingStateT m) a
-> StateT (HandlingState m) m (Either EOLCPortMidiError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT EOLCPortMidiError (HandlingStateT m) a
unPortMidiT

-- * Input- and output streams

-- | A stream associated to a PortMidi input device
newtype PortMidiInputStream = PortMidiInputStream {PortMidiInputStream -> PMStream
unPortMidiInputStream :: PMStream}

-- | A stream associated to a PortMidi output device
newtype PortMidiOutputStream = PortMidiOutputStream {PortMidiOutputStream -> PMStream
unPortMidiOutputStream :: PMStream}

-- | A marker to specify which kind of device to search
data DeviceDirection = Input | Output

{- | Look up a PortMidi device by its name and direction.

You will rarely need this function.
Consider 'readEventsC' and 'writeEventsC' instead.
-}
lookupDeviceID ::
  (MonadIO m) =>
  String ->
  DeviceDirection ->
  m (Either EOLCPortMidiError DeviceID)
lookupDeviceID :: forall (m :: * -> *).
MonadIO m =>
String -> DeviceDirection -> m (Either EOLCPortMidiError DeviceID)
lookupDeviceID String
nameLookingFor DeviceDirection
inputOrOutput = do
  DeviceID
nDevices <- IO DeviceID -> m DeviceID
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO DeviceID
countDevices
  -- This is a bit of a race condition, but PortMidi has no better API
  [(DeviceInfo, DeviceID)]
devices <- [DeviceID]
-> (DeviceID -> m (DeviceInfo, DeviceID))
-> m [(DeviceInfo, DeviceID)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [DeviceID
0 .. DeviceID
nDevices DeviceID -> DeviceID -> DeviceID
forall a. Num a => a -> a -> a
- DeviceID
1] ((DeviceID -> m (DeviceInfo, DeviceID))
 -> m [(DeviceInfo, DeviceID)])
-> (DeviceID -> m (DeviceInfo, DeviceID))
-> m [(DeviceInfo, DeviceID)]
forall a b. (a -> b) -> a -> b
$ \DeviceID
deviceID -> do
    DeviceInfo
deviceInfo <- IO DeviceInfo -> m DeviceInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DeviceInfo -> m DeviceInfo) -> IO DeviceInfo -> m DeviceInfo
forall a b. (a -> b) -> a -> b
$ DeviceID -> IO DeviceInfo
getDeviceInfo DeviceID
deviceID
    (DeviceInfo, DeviceID) -> m (DeviceInfo, DeviceID)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DeviceInfo
deviceInfo, DeviceID
deviceID)
  let allDevicesWithName :: [(DeviceInfo, DeviceID)]
allDevicesWithName = ((DeviceInfo, DeviceID) -> Bool)
-> [(DeviceInfo, DeviceID)] -> [(DeviceInfo, DeviceID)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String
nameLookingFor String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool)
-> ((DeviceInfo, DeviceID) -> String)
-> (DeviceInfo, DeviceID)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeviceInfo -> String
name (DeviceInfo -> String)
-> ((DeviceInfo, DeviceID) -> DeviceInfo)
-> (DeviceInfo, DeviceID)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeviceInfo, DeviceID) -> DeviceInfo
forall a b. (a, b) -> a
fst) [(DeviceInfo, DeviceID)]
devices
      inputDevices :: [(DeviceInfo, DeviceID)]
inputDevices = ((DeviceInfo, DeviceID) -> Bool)
-> [(DeviceInfo, DeviceID)] -> [(DeviceInfo, DeviceID)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DeviceInfo -> Bool
input (DeviceInfo -> Bool)
-> ((DeviceInfo, DeviceID) -> DeviceInfo)
-> (DeviceInfo, DeviceID)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeviceInfo, DeviceID) -> DeviceInfo
forall a b. (a, b) -> a
fst) [(DeviceInfo, DeviceID)]
allDevicesWithName
      outputDevices :: [(DeviceInfo, DeviceID)]
outputDevices = ((DeviceInfo, DeviceID) -> Bool)
-> [(DeviceInfo, DeviceID)] -> [(DeviceInfo, DeviceID)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DeviceInfo -> Bool
output (DeviceInfo -> Bool)
-> ((DeviceInfo, DeviceID) -> DeviceInfo)
-> (DeviceInfo, DeviceID)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeviceInfo, DeviceID) -> DeviceInfo
forall a b. (a, b) -> a
fst) [(DeviceInfo, DeviceID)]
allDevicesWithName
  Either EOLCPortMidiError DeviceID
-> m (Either EOLCPortMidiError DeviceID)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either EOLCPortMidiError DeviceID
 -> m (Either EOLCPortMidiError DeviceID))
-> Either EOLCPortMidiError DeviceID
-> m (Either EOLCPortMidiError DeviceID)
forall a b. (a -> b) -> a -> b
$ case (DeviceDirection
inputOrOutput, [(DeviceInfo, DeviceID)]
inputDevices, [(DeviceInfo, DeviceID)]
outputDevices) of
    (DeviceDirection
_, [], []) -> EOLCPortMidiError -> Either EOLCPortMidiError DeviceID
forall a b. a -> Either a b
Left EOLCPortMidiError
NoSuchDevice
    (DeviceDirection
Input, [], (DeviceInfo, DeviceID)
_ : [(DeviceInfo, DeviceID)]
_) -> EOLCPortMidiError -> Either EOLCPortMidiError DeviceID
forall a b. a -> Either a b
Left EOLCPortMidiError
NotAnInputDevice
    (DeviceDirection
Output, (DeviceInfo, DeviceID)
_ : [(DeviceInfo, DeviceID)]
_, []) -> EOLCPortMidiError -> Either EOLCPortMidiError DeviceID
forall a b. a -> Either a b
Left EOLCPortMidiError
NotAnOutputDevice
    (DeviceDirection
Input, [(DeviceInfo
_, DeviceID
deviceID)], [(DeviceInfo, DeviceID)]
_) -> DeviceID -> Either EOLCPortMidiError DeviceID
forall a b. b -> Either a b
Right DeviceID
deviceID
    (DeviceDirection
Output, [(DeviceInfo, DeviceID)]
_, [(DeviceInfo
_, DeviceID
deviceID)]) -> DeviceID -> Either EOLCPortMidiError DeviceID
forall a b. b -> Either a b
Right DeviceID
deviceID
    (DeviceDirection, [(DeviceInfo, DeviceID)],
 [(DeviceInfo, DeviceID)])
_ -> EOLCPortMidiError -> Either EOLCPortMidiError DeviceID
forall a b. a -> Either a b
Left EOLCPortMidiError
MultipleDevices

-- | A 'Handle' that opens a 'PortMidiInputStream' of the given device name.
portMidiInputStreamHandle ::
  (MonadIO m) =>
  String ->
  Handle m (Either EOLCPortMidiError PortMidiInputStream)
portMidiInputStreamHandle :: forall (m :: * -> *).
MonadIO m =>
String -> Handle m (Either EOLCPortMidiError PortMidiInputStream)
portMidiInputStreamHandle String
name =
  Handle
    { create :: m (Either EOLCPortMidiError PortMidiInputStream)
create = ExceptT EOLCPortMidiError m PortMidiInputStream
-> m (Either EOLCPortMidiError PortMidiInputStream)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT EOLCPortMidiError m PortMidiInputStream
 -> m (Either EOLCPortMidiError PortMidiInputStream))
-> ExceptT EOLCPortMidiError m PortMidiInputStream
-> m (Either EOLCPortMidiError PortMidiInputStream)
forall a b. (a -> b) -> a -> b
$ do
        DeviceID
deviceID <- m (Either EOLCPortMidiError DeviceID)
-> ExceptT EOLCPortMidiError m DeviceID
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either EOLCPortMidiError DeviceID)
 -> ExceptT EOLCPortMidiError m DeviceID)
-> m (Either EOLCPortMidiError DeviceID)
-> ExceptT EOLCPortMidiError m DeviceID
forall a b. (a -> b) -> a -> b
$ String -> DeviceDirection -> m (Either EOLCPortMidiError DeviceID)
forall (m :: * -> *).
MonadIO m =>
String -> DeviceDirection -> m (Either EOLCPortMidiError DeviceID)
lookupDeviceID String
name DeviceDirection
Input
        (PMStream -> PortMidiInputStream)
-> ExceptT EOLCPortMidiError m PMStream
-> ExceptT EOLCPortMidiError m PortMidiInputStream
forall a b.
(a -> b)
-> ExceptT EOLCPortMidiError m a -> ExceptT EOLCPortMidiError m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PMStream -> PortMidiInputStream
PortMidiInputStream (ExceptT EOLCPortMidiError m PMStream
 -> ExceptT EOLCPortMidiError m PortMidiInputStream)
-> ExceptT EOLCPortMidiError m PMStream
-> ExceptT EOLCPortMidiError m PortMidiInputStream
forall a b. (a -> b) -> a -> b
$ (PMError -> EOLCPortMidiError)
-> ExceptT PMError m PMStream
-> ExceptT EOLCPortMidiError m PMStream
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT PMError -> EOLCPortMidiError
PMError (ExceptT PMError m PMStream
 -> ExceptT EOLCPortMidiError m PMStream)
-> ExceptT PMError m PMStream
-> ExceptT EOLCPortMidiError m PMStream
forall a b. (a -> b) -> a -> b
$ m (Either PMError PMStream) -> ExceptT PMError m PMStream
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either PMError PMStream) -> ExceptT PMError m PMStream)
-> m (Either PMError PMStream) -> ExceptT PMError m PMStream
forall a b. (a -> b) -> a -> b
$ IO (Either PMError PMStream) -> m (Either PMError PMStream)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either PMError PMStream) -> m (Either PMError PMStream))
-> IO (Either PMError PMStream) -> m (Either PMError PMStream)
forall a b. (a -> b) -> a -> b
$ DeviceID -> IO (Either PMError PMStream)
openInput DeviceID
deviceID
    , -- TODO I don't get the error from closing here.
      -- Actually I really want ExceptT in the monad
      destroy :: Either EOLCPortMidiError PortMidiInputStream -> m ()
destroy = (EOLCPortMidiError -> m ())
-> (PortMidiInputStream -> m ())
-> Either EOLCPortMidiError PortMidiInputStream
-> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m () -> EOLCPortMidiError -> m ()
forall a b. a -> b -> a
const (m () -> EOLCPortMidiError -> m ())
-> m () -> EOLCPortMidiError -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ((PortMidiInputStream -> m ())
 -> Either EOLCPortMidiError PortMidiInputStream -> m ())
-> (PortMidiInputStream -> m ())
-> Either EOLCPortMidiError PortMidiInputStream
-> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (PortMidiInputStream -> IO ()) -> PortMidiInputStream -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either PMError PMSuccess) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either PMError PMSuccess) -> IO ())
-> (PortMidiInputStream -> IO (Either PMError PMSuccess))
-> PortMidiInputStream
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PMStream -> IO (Either PMError PMSuccess)
close (PMStream -> IO (Either PMError PMSuccess))
-> (PortMidiInputStream -> PMStream)
-> PortMidiInputStream
-> IO (Either PMError PMSuccess)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PortMidiInputStream -> PMStream
unPortMidiInputStream
    }

-- | Read all events from the 'PortMidiInputStream' that accumulated since the last tick.
readEventsFrom ::
  (MonadIO m) =>
  Cell (PortMidiT m) PortMidiInputStream [PMEvent]
readEventsFrom :: forall (m :: * -> *).
MonadIO m =>
Cell (PortMidiT m) PortMidiInputStream [PMEvent]
readEventsFrom = (PortMidiInputStream -> PortMidiT m [PMEvent])
-> Cell (PortMidiT m) PortMidiInputStream [PMEvent]
forall a (m :: * -> *) b. (a -> m b) -> Cell m a b
arrM ((PortMidiInputStream -> PortMidiT m [PMEvent])
 -> Cell (PortMidiT m) PortMidiInputStream [PMEvent])
-> (PortMidiInputStream -> PortMidiT m [PMEvent])
-> Cell (PortMidiT m) PortMidiInputStream [PMEvent]
forall a b. (a -> b) -> a -> b
$ m (Either PMError [PMEvent]) -> PortMidiT m [PMEvent]
forall (m :: * -> *) a.
Monad m =>
m (Either PMError a) -> PortMidiT m a
liftPMError (m (Either PMError [PMEvent]) -> PortMidiT m [PMEvent])
-> (PortMidiInputStream -> m (Either PMError [PMEvent]))
-> PortMidiInputStream
-> PortMidiT m [PMEvent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either PMError [PMEvent]) -> m (Either PMError [PMEvent])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either PMError [PMEvent]) -> m (Either PMError [PMEvent]))
-> (PortMidiInputStream -> IO (Either PMError [PMEvent]))
-> PortMidiInputStream
-> m (Either PMError [PMEvent])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PMStream -> IO (Either PMError [PMEvent])
readEvents (PMStream -> IO (Either PMError [PMEvent]))
-> (PortMidiInputStream -> PMStream)
-> PortMidiInputStream
-> IO (Either PMError [PMEvent])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PortMidiInputStream -> PMStream
unPortMidiInputStream

{- | 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'.
-}
readEventsC ::
  (MonadIO m) =>
  String ->
  Cell (PortMidiT m) arbitrary [PMEvent]
readEventsC :: forall (m :: * -> *) arbitrary.
MonadIO m =>
String -> Cell (PortMidiT m) arbitrary [PMEvent]
readEventsC String
name = proc arbitrary
_ -> do
  Either EOLCPortMidiError PortMidiInputStream
pmStreamE <- Cell
  (HandlingStateT m)
  ()
  (Either EOLCPortMidiError PortMidiInputStream)
-> Cell
     (PortMidiT m) () (Either EOLCPortMidiError PortMidiInputStream)
forall (m :: * -> *) a b.
Monad m =>
Cell (HandlingStateT m) a b -> Cell (PortMidiT m) a b
liftHandlingState (Cell
   (HandlingStateT m)
   ()
   (Either EOLCPortMidiError PortMidiInputStream)
 -> Cell
      (PortMidiT m) () (Either EOLCPortMidiError PortMidiInputStream))
-> Cell
     (HandlingStateT m)
     ()
     (Either EOLCPortMidiError PortMidiInputStream)
-> Cell
     (PortMidiT m) () (Either EOLCPortMidiError PortMidiInputStream)
forall a b. (a -> b) -> a -> b
$ Handle m (Either EOLCPortMidiError PortMidiInputStream)
-> Cell
     (HandlingStateT m)
     ()
     (Either EOLCPortMidiError PortMidiInputStream)
forall h (m :: * -> *) arbitrary.
(Typeable h, Monad m) =>
Handle m h -> Cell (HandlingStateT m) arbitrary h
handling (Handle m (Either EOLCPortMidiError PortMidiInputStream)
 -> Cell
      (HandlingStateT m)
      ()
      (Either EOLCPortMidiError PortMidiInputStream))
-> Handle m (Either EOLCPortMidiError PortMidiInputStream)
-> Cell
     (HandlingStateT m)
     ()
     (Either EOLCPortMidiError PortMidiInputStream)
forall a b. (a -> b) -> a -> b
$ String -> Handle m (Either EOLCPortMidiError PortMidiInputStream)
forall (m :: * -> *).
MonadIO m =>
String -> Handle m (Either EOLCPortMidiError PortMidiInputStream)
portMidiInputStreamHandle String
name -< ()
  PortMidiInputStream
pmStream <- (forall x.
 ExceptT EOLCPortMidiError (HandlingStateT m) x -> PortMidiT m x)
-> Cell
     (ExceptT EOLCPortMidiError (HandlingStateT m))
     (Either EOLCPortMidiError PortMidiInputStream)
     PortMidiInputStream
-> Cell
     (PortMidiT m)
     (Either EOLCPortMidiError PortMidiInputStream)
     PortMidiInputStream
forall (m1 :: * -> *) (m2 :: * -> *) a b.
(forall x. m1 x -> m2 x) -> Cell m1 a b -> Cell m2 a b
hoistCell ExceptT EOLCPortMidiError (HandlingStateT m) x -> PortMidiT m x
forall x.
ExceptT EOLCPortMidiError (HandlingStateT m) x -> PortMidiT m x
forall (m :: * -> *) a.
ExceptT EOLCPortMidiError (HandlingStateT m) a -> PortMidiT m a
PortMidiT Cell
  (ExceptT EOLCPortMidiError (HandlingStateT m))
  (Either EOLCPortMidiError PortMidiInputStream)
  PortMidiInputStream
forall (m :: * -> *) e a.
Monad m =>
Cell (ExceptT e m) (Either e a) a
exceptC -< Either EOLCPortMidiError PortMidiInputStream
pmStreamE
  Cell (PortMidiT m) PortMidiInputStream [PMEvent]
forall (m :: * -> *).
MonadIO m =>
Cell (PortMidiT m) PortMidiInputStream [PMEvent]
readEventsFrom -< PortMidiInputStream
pmStream

-- | A 'Handle' that opens a 'PortMidiOutputStream' of the given device name.
portMidiOutputStreamHandle ::
  (MonadIO m) =>
  String ->
  Handle m (Either EOLCPortMidiError PortMidiOutputStream)
portMidiOutputStreamHandle :: forall (m :: * -> *).
MonadIO m =>
String -> Handle m (Either EOLCPortMidiError PortMidiOutputStream)
portMidiOutputStreamHandle String
name =
  Handle
    { create :: m (Either EOLCPortMidiError PortMidiOutputStream)
create = ExceptT EOLCPortMidiError m PortMidiOutputStream
-> m (Either EOLCPortMidiError PortMidiOutputStream)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT EOLCPortMidiError m PortMidiOutputStream
 -> m (Either EOLCPortMidiError PortMidiOutputStream))
-> ExceptT EOLCPortMidiError m PortMidiOutputStream
-> m (Either EOLCPortMidiError PortMidiOutputStream)
forall a b. (a -> b) -> a -> b
$ do
        DeviceID
deviceID <- m (Either EOLCPortMidiError DeviceID)
-> ExceptT EOLCPortMidiError m DeviceID
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either EOLCPortMidiError DeviceID)
 -> ExceptT EOLCPortMidiError m DeviceID)
-> m (Either EOLCPortMidiError DeviceID)
-> ExceptT EOLCPortMidiError m DeviceID
forall a b. (a -> b) -> a -> b
$ String -> DeviceDirection -> m (Either EOLCPortMidiError DeviceID)
forall (m :: * -> *).
MonadIO m =>
String -> DeviceDirection -> m (Either EOLCPortMidiError DeviceID)
lookupDeviceID String
name DeviceDirection
Output
        -- Choose same latency as supercollider, see https://github.com/supercollider/supercollider/blob/18c4aad363c49f29e866f884f5ac5bd35969d828/lang/LangPrimSource/SC_PortMIDI.cpp#L416
        -- Thanks Miguel Negrão
        (PMStream -> PortMidiOutputStream)
-> ExceptT EOLCPortMidiError m PMStream
-> ExceptT EOLCPortMidiError m PortMidiOutputStream
forall a b.
(a -> b)
-> ExceptT EOLCPortMidiError m a -> ExceptT EOLCPortMidiError m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PMStream -> PortMidiOutputStream
PortMidiOutputStream (ExceptT EOLCPortMidiError m PMStream
 -> ExceptT EOLCPortMidiError m PortMidiOutputStream)
-> ExceptT EOLCPortMidiError m PMStream
-> ExceptT EOLCPortMidiError m PortMidiOutputStream
forall a b. (a -> b) -> a -> b
$ (PMError -> EOLCPortMidiError)
-> ExceptT PMError m PMStream
-> ExceptT EOLCPortMidiError m PMStream
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT PMError -> EOLCPortMidiError
PMError (ExceptT PMError m PMStream
 -> ExceptT EOLCPortMidiError m PMStream)
-> ExceptT PMError m PMStream
-> ExceptT EOLCPortMidiError m PMStream
forall a b. (a -> b) -> a -> b
$ m (Either PMError PMStream) -> ExceptT PMError m PMStream
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either PMError PMStream) -> ExceptT PMError m PMStream)
-> m (Either PMError PMStream) -> ExceptT PMError m PMStream
forall a b. (a -> b) -> a -> b
$ IO (Either PMError PMStream) -> m (Either PMError PMStream)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either PMError PMStream) -> m (Either PMError PMStream))
-> IO (Either PMError PMStream) -> m (Either PMError PMStream)
forall a b. (a -> b) -> a -> b
$ DeviceID -> DeviceID -> IO (Either PMError PMStream)
openOutput DeviceID
deviceID DeviceID
0
    , destroy :: Either EOLCPortMidiError PortMidiOutputStream -> m ()
destroy = (EOLCPortMidiError -> m ())
-> (PortMidiOutputStream -> m ())
-> Either EOLCPortMidiError PortMidiOutputStream
-> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m () -> EOLCPortMidiError -> m ()
forall a b. a -> b -> a
const (m () -> EOLCPortMidiError -> m ())
-> m () -> EOLCPortMidiError -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ((PortMidiOutputStream -> m ())
 -> Either EOLCPortMidiError PortMidiOutputStream -> m ())
-> (PortMidiOutputStream -> m ())
-> Either EOLCPortMidiError PortMidiOutputStream
-> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (PortMidiOutputStream -> IO ()) -> PortMidiOutputStream -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either PMError PMSuccess) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either PMError PMSuccess) -> IO ())
-> (PortMidiOutputStream -> IO (Either PMError PMSuccess))
-> PortMidiOutputStream
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PMStream -> IO (Either PMError PMSuccess)
close (PMStream -> IO (Either PMError PMSuccess))
-> (PortMidiOutputStream -> PMStream)
-> PortMidiOutputStream
-> IO (Either PMError PMSuccess)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PortMidiOutputStream -> PMStream
unPortMidiOutputStream
    }

-- | Write all events to the 'PortMidiOutputStream'.
writeEventsTo ::
  (MonadIO m) =>
  Cell (PortMidiT m) (PortMidiOutputStream, [PMEvent]) ()
writeEventsTo :: forall (m :: * -> *).
MonadIO m =>
Cell (PortMidiT m) (PortMidiOutputStream, [PMEvent]) ()
writeEventsTo = ((PortMidiOutputStream, [PMEvent]) -> PortMidiT m ())
-> Cell (PortMidiT m) (PortMidiOutputStream, [PMEvent]) ()
forall a (m :: * -> *) b. (a -> m b) -> Cell m a b
arrM (PortMidiOutputStream, [PMEvent]) -> PortMidiT m ()
forall {m :: * -> *}.
MonadIO m =>
(PortMidiOutputStream, [PMEvent]) -> PortMidiT m ()
writer
  where
    writer :: (PortMidiOutputStream, [PMEvent]) -> PortMidiT m ()
writer (PortMidiOutputStream {PMStream
unPortMidiOutputStream :: PortMidiOutputStream -> PMStream
unPortMidiOutputStream :: PMStream
..}, [PMEvent]
events) =
      PMStream -> [PMEvent] -> IO (Either PMError PMSuccess)
writeEvents PMStream
unPortMidiOutputStream [PMEvent]
events
        IO (Either PMError PMSuccess)
-> (IO (Either PMError PMSuccess) -> m (Either PMError PMSuccess))
-> m (Either PMError PMSuccess)
forall a b. a -> (a -> b) -> b
& IO (Either PMError PMSuccess) -> m (Either PMError PMSuccess)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        m (Either PMError PMSuccess)
-> (m (Either PMError PMSuccess) -> PortMidiT m PMSuccess)
-> PortMidiT m PMSuccess
forall a b. a -> (a -> b) -> b
& m (Either PMError PMSuccess) -> PortMidiT m PMSuccess
forall (m :: * -> *) a.
Monad m =>
m (Either PMError a) -> PortMidiT m a
liftPMError
        PortMidiT m PMSuccess
-> (PortMidiT m PMSuccess -> PortMidiT m ()) -> PortMidiT m ()
forall a b. a -> (a -> b) -> b
& PortMidiT m PMSuccess -> PortMidiT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void

{- | 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'.
-}
writeEventsC ::
  (MonadIO m) =>
  String ->
  Cell (PortMidiT m) [PMEvent] ()
writeEventsC :: forall (m :: * -> *).
MonadIO m =>
String -> Cell (PortMidiT m) [PMEvent] ()
writeEventsC String
name = proc [PMEvent]
events -> do
  Either EOLCPortMidiError PortMidiOutputStream
portMidiOutputStreamE <- Cell
  (HandlingStateT m)
  ()
  (Either EOLCPortMidiError PortMidiOutputStream)
-> Cell
     (PortMidiT m) () (Either EOLCPortMidiError PortMidiOutputStream)
forall (m :: * -> *) a b.
Monad m =>
Cell (HandlingStateT m) a b -> Cell (PortMidiT m) a b
liftHandlingState (Cell
   (HandlingStateT m)
   ()
   (Either EOLCPortMidiError PortMidiOutputStream)
 -> Cell
      (PortMidiT m) () (Either EOLCPortMidiError PortMidiOutputStream))
-> Cell
     (HandlingStateT m)
     ()
     (Either EOLCPortMidiError PortMidiOutputStream)
-> Cell
     (PortMidiT m) () (Either EOLCPortMidiError PortMidiOutputStream)
forall a b. (a -> b) -> a -> b
$ Handle m (Either EOLCPortMidiError PortMidiOutputStream)
-> Cell
     (HandlingStateT m)
     ()
     (Either EOLCPortMidiError PortMidiOutputStream)
forall h (m :: * -> *) arbitrary.
(Typeable h, Monad m) =>
Handle m h -> Cell (HandlingStateT m) arbitrary h
handling (String -> Handle m (Either EOLCPortMidiError PortMidiOutputStream)
forall (m :: * -> *).
MonadIO m =>
String -> Handle m (Either EOLCPortMidiError PortMidiOutputStream)
portMidiOutputStreamHandle String
name) -< ()
  PortMidiOutputStream
portMidiOutputStream <- (forall x.
 ExceptT EOLCPortMidiError (HandlingStateT m) x -> PortMidiT m x)
-> Cell
     (ExceptT EOLCPortMidiError (HandlingStateT m))
     (Either EOLCPortMidiError PortMidiOutputStream)
     PortMidiOutputStream
-> Cell
     (PortMidiT m)
     (Either EOLCPortMidiError PortMidiOutputStream)
     PortMidiOutputStream
forall (m1 :: * -> *) (m2 :: * -> *) a b.
(forall x. m1 x -> m2 x) -> Cell m1 a b -> Cell m2 a b
hoistCell ExceptT EOLCPortMidiError (HandlingStateT m) x -> PortMidiT m x
forall x.
ExceptT EOLCPortMidiError (HandlingStateT m) x -> PortMidiT m x
forall (m :: * -> *) a.
ExceptT EOLCPortMidiError (HandlingStateT m) a -> PortMidiT m a
PortMidiT Cell
  (ExceptT EOLCPortMidiError (HandlingStateT m))
  (Either EOLCPortMidiError PortMidiOutputStream)
  PortMidiOutputStream
forall (m :: * -> *) e a.
Monad m =>
Cell (ExceptT e m) (Either e a) a
exceptC -< Either EOLCPortMidiError PortMidiOutputStream
portMidiOutputStreamE
  Cell (PortMidiT m) (PortMidiOutputStream, [PMEvent]) ()
forall (m :: * -> *).
MonadIO m =>
Cell (PortMidiT m) (PortMidiOutputStream, [PMEvent]) ()
writeEventsTo -< (PortMidiOutputStream
portMidiOutputStream, [PMEvent]
events)

-- | All devices that the PortMidi backend has connected.
data PortMidiDevices = PortMidiDevices
  { PortMidiDevices -> [DeviceInfo]
inputDevices :: [DeviceInfo]
  , PortMidiDevices -> [DeviceInfo]
outputDevices :: [DeviceInfo]
  }

-- | Retrieve all PortMidi devices.
getPortMidiDevices :: IO PortMidiDevices
getPortMidiDevices :: IO PortMidiDevices
getPortMidiDevices = do
  DeviceID
nDevices <- IO DeviceID
countDevices
  [DeviceInfo]
devices <- (DeviceID -> IO DeviceInfo) -> [DeviceID] -> IO [DeviceInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM DeviceID -> IO DeviceInfo
getDeviceInfo [DeviceID
0 .. DeviceID
nDevices DeviceID -> DeviceID -> DeviceID
forall a. Num a => a -> a -> a
- DeviceID
1]
  PortMidiDevices -> IO PortMidiDevices
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    PortMidiDevices
      { inputDevices :: [DeviceInfo]
inputDevices = (DeviceInfo -> Bool) -> [DeviceInfo] -> [DeviceInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter DeviceInfo -> Bool
input [DeviceInfo]
devices
      , outputDevices :: [DeviceInfo]
outputDevices = (DeviceInfo -> Bool) -> [DeviceInfo] -> [DeviceInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter DeviceInfo -> Bool
output [DeviceInfo]
devices
      }

-- | Print input and output devices separately, one device per line.
prettyPrintPortMidiDevices :: PortMidiDevices -> IO ()
prettyPrintPortMidiDevices :: PortMidiDevices -> IO ()
prettyPrintPortMidiDevices PortMidiDevices {[DeviceInfo]
inputDevices :: PortMidiDevices -> [DeviceInfo]
outputDevices :: PortMidiDevices -> [DeviceInfo]
inputDevices :: [DeviceInfo]
outputDevices :: [DeviceInfo]
..} = do
  String -> IO ()
putStrLn String
"\nPortMidi input devices:"
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ DeviceInfo -> String
printName (DeviceInfo -> String) -> [DeviceInfo] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DeviceInfo]
inputDevices
  String -> IO ()
putStrLn String
"\nPortMidi output devices:"
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ DeviceInfo -> String
printName (DeviceInfo -> String) -> [DeviceInfo] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DeviceInfo]
outputDevices
  where
    printName :: DeviceInfo -> String
printName DeviceInfo
dev = String
"- \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ DeviceInfo -> String
name DeviceInfo
dev String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""