{-# LANGUAGE Arrows #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
module LiveCoding.PortMidi where
import Control.Concurrent (threadDelay)
import Control.Monad (void, forM, join)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Either (fromRight)
import Data.Foldable (traverse_, find)
import Data.Function ((&))
import Data.Maybe (catMaybes)
import GHC.Generics
import GHC.TypeLits (Symbol, symbolVal, KnownSymbol)
import Control.Monad.Trans.Class
import Sound.PortMidi
import LiveCoding
import LiveCoding.PortMidi.Internal
newtype PortMidiT m a = PortMidiT
{ PortMidiT m a -> ExceptT EOLCPortMidiError (HandlingStateT m) a
unPortMidiT :: ExceptT EOLCPortMidiError (HandlingStateT m) a }
deriving (a -> PortMidiT m b -> PortMidiT m a
(a -> b) -> PortMidiT m a -> PortMidiT m b
(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
<$ :: a -> PortMidiT m b -> PortMidiT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> PortMidiT m b -> PortMidiT m a
fmap :: (a -> b) -> PortMidiT m a -> PortMidiT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> PortMidiT m a -> PortMidiT m b
Functor, Functor (PortMidiT m)
a -> PortMidiT m a
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)
PortMidiT m a -> PortMidiT m b -> PortMidiT m b
PortMidiT m a -> PortMidiT m b -> PortMidiT m a
PortMidiT m (a -> b) -> PortMidiT m a -> PortMidiT m b
(a -> b -> c) -> PortMidiT m a -> PortMidiT m b -> PortMidiT m c
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
<* :: PortMidiT m a -> PortMidiT m b -> PortMidiT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
PortMidiT m a -> PortMidiT m b -> PortMidiT m a
*> :: PortMidiT m a -> PortMidiT m b -> PortMidiT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
PortMidiT m a -> PortMidiT m b -> PortMidiT m b
liftA2 :: (a -> b -> c) -> PortMidiT m a -> PortMidiT m b -> PortMidiT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> PortMidiT m a -> PortMidiT m b -> PortMidiT m c
<*> :: PortMidiT m (a -> b) -> PortMidiT m a -> PortMidiT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
PortMidiT m (a -> b) -> PortMidiT m a -> PortMidiT m b
pure :: a -> PortMidiT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> PortMidiT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (PortMidiT m)
Applicative, Applicative (PortMidiT m)
a -> PortMidiT m a
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)
PortMidiT m a -> (a -> PortMidiT m b) -> PortMidiT m b
PortMidiT m a -> PortMidiT m b -> PortMidiT m b
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
return :: a -> PortMidiT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> PortMidiT m a
>> :: PortMidiT m a -> PortMidiT m b -> PortMidiT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
PortMidiT m a -> PortMidiT m b -> PortMidiT m b
>>= :: PortMidiT m a -> (a -> PortMidiT m b) -> PortMidiT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
PortMidiT m a -> (a -> PortMidiT m b) -> PortMidiT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (PortMidiT m)
Monad, Monad (PortMidiT m)
Monad (PortMidiT m)
-> (forall a. IO a -> PortMidiT m a) -> MonadIO (PortMidiT m)
IO a -> PortMidiT m a
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
liftIO :: IO a -> PortMidiT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> PortMidiT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (PortMidiT m)
MonadIO)
instance MonadTrans PortMidiT where
lift :: 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
. StateT (HandlingState m) m a
-> ExceptT EOLCPortMidiError (HandlingStateT m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (HandlingState m) m a
-> ExceptT EOLCPortMidiError (HandlingStateT m) a)
-> (m a -> StateT (HandlingState m) m a)
-> m a
-> ExceptT EOLCPortMidiError (HandlingStateT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT (HandlingState m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
data EOLCPortMidiError
= PMError PMError
| NoSuchDevice
| NotAnInputDevice
| NotAnOutputDevice
| MultipleDevices
deriving (Typeable EOLCPortMidiError
DataType
Constr
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.
Int -> (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 -> DataType
EOLCPortMidiError -> Constr
(forall b. Data b => b -> b)
-> EOLCPortMidiError -> EOLCPortMidiError
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EOLCPortMidiError -> c EOLCPortMidiError
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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. Int -> (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.
Int -> (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)
$cMultipleDevices :: Constr
$cNotAnOutputDevice :: Constr
$cNotAnInputDevice :: Constr
$cNoSuchDevice :: Constr
$cPMError :: Constr
$tEOLCPortMidiError :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d)
-> EOLCPortMidiError -> m EOLCPortMidiError
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> EOLCPortMidiError -> m EOLCPortMidiError
gmapQi :: Int -> (forall d. Data d => d -> u) -> EOLCPortMidiError -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> EOLCPortMidiError -> u
gmapQ :: (forall d. Data d => d -> u) -> EOLCPortMidiError -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EOLCPortMidiError -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EOLCPortMidiError -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EOLCPortMidiError -> r
gmapT :: (forall b. Data b => b -> b)
-> EOLCPortMidiError -> EOLCPortMidiError
$cgmapT :: (forall b. Data b => b -> b)
-> EOLCPortMidiError -> EOLCPortMidiError
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EOLCPortMidiError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EOLCPortMidiError)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c EOLCPortMidiError)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EOLCPortMidiError)
dataTypeOf :: EOLCPortMidiError -> DataType
$cdataTypeOf :: EOLCPortMidiError -> DataType
toConstr :: EOLCPortMidiError -> Constr
$ctoConstr :: EOLCPortMidiError -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EOLCPortMidiError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EOLCPortMidiError
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EOLCPortMidiError -> c EOLCPortMidiError
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EOLCPortMidiError -> c EOLCPortMidiError
$cp1Data :: Typeable 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
$cto :: forall x. Rep EOLCPortMidiError x -> EOLCPortMidiError
$cfrom :: forall x. EOLCPortMidiError -> Rep EOLCPortMidiError x
Generic, Int -> EOLCPortMidiError -> ShowS
[EOLCPortMidiError] -> ShowS
EOLCPortMidiError -> String
(Int -> EOLCPortMidiError -> ShowS)
-> (EOLCPortMidiError -> String)
-> ([EOLCPortMidiError] -> ShowS)
-> Show EOLCPortMidiError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EOLCPortMidiError] -> ShowS
$cshowList :: [EOLCPortMidiError] -> ShowS
show :: EOLCPortMidiError -> String
$cshow :: EOLCPortMidiError -> String
showsPrec :: Int -> EOLCPortMidiError -> ShowS
$cshowsPrec :: Int -> EOLCPortMidiError -> ShowS
Show)
instance Finite EOLCPortMidiError
deriving instance Data PMError
deriving instance Generic PMError
instance Finite PMError
throwPortMidi :: Monad m => EOLCPortMidiError -> PortMidiT m arbitrary
throwPortMidi :: 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
throwPortMidiC :: Monad m => Cell (PortMidiT m) EOLCPortMidiError arbitrary
throwPortMidiC :: 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
liftPMError :: Monad m => m (Either PMError a) -> PortMidiT m a
liftPMError :: m (Either PMError a) -> PortMidiT m a
liftPMError = 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 (Either PMError a)
-> ExceptT EOLCPortMidiError (HandlingStateT m) a)
-> m (Either PMError a)
-> PortMidiT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT (HandlingState m) m (Either EOLCPortMidiError a)
-> ExceptT EOLCPortMidiError (HandlingStateT m) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (StateT (HandlingState m) m (Either EOLCPortMidiError a)
-> ExceptT EOLCPortMidiError (HandlingStateT m) a)
-> (m (Either PMError a)
-> StateT (HandlingState m) m (Either EOLCPortMidiError a))
-> m (Either PMError a)
-> ExceptT EOLCPortMidiError (HandlingStateT 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)
-> StateT (HandlingState m) m (Either EOLCPortMidiError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PMError -> EOLCPortMidiError)
-> Either PMError a -> Either EOLCPortMidiError a
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)
-> StateT (HandlingState m) m (Either EOLCPortMidiError a))
-> (m (Either PMError a)
-> StateT (HandlingState m) m (Either PMError a))
-> m (Either PMError a)
-> StateT (HandlingState m) 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 (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
liftHandlingState :: Monad m => Cell (HandlingStateT m) a b -> Cell (PortMidiT m) a b
liftHandlingState :: 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 (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
runPortMidiC :: MonadIO m => Cell (PortMidiT m) a b -> CellExcept a b (HandlingStateT m) EOLCPortMidiError
runPortMidiC :: 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 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
loopPortMidiC :: MonadIO m => Cell (PortMidiT m) a b -> Cell (HandlingStateT m) a b
loopPortMidiC :: 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 (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
Int -> IO ()
threadDelay Int
1000
EOLCPortMidiError
-> CellExcept a b (HandlingStateT m) EOLCPortMidiError
forall (m :: * -> *) a. Monad m => a -> m a
return EOLCPortMidiError
e
runPortMidiT :: PortMidiT m a -> HandlingStateT m (Either EOLCPortMidiError a)
runPortMidiT :: PortMidiT m a -> HandlingStateT m (Either EOLCPortMidiError a)
runPortMidiT PortMidiT { ExceptT EOLCPortMidiError (HandlingStateT m) a
unPortMidiT :: ExceptT EOLCPortMidiError (HandlingStateT m) a
unPortMidiT :: forall (m :: * -> *) a.
PortMidiT m a -> ExceptT EOLCPortMidiError (HandlingStateT m) a
.. } = ExceptT EOLCPortMidiError (HandlingStateT m) a
-> HandlingStateT m (Either EOLCPortMidiError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT EOLCPortMidiError (HandlingStateT m) a
unPortMidiT
newtype PortMidiInputStream = PortMidiInputStream { PortMidiInputStream -> PMStream
unPortMidiInputStream :: PMStream }
newtype PortMidiOutputStream = PortMidiOutputStream { PortMidiOutputStream -> PMStream
unPortMidiOutputStream :: PMStream }
data DeviceDirection = Input | Output
lookupDeviceID
:: MonadIO m
=> String
-> DeviceDirection
-> m (Either EOLCPortMidiError DeviceID)
lookupDeviceID :: String -> DeviceDirection -> m (Either EOLCPortMidiError Int)
lookupDeviceID String
nameLookingFor DeviceDirection
inputOrOutput = do
Int
nDevices <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Int
countDevices
[(DeviceInfo, Int)]
devices <- [Int] -> (Int -> m (DeviceInfo, Int)) -> m [(DeviceInfo, Int)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..Int
nDevicesInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> m (DeviceInfo, Int)) -> m [(DeviceInfo, Int)])
-> (Int -> m (DeviceInfo, Int)) -> m [(DeviceInfo, Int)]
forall a b. (a -> b) -> a -> b
$ \Int
deviceID -> do
DeviceInfo
deviceInfo <- IO DeviceInfo -> m DeviceInfo
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
$ Int -> IO DeviceInfo
getDeviceInfo Int
deviceID
(DeviceInfo, Int) -> m (DeviceInfo, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (DeviceInfo
deviceInfo, Int
deviceID)
let allDevicesWithName :: [(DeviceInfo, Int)]
allDevicesWithName = ((DeviceInfo, Int) -> Bool)
-> [(DeviceInfo, Int)] -> [(DeviceInfo, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String
nameLookingFor String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool)
-> ((DeviceInfo, Int) -> String) -> (DeviceInfo, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeviceInfo -> String
name (DeviceInfo -> String)
-> ((DeviceInfo, Int) -> DeviceInfo) -> (DeviceInfo, Int) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeviceInfo, Int) -> DeviceInfo
forall a b. (a, b) -> a
fst) [(DeviceInfo, Int)]
devices
inputDevices :: [(DeviceInfo, Int)]
inputDevices = ((DeviceInfo, Int) -> Bool)
-> [(DeviceInfo, Int)] -> [(DeviceInfo, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DeviceInfo -> Bool
input (DeviceInfo -> Bool)
-> ((DeviceInfo, Int) -> DeviceInfo) -> (DeviceInfo, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeviceInfo, Int) -> DeviceInfo
forall a b. (a, b) -> a
fst) [(DeviceInfo, Int)]
allDevicesWithName
outputDevices :: [(DeviceInfo, Int)]
outputDevices = ((DeviceInfo, Int) -> Bool)
-> [(DeviceInfo, Int)] -> [(DeviceInfo, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DeviceInfo -> Bool
output (DeviceInfo -> Bool)
-> ((DeviceInfo, Int) -> DeviceInfo) -> (DeviceInfo, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DeviceInfo, Int) -> DeviceInfo
forall a b. (a, b) -> a
fst) [(DeviceInfo, Int)]
allDevicesWithName
Either EOLCPortMidiError Int -> m (Either EOLCPortMidiError Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either EOLCPortMidiError Int -> m (Either EOLCPortMidiError Int))
-> Either EOLCPortMidiError Int -> m (Either EOLCPortMidiError Int)
forall a b. (a -> b) -> a -> b
$ case (DeviceDirection
inputOrOutput, [(DeviceInfo, Int)]
inputDevices, [(DeviceInfo, Int)]
outputDevices) of
(DeviceDirection
_, [], []) -> EOLCPortMidiError -> Either EOLCPortMidiError Int
forall a b. a -> Either a b
Left EOLCPortMidiError
NoSuchDevice
(DeviceDirection
Input, [], (DeviceInfo, Int)
_ : [(DeviceInfo, Int)]
_) -> EOLCPortMidiError -> Either EOLCPortMidiError Int
forall a b. a -> Either a b
Left EOLCPortMidiError
NotAnInputDevice
(DeviceDirection
Output, (DeviceInfo, Int)
_ : [(DeviceInfo, Int)]
_, []) -> EOLCPortMidiError -> Either EOLCPortMidiError Int
forall a b. a -> Either a b
Left EOLCPortMidiError
NotAnOutputDevice
(DeviceDirection
Input, [(DeviceInfo
_, Int
deviceID)], [(DeviceInfo, Int)]
_) -> Int -> Either EOLCPortMidiError Int
forall a b. b -> Either a b
Right Int
deviceID
(DeviceDirection
Output, [(DeviceInfo, Int)]
_, [(DeviceInfo
_, Int
deviceID)]) -> Int -> Either EOLCPortMidiError Int
forall a b. b -> Either a b
Right Int
deviceID
(DeviceDirection, [(DeviceInfo, Int)], [(DeviceInfo, Int)])
_ -> EOLCPortMidiError -> Either EOLCPortMidiError Int
forall a b. a -> Either a b
Left EOLCPortMidiError
MultipleDevices
portMidiInputStreamHandle
:: MonadIO m
=> String
-> Handle m (Either EOLCPortMidiError PortMidiInputStream)
portMidiInputStreamHandle :: String -> Handle m (Either EOLCPortMidiError PortMidiInputStream)
portMidiInputStreamHandle String
name = Handle :: forall (m :: * -> *) h. m h -> (h -> m ()) -> Handle m h
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
Int
deviceID <- m (Either EOLCPortMidiError Int) -> ExceptT EOLCPortMidiError m Int
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either EOLCPortMidiError Int)
-> ExceptT EOLCPortMidiError m Int)
-> m (Either EOLCPortMidiError Int)
-> ExceptT EOLCPortMidiError m Int
forall a b. (a -> b) -> a -> b
$ String -> DeviceDirection -> m (Either EOLCPortMidiError Int)
forall (m :: * -> *).
MonadIO m =>
String -> DeviceDirection -> m (Either EOLCPortMidiError Int)
lookupDeviceID String
name DeviceDirection
Input
(PMStream -> PortMidiInputStream)
-> ExceptT EOLCPortMidiError m PMStream
-> ExceptT EOLCPortMidiError m PortMidiInputStream
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 (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
$ Int -> IO (Either PMError PMStream)
openInput Int
deviceID
, 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 (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 (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
}
readEventsFrom
:: MonadIO m
=> Cell (PortMidiT m) PortMidiInputStream [PMEvent]
readEventsFrom :: 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 (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
readEventsC
:: MonadIO m
=> String -> Cell (PortMidiT m) arbitrary [PMEvent]
readEventsC :: 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 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
portMidiOutputStreamHandle
:: MonadIO m
=> String
-> Handle m (Either EOLCPortMidiError PortMidiOutputStream)
portMidiOutputStreamHandle :: String -> Handle m (Either EOLCPortMidiError PortMidiOutputStream)
portMidiOutputStreamHandle String
name = Handle :: forall (m :: * -> *) h. m h -> (h -> m ()) -> Handle m h
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
Int
deviceID <- m (Either EOLCPortMidiError Int) -> ExceptT EOLCPortMidiError m Int
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either EOLCPortMidiError Int)
-> ExceptT EOLCPortMidiError m Int)
-> m (Either EOLCPortMidiError Int)
-> ExceptT EOLCPortMidiError m Int
forall a b. (a -> b) -> a -> b
$ String -> DeviceDirection -> m (Either EOLCPortMidiError Int)
forall (m :: * -> *).
MonadIO m =>
String -> DeviceDirection -> m (Either EOLCPortMidiError Int)
lookupDeviceID String
name DeviceDirection
Output
(PMStream -> PortMidiOutputStream)
-> ExceptT EOLCPortMidiError m PMStream
-> ExceptT EOLCPortMidiError m PortMidiOutputStream
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 (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
$ Int -> Int -> IO (Either PMError PMStream)
openOutput Int
deviceID Int
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 (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 (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
}
writeEventsTo
:: MonadIO m
=> Cell (PortMidiT m) (PortMidiOutputStream, [PMEvent]) ()
writeEventsTo :: 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 :: PMStream
unPortMidiOutputStream :: PortMidiOutputStream -> 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 (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
writeEventsC
:: MonadIO m
=> String
-> Cell (PortMidiT m) [PMEvent] ()
writeEventsC :: 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 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)
data PortMidiDevices = PortMidiDevices
{ PortMidiDevices -> [DeviceInfo]
inputDevices :: [DeviceInfo]
, PortMidiDevices -> [DeviceInfo]
outputDevices :: [DeviceInfo]
}
getPortMidiDevices :: IO PortMidiDevices
getPortMidiDevices :: IO PortMidiDevices
getPortMidiDevices = do
Int
nDevices <- IO Int
countDevices
[DeviceInfo]
devices <- (Int -> IO DeviceInfo) -> [Int] -> IO [DeviceInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> IO DeviceInfo
getDeviceInfo [Int
0..Int
nDevicesInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
PortMidiDevices -> IO PortMidiDevices
forall (m :: * -> *) a. Monad m => a -> m a
return PortMidiDevices :: [DeviceInfo] -> [DeviceInfo] -> PortMidiDevices
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
}
prettyPrintPortMidiDevices :: PortMidiDevices -> IO ()
prettyPrintPortMidiDevices :: PortMidiDevices -> IO ()
prettyPrintPortMidiDevices PortMidiDevices { [DeviceInfo]
outputDevices :: [DeviceInfo]
inputDevices :: [DeviceInfo]
outputDevices :: PortMidiDevices -> [DeviceInfo]
inputDevices :: PortMidiDevices -> [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
"\""