{-# 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 (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)
import Control.Monad.Trans.Class
import Sound.PortMidi
import LiveCoding
import LiveCoding.PortMidi.Internal
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 -> 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
<$ :: forall a b. a -> PortMidiT m b -> PortMidiT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> PortMidiT m b -> PortMidiT m a
fmap :: forall a b. (a -> b) -> PortMidiT m a -> PortMidiT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> PortMidiT m a -> PortMidiT m b
Functor, 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
<* :: forall a b. 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
*> :: 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 b
liftA2 :: forall a b c.
(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
<*> :: forall a b. 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 :: forall a. a -> PortMidiT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> PortMidiT m a
Applicative, 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 :: forall a. a -> PortMidiT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> PortMidiT m a
>> :: 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 b
>>= :: forall a 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
Monad, 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 :: forall a. IO a -> PortMidiT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> PortMidiT m a
MonadIO)
instance MonadTrans PortMidiT where
lift :: forall (m :: * -> *) a. Monad m => m a -> PortMidiT m a
lift = forall (m :: * -> *) a.
ExceptT EOLCPortMidiError (HandlingStateT m) a -> PortMidiT m a
PortMidiT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
EOLCPortMidiError -> DataType
EOLCPortMidiError -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(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 :: forall u.
DeviceID -> (forall d. Data d => d -> u) -> EOLCPortMidiError -> u
$cgmapQi :: forall u.
DeviceID -> (forall d. Data d => d -> u) -> EOLCPortMidiError -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> EOLCPortMidiError -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EOLCPortMidiError -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, 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, DeviceID -> EOLCPortMidiError -> ShowS
[EOLCPortMidiError] -> ShowS
EOLCPortMidiError -> String
forall a.
(DeviceID -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EOLCPortMidiError] -> ShowS
$cshowList :: [EOLCPortMidiError] -> ShowS
show :: EOLCPortMidiError -> String
$cshow :: EOLCPortMidiError -> String
showsPrec :: DeviceID -> EOLCPortMidiError -> ShowS
$cshowsPrec :: DeviceID -> 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 :: forall (m :: * -> *) arbitrary.
Monad m =>
EOLCPortMidiError -> PortMidiT m arbitrary
throwPortMidi = forall (m :: * -> *) a.
ExceptT EOLCPortMidiError (HandlingStateT m) a -> PortMidiT m a
PortMidiT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE
throwPortMidiC :: Monad m => Cell (PortMidiT m) EOLCPortMidiError arbitrary
throwPortMidiC :: forall (m :: * -> *) arbitrary.
Monad m =>
Cell (PortMidiT m) EOLCPortMidiError arbitrary
throwPortMidiC = forall a (m :: * -> *) b. (a -> m b) -> Cell m a b
arrM forall (m :: * -> *) arbitrary.
Monad m =>
EOLCPortMidiError -> PortMidiT m arbitrary
throwPortMidi
liftPMError :: Monad m => m (Either PMError a) -> PortMidiT m a
liftPMError :: forall (m :: * -> *) a.
Monad m =>
m (Either PMError a) -> PortMidiT m a
liftPMError = forall (m :: * -> *) a.
ExceptT EOLCPortMidiError (HandlingStateT m) a -> PortMidiT m a
PortMidiT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left PMError -> EOLCPortMidiError
PMError) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) a b.
Monad m =>
Cell (HandlingStateT m) a b -> Cell (PortMidiT m) a b
liftHandlingState = forall (m1 :: * -> *) (m2 :: * -> *) a b.
(forall x. m1 x -> m2 x) -> Cell m1 a b -> Cell m2 a b
hoistCell forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
ExceptT EOLCPortMidiError (HandlingStateT m) a -> PortMidiT m a
PortMidiT forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) a b.
MonadIO m =>
Cell (PortMidiT m) a b
-> CellExcept a b (HandlingStateT m) EOLCPortMidiError
runPortMidiC Cell (PortMidiT m) a b
cell = forall e (m :: * -> *) a b.
(Data e, Finite e) =>
Cell (ExceptT e m) a b -> CellExcept a b m e
try forall a b. (a -> b) -> a -> b
$ proc a
a -> do
PortMidiHandle
_ <- forall (m :: * -> *) (t :: (* -> *) -> * -> *) a b.
(Monad m, MonadTrans t) =>
Cell m a b -> Cell (t m) a b
liftCell forall a b. (a -> b) -> a -> b
$ forall h (m :: * -> *) arbitrary.
(Typeable h, Monad m) =>
Handle m h -> Cell (HandlingStateT m) arbitrary h
handling forall (m :: * -> *). MonadIO m => Handle m PortMidiHandle
portMidiHandle -< ()
forall (m1 :: * -> *) (m2 :: * -> *) a b.
(forall x. m1 x -> m2 x) -> Cell m1 a b -> Cell m2 a b
hoistCell 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 :: forall (m :: * -> *) a b.
MonadIO m =>
Cell (PortMidiT m) a b -> Cell (HandlingStateT m) a b
loopPortMidiC Cell (PortMidiT m) a b
cell = forall e (m :: * -> *) a b.
(Data e, Monad m) =>
Cell (ExceptT e m) a b -> Cell m a b
foreverC forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b e.
Monad m =>
CellExcept a b m e -> Cell (ExceptT e m) a b
runCellExcept forall a b. (a -> b) -> a -> b
$ do
EOLCPortMidiError
e <- forall (m :: * -> *) a b.
MonadIO m =>
Cell (PortMidiT m) a b
-> CellExcept a b (HandlingStateT m) EOLCPortMidiError
runPortMidiC Cell (PortMidiT m) a b
cell
forall (m :: * -> *) e a arbitrary.
(Monad m, Data e, Finite e) =>
m e -> CellExcept a arbitrary m e
once_ forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
putStrLn String
"Encountered PortMidi exception:"
forall a. Show a => a -> IO ()
print EOLCPortMidiError
e
DeviceID -> IO ()
threadDelay DeviceID
1000
forall (m :: * -> *) a. Monad m => a -> m a
return EOLCPortMidiError
e
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 :: ExceptT EOLCPortMidiError (HandlingStateT m) a
unPortMidiT :: forall (m :: * -> *) a.
PortMidiT m a -> ExceptT EOLCPortMidiError (HandlingStateT m) 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 :: forall (m :: * -> *).
MonadIO m =>
String -> DeviceDirection -> m (Either EOLCPortMidiError DeviceID)
lookupDeviceID String
nameLookingFor DeviceDirection
inputOrOutput = do
DeviceID
nDevices <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO DeviceID
countDevices
[(DeviceInfo, DeviceID)]
devices <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [DeviceID
0 .. DeviceID
nDevices forall a. Num a => a -> a -> a
- DeviceID
1] forall a b. (a -> b) -> a -> b
$ \DeviceID
deviceID -> do
DeviceInfo
deviceInfo <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DeviceID -> IO DeviceInfo
getDeviceInfo DeviceID
deviceID
forall (m :: * -> *) a. Monad m => a -> m a
return (DeviceInfo
deviceInfo, DeviceID
deviceID)
let allDevicesWithName :: [(DeviceInfo, DeviceID)]
allDevicesWithName = forall a. (a -> Bool) -> [a] -> [a]
filter ((String
nameLookingFor forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeviceInfo -> String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(DeviceInfo, DeviceID)]
devices
inputDevices :: [(DeviceInfo, DeviceID)]
inputDevices = forall a. (a -> Bool) -> [a] -> [a]
filter (DeviceInfo -> Bool
input forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(DeviceInfo, DeviceID)]
allDevicesWithName
outputDevices :: [(DeviceInfo, DeviceID)]
outputDevices = forall a. (a -> Bool) -> [a] -> [a]
filter (DeviceInfo -> Bool
output forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(DeviceInfo, DeviceID)]
allDevicesWithName
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case (DeviceDirection
inputOrOutput, [(DeviceInfo, DeviceID)]
inputDevices, [(DeviceInfo, DeviceID)]
outputDevices) of
(DeviceDirection
_, [], []) -> forall a b. a -> Either a b
Left EOLCPortMidiError
NoSuchDevice
(DeviceDirection
Input, [], (DeviceInfo, DeviceID)
_ : [(DeviceInfo, DeviceID)]
_) -> forall a b. a -> Either a b
Left EOLCPortMidiError
NotAnInputDevice
(DeviceDirection
Output, (DeviceInfo, DeviceID)
_ : [(DeviceInfo, DeviceID)]
_, []) -> forall a b. a -> Either a b
Left EOLCPortMidiError
NotAnOutputDevice
(DeviceDirection
Input, [(DeviceInfo
_, DeviceID
deviceID)], [(DeviceInfo, DeviceID)]
_) -> forall a b. b -> Either a b
Right DeviceID
deviceID
(DeviceDirection
Output, [(DeviceInfo, DeviceID)]
_, [(DeviceInfo
_, DeviceID
deviceID)]) -> forall a b. b -> Either a b
Right DeviceID
deviceID
(DeviceDirection, [(DeviceInfo, DeviceID)],
[(DeviceInfo, DeviceID)])
_ -> forall a b. a -> Either a b
Left EOLCPortMidiError
MultipleDevices
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 = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
DeviceID
deviceID <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
String -> DeviceDirection -> m (Either EOLCPortMidiError DeviceID)
lookupDeviceID String
name DeviceDirection
Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PMStream -> PortMidiInputStream
PortMidiInputStream forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT PMError -> EOLCPortMidiError
PMError forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DeviceID -> IO (Either PMError PMStream)
openInput DeviceID
deviceID
,
destroy :: Either EOLCPortMidiError PortMidiInputStream -> m ()
destroy = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. PMStream -> IO (Either PMError PMSuccess)
close forall b c a. (b -> c) -> (a -> b) -> a -> c
. PortMidiInputStream -> PMStream
unPortMidiInputStream
}
readEventsFrom ::
MonadIO m =>
Cell (PortMidiT m) PortMidiInputStream [PMEvent]
readEventsFrom :: forall (m :: * -> *).
MonadIO m =>
Cell (PortMidiT m) PortMidiInputStream [PMEvent]
readEventsFrom = forall a (m :: * -> *) b. (a -> m b) -> Cell m a b
arrM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
m (Either PMError a) -> PortMidiT m a
liftPMError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. PMStream -> IO (Either PMError [PMEvent])
readEvents forall b c a. (b -> c) -> (a -> b) -> a -> c
. PortMidiInputStream -> PMStream
unPortMidiInputStream
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 <- forall (m :: * -> *) a b.
Monad m =>
Cell (HandlingStateT m) a b -> Cell (PortMidiT m) a b
liftHandlingState forall a b. (a -> b) -> a -> b
$ forall h (m :: * -> *) arbitrary.
(Typeable h, Monad m) =>
Handle m h -> Cell (HandlingStateT m) arbitrary h
handling forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
String -> Handle m (Either EOLCPortMidiError PortMidiInputStream)
portMidiInputStreamHandle String
name -< ()
PortMidiInputStream
pmStream <- forall (m1 :: * -> *) (m2 :: * -> *) a b.
(forall x. m1 x -> m2 x) -> Cell m1 a b -> Cell m2 a b
hoistCell forall (m :: * -> *) a.
ExceptT EOLCPortMidiError (HandlingStateT m) a -> PortMidiT m a
PortMidiT forall (m :: * -> *) e a.
Monad m =>
Cell (ExceptT e m) (Either e a) a
exceptC -< Either EOLCPortMidiError PortMidiInputStream
pmStreamE
forall (m :: * -> *).
MonadIO m =>
Cell (PortMidiT m) PortMidiInputStream [PMEvent]
readEventsFrom -< PortMidiInputStream
pmStream
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 = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
DeviceID
deviceID <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
String -> DeviceDirection -> m (Either EOLCPortMidiError DeviceID)
lookupDeviceID String
name DeviceDirection
Output
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PMStream -> PortMidiOutputStream
PortMidiOutputStream forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT PMError -> EOLCPortMidiError
PMError forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ DeviceID -> DeviceID -> IO (Either PMError PMStream)
openOutput DeviceID
deviceID DeviceID
0
, destroy :: Either EOLCPortMidiError PortMidiOutputStream -> m ()
destroy = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. PMStream -> IO (Either PMError PMSuccess)
close forall b c a. (b -> c) -> (a -> b) -> a -> c
. PortMidiOutputStream -> PMStream
unPortMidiOutputStream
}
writeEventsTo ::
MonadIO m =>
Cell (PortMidiT m) (PortMidiOutputStream, [PMEvent]) ()
writeEventsTo :: forall (m :: * -> *).
MonadIO m =>
Cell (PortMidiT m) (PortMidiOutputStream, [PMEvent]) ()
writeEventsTo = forall a (m :: * -> *) b. (a -> m b) -> Cell m a b
arrM 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
forall a b. a -> (a -> b) -> b
& forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
forall a b. a -> (a -> b) -> b
& forall (m :: * -> *) a.
Monad m =>
m (Either PMError a) -> PortMidiT m a
liftPMError
forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a. Functor f => f a -> f ()
void
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 <- forall (m :: * -> *) a b.
Monad m =>
Cell (HandlingStateT m) a b -> Cell (PortMidiT m) a b
liftHandlingState forall a b. (a -> b) -> a -> b
$ forall h (m :: * -> *) arbitrary.
(Typeable h, Monad m) =>
Handle m h -> Cell (HandlingStateT m) arbitrary h
handling (forall (m :: * -> *).
MonadIO m =>
String -> Handle m (Either EOLCPortMidiError PortMidiOutputStream)
portMidiOutputStreamHandle String
name) -< ()
PortMidiOutputStream
portMidiOutputStream <- forall (m1 :: * -> *) (m2 :: * -> *) a b.
(forall x. m1 x -> m2 x) -> Cell m1 a b -> Cell m2 a b
hoistCell forall (m :: * -> *) a.
ExceptT EOLCPortMidiError (HandlingStateT m) a -> PortMidiT m a
PortMidiT forall (m :: * -> *) e a.
Monad m =>
Cell (ExceptT e m) (Either e a) a
exceptC -< Either EOLCPortMidiError PortMidiOutputStream
portMidiOutputStreamE
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
DeviceID
nDevices <- IO DeviceID
countDevices
[DeviceInfo]
devices <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM DeviceID -> IO DeviceInfo
getDeviceInfo [DeviceID
0 .. DeviceID
nDevices forall a. Num a => a -> a -> a
- DeviceID
1]
forall (m :: * -> *) a. Monad m => a -> m a
return
PortMidiDevices
{ inputDevices :: [DeviceInfo]
inputDevices = forall a. (a -> Bool) -> [a] -> [a]
filter DeviceInfo -> Bool
input [DeviceInfo]
devices
, outputDevices :: [DeviceInfo]
outputDevices = 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 forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ DeviceInfo -> String
printName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DeviceInfo]
inputDevices
String -> IO ()
putStrLn String
"\nPortMidi output devices:"
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ DeviceInfo -> String
printName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DeviceInfo]
outputDevices
where
printName :: DeviceInfo -> String
printName DeviceInfo
dev = String
"- \"" forall a. [a] -> [a] -> [a]
++ DeviceInfo -> String
name DeviceInfo
dev forall a. [a] -> [a] -> [a]
++ String
"\""