diff --git a/alsa-seq.cabal b/alsa-seq.cabal --- a/alsa-seq.cabal +++ b/alsa-seq.cabal @@ -1,5 +1,5 @@ Name: alsa-seq -Version: 0.6.0.3 +Version: 0.6.0.4 Author: Henning Thielemann , Dylan Simon , @@ -13,7 +13,7 @@ Homepage: http://www.haskell.org/haskellwiki/ALSA Stability: Experimental Build-Type: Simple -Cabal-Version: >= 1.8 +Cabal-Version: >= 1.14 Synopsis: Binding to the ALSA Library API (MIDI sequencer). Description: This package provides access to ALSA sequencer (MIDI support). @@ -31,7 +31,7 @@ location: http://code.haskell.org/alsa/seq/ Source-Repository this - tag: 0.6.0.3 + tag: 0.6.0.4 type: darcs location: http://code.haskell.org/alsa/seq/ @@ -57,10 +57,7 @@ base >=3 && <5 GHC-Options: -Wall - Extensions: - ForeignFunctionInterface - GeneralizedNewtypeDeriving - EmptyDataDecls + Default-Language: Haskell2010 Hs-Source-Dirs: src Include-Dirs: src @@ -115,323 +112,125 @@ Sound.ALSA.Sequencer.Sequencer Sound.ALSA.Sequencer.Utility - Includes: alsa/asoundlib.h - Executable alsa-seq-dump Main-Is: dump.hs - If !flag(buildExamples) - Buildable: False - Hs-Source-Dirs: src, examples - Include-Dirs: src - If flag(modifyFilter) - Hs-Source-Dirs: filter/modify + Hs-Source-Dirs: examples + GHC-Options: -Wall -threaded + Default-Language: Haskell2010 + Other-Modules: Common + If flag(buildExamples) + Build-Depends: + alsa-seq, + alsa-core, + transformers, + base Else - Hs-Source-Dirs: filter/setget - GHC-Options: -Wall - Extensions: - ForeignFunctionInterface - GeneralizedNewtypeDeriving - EmptyDataDecls - Other-modules: - Sound.ALSA.Sequencer.Marshal.Sequencer - Sound.ALSA.Sequencer.Marshal.Address - Sound.ALSA.Sequencer.Marshal.Client - Sound.ALSA.Sequencer.Marshal.ClientInfo - Sound.ALSA.Sequencer.Marshal.Connect - Sound.ALSA.Sequencer.Marshal.Port - Sound.ALSA.Sequencer.Marshal.PortInfo - Sound.ALSA.Sequencer.Marshal.Queue - Sound.ALSA.Sequencer.Marshal.Event - Sound.ALSA.Sequencer.Marshal.RealTime - Sound.ALSA.Sequencer.Marshal.Time - Sound.ALSA.Sequencer.Area - Sound.ALSA.Sequencer.Sequencer - Build-Depends: - alsa-core >=0.5 && <0.6, - enumset >=0.0.3 && <0.1, - transformers >=0.2 && <0.4, - array, - bytestring >=0.9 && <0.11, - data-accessor >=0.2.2 && <0.3, - utility-ht >=0.0.7 && <0.1, - base >=3 && <5 + Buildable: False Executable alsa-seq-send-note Main-Is: send-note.hs - If !flag(buildExamples) - Buildable: False - Hs-Source-Dirs: src, examples - Include-Dirs: src - If flag(modifyFilter) - Hs-Source-Dirs: filter/modify + Hs-Source-Dirs: examples + GHC-Options: -Wall -threaded + Default-Language: Haskell2010 + Other-Modules: Common + If flag(buildExamples) + Build-Depends: + alsa-seq, + alsa-core, + transformers, + base Else - Hs-Source-Dirs: filter/setget - GHC-Options: -Wall - Extensions: - ForeignFunctionInterface - GeneralizedNewtypeDeriving - EmptyDataDecls - Other-modules: - Sound.ALSA.Sequencer.Marshal.Sequencer - Sound.ALSA.Sequencer.Marshal.Address - Sound.ALSA.Sequencer.Marshal.Client - Sound.ALSA.Sequencer.Marshal.ClientInfo - Sound.ALSA.Sequencer.Marshal.Connect - Sound.ALSA.Sequencer.Marshal.Port - Sound.ALSA.Sequencer.Marshal.PortInfo - Sound.ALSA.Sequencer.Marshal.Queue - Sound.ALSA.Sequencer.Marshal.Event - Sound.ALSA.Sequencer.Marshal.RealTime - Sound.ALSA.Sequencer.Marshal.Time - Sound.ALSA.Sequencer.Area - Sound.ALSA.Sequencer.Sequencer - Common - Build-Depends: - alsa-core >=0.5 && <0.6, - enumset >=0.0.3 && <0.1, - transformers >=0.2 && <0.4, - array, - bytestring >=0.9 && <0.11, - data-accessor >=0.2.2 && <0.3, - utility-ht >=0.0.7 && <0.1, - base >=3 && <5 + Buildable: False Executable alsa-seq-broadcast Main-Is: broadcast.hs - If !flag(buildExamples) - Buildable: False - Hs-Source-Dirs: src, examples - Include-Dirs: src - If flag(modifyFilter) - Hs-Source-Dirs: filter/modify + Hs-Source-Dirs: examples + GHC-Options: -Wall -threaded + Default-Language: Haskell2010 + Other-Modules: Common + If flag(buildExamples) + Build-Depends: + alsa-seq, + alsa-core, + transformers, + base Else - Hs-Source-Dirs: filter/setget - GHC-Options: -Wall - Extensions: - ForeignFunctionInterface - GeneralizedNewtypeDeriving - EmptyDataDecls - Other-modules: - Sound.ALSA.Sequencer.Marshal.Sequencer - Sound.ALSA.Sequencer.Marshal.Address - Sound.ALSA.Sequencer.Marshal.Client - Sound.ALSA.Sequencer.Marshal.ClientInfo - Sound.ALSA.Sequencer.Marshal.Connect - Sound.ALSA.Sequencer.Marshal.Port - Sound.ALSA.Sequencer.Marshal.PortInfo - Sound.ALSA.Sequencer.Marshal.Queue - Sound.ALSA.Sequencer.Marshal.Event - Sound.ALSA.Sequencer.Marshal.RealTime - Sound.ALSA.Sequencer.Marshal.Time - Sound.ALSA.Sequencer.Area - Sound.ALSA.Sequencer.Sequencer - Build-Depends: - alsa-core >=0.5 && <0.6, - enumset >=0.0.3 && <0.1, - transformers >=0.2 && <0.4, - array, - bytestring >=0.9 && <0.11, - data-accessor >=0.2.2 && <0.3, - utility-ht >=0.0.7 && <0.1, - base >=3 && <5 + Buildable: False Executable alsa-seq-list-ports Main-Is: list-ports.hs - If !flag(buildExamples) - Buildable: False - Hs-Source-Dirs: src, examples - Include-Dirs: src - If flag(modifyFilter) - Hs-Source-Dirs: filter/modify + Hs-Source-Dirs: examples + GHC-Options: -Wall -threaded + Default-Language: Haskell2010 + If flag(buildExamples) + Build-Depends: + alsa-seq, + alsa-core, + enumset, + transformers, + base Else - Hs-Source-Dirs: filter/setget - GHC-Options: -Wall - Extensions: - ForeignFunctionInterface - GeneralizedNewtypeDeriving - EmptyDataDecls - Other-modules: - Sound.ALSA.Sequencer.Marshal.Sequencer - Sound.ALSA.Sequencer.Marshal.Address - Sound.ALSA.Sequencer.Marshal.Client - Sound.ALSA.Sequencer.Marshal.ClientInfo - Sound.ALSA.Sequencer.Marshal.Connect - Sound.ALSA.Sequencer.Marshal.Port - Sound.ALSA.Sequencer.Marshal.PortInfo - Sound.ALSA.Sequencer.Marshal.Queue - Sound.ALSA.Sequencer.Marshal.Event - Sound.ALSA.Sequencer.Marshal.RealTime - Sound.ALSA.Sequencer.Marshal.Time - Sound.ALSA.Sequencer.Area - Sound.ALSA.Sequencer.Sequencer - Build-Depends: - alsa-core >=0.5 && <0.6, - enumset >=0.0.3 && <0.1, - transformers >=0.2 && <0.4, - array, - bytestring >=0.9 && <0.11, - data-accessor >=0.2.2 && <0.3, - utility-ht >=0.0.7 && <0.1, - base >=3 && <5 + Buildable: False Executable alsa-seq-melody Main-Is: melody.hs - If !flag(buildExamples) - Buildable: False - Hs-Source-Dirs: src, examples - Include-Dirs: src - If flag(modifyFilter) - Hs-Source-Dirs: filter/modify + Hs-Source-Dirs: examples + GHC-Options: -Wall -threaded + Default-Language: Haskell2010 + Other-Modules: Common + If flag(buildExamples) + Build-Depends: + alsa-seq, + alsa-core, + transformers, + base Else - Hs-Source-Dirs: filter/setget - GHC-Options: -Wall - Extensions: - ForeignFunctionInterface - GeneralizedNewtypeDeriving - EmptyDataDecls - Other-modules: - Sound.ALSA.Sequencer.Marshal.Sequencer - Sound.ALSA.Sequencer.Marshal.Address - Sound.ALSA.Sequencer.Marshal.Client - Sound.ALSA.Sequencer.Marshal.ClientInfo - Sound.ALSA.Sequencer.Marshal.Connect - Sound.ALSA.Sequencer.Marshal.Port - Sound.ALSA.Sequencer.Marshal.PortInfo - Sound.ALSA.Sequencer.Marshal.Queue - Sound.ALSA.Sequencer.Marshal.Event - Sound.ALSA.Sequencer.Marshal.RealTime - Sound.ALSA.Sequencer.Marshal.Time - Sound.ALSA.Sequencer.Area - Sound.ALSA.Sequencer.Sequencer - Common - Build-Depends: - alsa-core >=0.5 && <0.6, - enumset >=0.0.3 && <0.1, - transformers >=0.2 && <0.4, - array, - bytestring >=0.9 && <0.11, - data-accessor >=0.2.2 && <0.3, - utility-ht >=0.0.7 && <0.1, - base >=3 && <5 + Buildable: False Executable alsa-seq-list-subscribers Main-Is: list-subscribers.hs - If !flag(buildExamples) - Buildable: False - Hs-Source-Dirs: src, examples - Include-Dirs: src - If flag(modifyFilter) - Hs-Source-Dirs: filter/modify + Hs-Source-Dirs: examples + GHC-Options: -Wall -threaded + Default-Language: Haskell2010 + Other-Modules: Common + If flag(buildExamples) + Build-Depends: + alsa-seq, + alsa-core, + transformers, + utility-ht, + base Else - Hs-Source-Dirs: filter/setget - GHC-Options: -Wall - Extensions: - ForeignFunctionInterface - GeneralizedNewtypeDeriving - EmptyDataDecls - Other-modules: - Sound.ALSA.Sequencer.Marshal.Sequencer - Sound.ALSA.Sequencer.Marshal.Address - Sound.ALSA.Sequencer.Marshal.Client - Sound.ALSA.Sequencer.Marshal.ClientInfo - Sound.ALSA.Sequencer.Marshal.Connect - Sound.ALSA.Sequencer.Marshal.Port - Sound.ALSA.Sequencer.Marshal.PortInfo - Sound.ALSA.Sequencer.Marshal.Queue - Sound.ALSA.Sequencer.Marshal.Event - Sound.ALSA.Sequencer.Marshal.RealTime - Sound.ALSA.Sequencer.Marshal.Time - Sound.ALSA.Sequencer.Area - Sound.ALSA.Sequencer.Sequencer - Sound.ALSA.Sequencer.Subscribe.Query - Build-Depends: - alsa-core >=0.5 && <0.6, - enumset >=0.0.3 && <0.1, - transformers >=0.2 && <0.4, - array, - bytestring >=0.9 && <0.11, - data-accessor >=0.2.2 && <0.3, - utility-ht >=0.0.7 && <0.1, - base >=3 && <5 + Buildable: False Executable alsa-seq-beat Main-Is: beat.hs - If !flag(buildExamples) - Buildable: False - Hs-Source-Dirs: src, examples - Include-Dirs: src - If flag(modifyFilter) - Hs-Source-Dirs: filter/modify + Hs-Source-Dirs: examples + GHC-Options: -Wall -threaded + Default-Language: Haskell2010 + Other-Modules: Common + If flag(buildExamples) + Build-Depends: + alsa-seq, + alsa-core, + transformers, + utility-ht, + base Else - Hs-Source-Dirs: filter/setget - GHC-Options: -Wall - Extensions: - ForeignFunctionInterface - GeneralizedNewtypeDeriving - EmptyDataDecls - Other-modules: - Sound.ALSA.Sequencer.Marshal.Sequencer - Sound.ALSA.Sequencer.Marshal.Address - Sound.ALSA.Sequencer.Marshal.Client - Sound.ALSA.Sequencer.Marshal.ClientInfo - Sound.ALSA.Sequencer.Marshal.Connect - Sound.ALSA.Sequencer.Marshal.Port - Sound.ALSA.Sequencer.Marshal.PortInfo - Sound.ALSA.Sequencer.Marshal.Queue - Sound.ALSA.Sequencer.Marshal.Event - Sound.ALSA.Sequencer.Marshal.RealTime - Sound.ALSA.Sequencer.Marshal.Time - Sound.ALSA.Sequencer.Area - Sound.ALSA.Sequencer.Sequencer - Sound.ALSA.Sequencer.Event.Remove - Common - Build-Depends: - alsa-core >=0.5 && <0.6, - enumset >=0.0.3 && <0.1, - transformers >=0.2 && <0.4, - array, - bytestring >=0.9 && <0.11, - data-accessor >=0.2.2 && <0.3, - utility-ht >=0.0.7 && <0.1, - base >=3 && <5 + Buildable: False Executable alsa-seq-sysex Main-Is: sysex.hs - If !flag(buildExamples) - Buildable: False - Hs-Source-Dirs: src, examples - Include-Dirs: src - If flag(modifyFilter) - Hs-Source-Dirs: filter/modify + Hs-Source-Dirs: examples + GHC-Options: -Wall -threaded + Default-Language: Haskell2010 + Other-Modules: Common + If flag(buildExamples) + Build-Depends: + alsa-seq, + alsa-core, + transformers, + bytestring, + base Else - Hs-Source-Dirs: filter/setget - GHC-Options: -Wall - Extensions: - ForeignFunctionInterface - GeneralizedNewtypeDeriving - EmptyDataDecls - Other-modules: - Sound.ALSA.Sequencer.Marshal.Sequencer - Sound.ALSA.Sequencer.Marshal.Address - Sound.ALSA.Sequencer.Marshal.Client - Sound.ALSA.Sequencer.Marshal.ClientInfo - Sound.ALSA.Sequencer.Marshal.Connect - Sound.ALSA.Sequencer.Marshal.Port - Sound.ALSA.Sequencer.Marshal.PortInfo - Sound.ALSA.Sequencer.Marshal.Queue - Sound.ALSA.Sequencer.Marshal.Event - Sound.ALSA.Sequencer.Marshal.RealTime - Sound.ALSA.Sequencer.Marshal.Time - Sound.ALSA.Sequencer.Area - Sound.ALSA.Sequencer.Sequencer - Sound.ALSA.Sequencer.Subscribe.Query - Common - Build-Depends: - alsa-core >=0.5 && <0.6, - enumset >=0.0.3 && <0.1, - transformers >=0.2 && <0.4, - array, - bytestring >=0.9 && <0.11, - data-accessor >=0.2.2 && <0.3, - utility-ht >=0.0.7 && <0.1, - base >=3 && <5 + Buildable: False diff --git a/examples/Common.hs b/examples/Common.hs --- a/examples/Common.hs +++ b/examples/Common.hs @@ -4,7 +4,10 @@ import qualified Sound.ALSA.Sequencer.Address as Addr import qualified Sound.ALSA.Sequencer.Port as Port import qualified Sound.ALSA.Sequencer as SndSeq +import qualified Sound.ALSA.Exception as AlsaExc +import Control.Monad.Trans.Cont (ContT, runContT, ) + import qualified System.Exit as Exit import qualified System.IO as IO @@ -33,3 +36,15 @@ IO.hPutStrLn IO.stderr "too many arguments" >> Exit.exitFailure + +handleExceptionCont :: ContT () IO () -> IO () +handleExceptionCont = handleException . runContUnit + +handleException :: IO () -> IO () +handleException act = + act + `AlsaExc.catch` \e -> + putStrLn $ "alsa_exception: " ++ AlsaExc.show e + +runContUnit :: (Monad m) => ContT a m a -> m a +runContUnit cont = runContT cont return diff --git a/examples/beat.hs b/examples/beat.hs --- a/examples/beat.hs +++ b/examples/beat.hs @@ -6,6 +6,8 @@ the events that are already scheduled. So we use this example to demonstrate removing output events. -} +import Common (handleExceptionCont, ) + import qualified Sound.ALSA.Sequencer.Connect as Connect import qualified Sound.ALSA.Sequencer.Address as Addr import qualified Sound.ALSA.Sequencer.Client as Client @@ -17,12 +19,13 @@ import qualified Sound.ALSA.Sequencer.RealTime as RealTime import qualified Sound.ALSA.Sequencer.Time as Time import qualified Sound.ALSA.Sequencer as SndSeq -import qualified Sound.ALSA.Exception as AlsaExc -import System.Environment (getArgs, ) import qualified System.Exit as Exit import qualified System.IO as IO +import System.Environment (getArgs, ) +import Control.Monad.Trans.Cont (ContT(ContT), ) +import Control.Monad.IO.Class (liftIO, ) import Control.Monad (mplus, ) import Data.Maybe.HT (toMaybe, ) @@ -68,18 +71,23 @@ main :: IO () -main = (do - SndSeq.withDefault SndSeq.Block $ \h -> do - Client.setName (h :: SndSeq.T SndSeq.DuplexMode) "Haskell-Beat" - Port.withSimple h "inout" - (Port.caps [Port.capRead, Port.capSubsRead, - Port.capWrite, Port.capSubsWrite]) - (Port.types [Port.typeMidiGeneric, Port.typeApplication]) $ \public -> do - Port.withSimple h "private" - (Port.caps [Port.capRead, Port.capWrite]) - (Port.types [Port.typeMidiGeneric]) $ \private -> do - Queue.with h $ \q -> do +main = handleExceptionCont $ do + h <- ContT $ SndSeq.withDefault SndSeq.Block + liftIO $ Client.setName h "Haskell-Beat" + public <- + ContT $ Port.withSimple h "inout" + (Port.caps [Port.capRead, Port.capSubsRead, + Port.capWrite, Port.capSubsWrite]) + (Port.types [Port.typeMidiGeneric, Port.typeApplication]) + private <- + ContT $ Port.withSimple h "private" + (Port.caps [Port.capRead, Port.capWrite]) + (Port.types [Port.typeMidiGeneric]) + q <- ContT $ Queue.with h + liftIO $ mainIO h public private q +mainIO :: SndSeq.T SndSeq.DuplexMode -> Port.T -> Port.T -> Queue.T -> IO () +mainIO h public private q = do PortInfo.modify h public $ do PortInfo.setTimestamping True PortInfo.setTimestampReal True @@ -195,7 +203,4 @@ then tempo trackA val t sa >>= \s -> go (s, sb) else tempo trackB val t sb >>= \s -> go (sa, s) - go (initState trackA, initState trackB)) - - `AlsaExc.catch` \e -> - putStrLn $ "alsa_exception: " ++ AlsaExc.show e + go (initState trackA, initState trackB) diff --git a/examples/broadcast.hs b/examples/broadcast.hs --- a/examples/broadcast.hs +++ b/examples/broadcast.hs @@ -1,29 +1,28 @@ +import Common (handleException, ) + import qualified Sound.ALSA.Sequencer.Address as Addr import qualified Sound.ALSA.Sequencer.Client as Client import qualified Sound.ALSA.Sequencer.Port as Port import qualified Sound.ALSA.Sequencer.Event as Event import qualified Sound.ALSA.Sequencer as SndSeq -import qualified Sound.ALSA.Exception as AlsaExc main :: IO () -main = (do - putStrLn "Starting." - SndSeq.withDefault SndSeq.Block $ \h -> do - Client.setName (h :: SndSeq.T SndSeq.OutputMode) "Haskell-Broadcast" - c <- Client.getId h - putStrLn ("Created sequencer with id: " ++ show c) - -- dst <- Addr.parse h "HS1:255" - let dst = Addr.broadcast - print dst - let ev n = - (Event.simple - (Addr.Cons c Port.unknown) - (Event.NoteEv n $ - Event.simpleNote (Event.Channel 0) (Event.Pitch 60) Event.normalVelocity)) - {Event.dest = dst} - _ <- Event.outputDirect h $ ev Event.NoteOn - _ <- getChar - _ <- Event.outputDirect h $ ev Event.NoteOff - return ()) - `AlsaExc.catch` \e -> - putStrLn $ "alsa_exception: " ++ AlsaExc.show e +main = handleException $ do + putStrLn "Starting." + SndSeq.withDefault SndSeq.Block $ \h -> do + Client.setName (h :: SndSeq.T SndSeq.OutputMode) "Haskell-Broadcast" + c <- Client.getId h + putStrLn ("Created sequencer with id: " ++ show c) + -- dst <- Addr.parse h "HS1:255" + let dst = Addr.broadcast + print dst + let ev n = + (Event.simple + (Addr.Cons c Port.unknown) + (Event.NoteEv n $ + Event.simpleNote (Event.Channel 0) (Event.Pitch 60) Event.normalVelocity)) + {Event.dest = dst} + _ <- Event.outputDirect h $ ev Event.NoteOn + _ <- getChar + _ <- Event.outputDirect h $ ev Event.NoteOff + return () diff --git a/examples/dump.hs b/examples/dump.hs --- a/examples/dump.hs +++ b/examples/dump.hs @@ -1,23 +1,28 @@ +import Common (handleException, runContUnit, ) + import qualified Sound.ALSA.Sequencer.Client as Client import qualified Sound.ALSA.Sequencer.Port as Port import qualified Sound.ALSA.Sequencer.Event as Event import qualified Sound.ALSA.Sequencer as SndSeq -import qualified Sound.ALSA.Exception as AlsaExc +import Control.Monad.Trans.Cont (ContT(ContT), ) +import Control.Monad.IO.Class (liftIO, ) import Control.Monad (forever, ) main :: IO () -main = (do - putStrLn "Starting." - SndSeq.withDefault SndSeq.Block $ \h -> do - Client.setName (h :: SndSeq.T SndSeq.InputMode) "Haskell-Dump" - putStrLn "Created sequencer." - Port.withSimple h "primary" - (Port.caps [Port.capWrite, Port.capSubsWrite]) Port.typeMidiGeneric $ \ _p1 -> do - Port.withSimple h "secondary" - (Port.caps [Port.capWrite, Port.capSubsWrite]) Port.typeMidiGeneric $ \ _p2 -> do - putStrLn "Created ports." - forever $ do - putStrLn "waiting for an event:" - print =<< Event.input h) - `AlsaExc.catch` \e -> - putStrLn $ "alsa_exception: " ++ AlsaExc.show e +main = handleException $ runContUnit $ do + liftIO $ putStrLn "Starting." + h <- ContT $ SndSeq.withDefault SndSeq.Block + liftIO $ Client.setName (h :: SndSeq.T SndSeq.InputMode) "Haskell-Dump" + liftIO $ putStrLn "Created sequencer." + _p1 <- + ContT $ + Port.withSimple h "primary" + (Port.caps [Port.capWrite, Port.capSubsWrite]) Port.typeMidiGeneric + _p2 <- + ContT $ + Port.withSimple h "secondary" + (Port.caps [Port.capWrite, Port.capSubsWrite]) Port.typeMidiGeneric + liftIO $ putStrLn "Created ports." + liftIO $ forever $ do + putStrLn "waiting for an event:" + print =<< Event.input h diff --git a/examples/list-subscribers.hs b/examples/list-subscribers.hs --- a/examples/list-subscribers.hs +++ b/examples/list-subscribers.hs @@ -1,28 +1,34 @@ +import Common (handleExceptionCont, ) + import qualified Sound.ALSA.Sequencer.Address as Addr import qualified Sound.ALSA.Sequencer.Subscribe.Query as Query import qualified Sound.ALSA.Sequencer as SndSeq -import qualified Sound.ALSA.Exception as AlsaExc +import Control.Monad.Trans.Cont (ContT(ContT), ) +import Control.Monad.IO.Class (liftIO, ) +import Control.Monad (forM_, ) import System.Environment (getArgs, ) -import Control.Monad ((<=<), forM_, ) + +showQ :: Query.T -> IO String +showQ q = do + ad <- Query.getAddr q + qq <- Query.getQueue q + ex <- Query.getExclusive q + tu <- Query.getTimeUpdate q + tr <- Query.getTimeReal q + return (show ad ++ ":" ++ show qq + ++ (if tu then " update" else "") + ++ (if tr then " realtime" else "") + ++ (if ex then " exclusive" else "")) + main :: IO () -main = (do - args <- getArgs - SndSeq.withDefault SndSeq.Block $ \h -> forM_ args $ \arg -> do - a <- Addr.parse (h :: SndSeq.T SndSeq.InputMode) arg - let showQ q = do - ad <- Query.getAddr q - qq <- Query.getQueue q - ex <- Query.getExclusive q - tu <- Query.getTimeUpdate q - tr <- Query.getTimeReal q - return (show ad ++ ":" ++ show qq - ++ (if tu then " update" else "") - ++ (if tr then " realtime" else "") - ++ (if ex then " exclusive" else "")) - list t = do - putStrLn ("subscribers of " ++ show a ++ " for " ++ show t ++ ":") - mapM_ (putStrLn . (' ':) <=< showQ) =<< Query.queryAll h a t - mapM_ list [Query.Read, Query.Write]) - `AlsaExc.catch` \e -> - putStrLn $ "alsa_exception: " ++ AlsaExc.show e +main = handleExceptionCont $ do + args <- liftIO getArgs + h <- ContT $ SndSeq.withDefault SndSeq.Block + arg <- ContT $ forM_ args + a <- liftIO $ Addr.parse (h :: SndSeq.T SndSeq.InputMode) arg + t <- ContT $ forM_ [Query.Read, Query.Write] + liftIO $ putStrLn ("subscribers of " ++ show a ++ " for " ++ show t ++ ":") + answers <- liftIO $ Query.queryAll h a t + answer <- ContT $ forM_ answers + liftIO $ putStrLn . (' ':) =<< showQ answer diff --git a/examples/melody.hs b/examples/melody.hs --- a/examples/melody.hs +++ b/examples/melody.hs @@ -3,7 +3,7 @@ Demonstrate how to wait on the end of a performance of events, by sending an Echo message to ourselves. -} -import Common (parseDestArgs, ) +import Common (parseDestArgs, handleExceptionCont, ) import qualified Sound.ALSA.Sequencer.Address as Addr import qualified Sound.ALSA.Sequencer.Client as Client @@ -12,21 +12,27 @@ import qualified Sound.ALSA.Sequencer.Queue as Queue import qualified Sound.ALSA.Sequencer.Time as Time import qualified Sound.ALSA.Sequencer as SndSeq -import qualified Sound.ALSA.Exception as AlsaExc -import System.Environment (getArgs, ) - +import Control.Monad.Trans.Cont (ContT(ContT), ) +import Control.Monad.IO.Class (liftIO, ) import Control.Monad (zipWithM_, ) +import System.Environment (getArgs, ) + main :: IO () -main = (do - SndSeq.withDefault SndSeq.Block $ \h -> do - Client.setName (h :: SndSeq.T SndSeq.DuplexMode) "Haskell-Melody" - Port.withSimple h "out" - (Port.caps [Port.capRead, Port.capSubsRead, Port.capWrite]) - (Port.types [Port.typeMidiGeneric, Port.typeApplication]) $ \p -> do - Queue.with h $ \q -> do +main = handleExceptionCont $ do + h <- ContT $ SndSeq.withDefault SndSeq.Block + liftIO $ Client.setName h "Haskell-Melody" + p <- ContT $ + Port.withSimple h "out" + (Port.caps [Port.capRead, Port.capSubsRead, Port.capWrite]) + (Port.types [Port.typeMidiGeneric, Port.typeApplication]) + q <- ContT $ Queue.with h + liftIO $ mainIO h p q + +mainIO :: SndSeq.T SndSeq.DuplexMode -> Port.T -> Queue.T -> IO () +mainIO h p q = do c <- Client.getId h let me = Addr.Cons c p conn <- parseDestArgs h me =<< getArgs @@ -76,7 +82,4 @@ then return () else waitForEcho _ -> waitForEcho - waitForEcho) - - `AlsaExc.catch` \e -> - putStrLn $ "alsa_exception: " ++ AlsaExc.show e + waitForEcho diff --git a/examples/send-note.hs b/examples/send-note.hs --- a/examples/send-note.hs +++ b/examples/send-note.hs @@ -1,25 +1,32 @@ -import Common (parseDestArgs, ) +import Common (handleExceptionCont, parseDestArgs, ) import qualified Sound.ALSA.Sequencer.Address as Addr import qualified Sound.ALSA.Sequencer.Client as Client import qualified Sound.ALSA.Sequencer.Port as Port import qualified Sound.ALSA.Sequencer.Event as Event import qualified Sound.ALSA.Sequencer as SndSeq -import qualified Sound.ALSA.Exception as AlsaExc +import Control.Monad.Trans.Cont (ContT(ContT), ) +import Control.Monad.IO.Class (liftIO, ) + import System.Environment (getArgs, ) main :: IO () -main = (do - putStrLn "Starting." - SndSeq.withDefault SndSeq.Block $ \h -> do - Client.setName (h :: SndSeq.T SndSeq.OutputMode) "Haskell-Send-Note" +main = handleExceptionCont $ do + liftIO $ putStrLn "Starting." + h <- ContT $ SndSeq.withDefault SndSeq.Block + liftIO $ Client.setName h "Haskell-Send-Note" + p <- + ContT $ + Port.withSimple h "out" + (Port.caps [Port.capRead, Port.capSubsRead]) Port.typeMidiGeneric + liftIO $ mainIO h p + +mainIO :: SndSeq.T SndSeq.OutputMode -> Port.T -> IO () +mainIO h p = do c <- Client.getId h putStrLn ("Created sequencer with id: " ++ show c) - Port.withSimple h "out" - (Port.caps [Port.capRead, Port.capSubsRead]) Port.typeMidiGeneric $ \ p -> do - putStrLn "Created port." conn <- parseDestArgs h (Addr.Cons c p) =<< getArgs let ev n = Event.forConnection conn $ Event.NoteEv n $ @@ -28,6 +35,4 @@ putStrLn "press Enter for stopping the note" _ <- getChar _ <- Event.outputDirect h $ ev Event.NoteOff - return ()) - `AlsaExc.catch` \e -> - putStrLn $ "alsa_exception: " ++ AlsaExc.show e + return () diff --git a/examples/sysex.hs b/examples/sysex.hs --- a/examples/sysex.hs +++ b/examples/sysex.hs @@ -1,4 +1,4 @@ -import Common (parseDestArgs, ) +import Common (handleExceptionCont, parseDestArgs, ) import qualified Sound.ALSA.Sequencer.Connect as Connect import qualified Sound.ALSA.Sequencer.Address as Addr @@ -6,24 +6,32 @@ import qualified Sound.ALSA.Sequencer.Port as Port import qualified Sound.ALSA.Sequencer.Event as Event import qualified Sound.ALSA.Sequencer as SndSeq -import qualified Sound.ALSA.Exception as AlsaExc +import Control.Monad.Trans.Cont (ContT(ContT), ) +import Control.Monad.IO.Class (liftIO, ) + import qualified Data.ByteString as B import System.Environment (getArgs, ) main :: IO () -main = (do - putStrLn "Starting." - SndSeq.withDefault SndSeq.Block $ \h -> do - Client.setName (h :: SndSeq.T SndSeq.DuplexMode) "Haskell-SysEx" +main = handleExceptionCont $ do + liftIO $ putStrLn "Starting." + h <- ContT $ SndSeq.withDefault SndSeq.Block + liftIO $ Client.setName h "Haskell-SysEx" + p <- + ContT $ + Port.withSimple h "out" + (Port.caps [Port.capRead, Port.capSubsRead, + Port.capWrite, Port.capSubsWrite]) + Port.typeMidiGeneric + liftIO $ mainIO h p + +mainIO :: SndSeq.T SndSeq.DuplexMode -> Port.T -> IO () +mainIO h p = do c <- Client.getId h putStrLn ("Created sequencer with id: " ++ show c) - Port.withSimple h "out" - (Port.caps [Port.capRead, Port.capSubsRead, - Port.capWrite, Port.capSubsWrite]) Port.typeMidiGeneric $ \ p -> do - putStrLn "Created port." let me = Addr.Cons c p conn <- parseDestArgs h me =<< getArgs @@ -41,6 +49,4 @@ putStrLn $ "got: " ++ show str _ -> waitForSysEx waitForSysEx - return ()) - `AlsaExc.catch` \e -> - putStrLn $ "alsa_exception: " ++ AlsaExc.show e + return () diff --git a/src/Sound/ALSA/Sequencer/Address.hs b/src/Sound/ALSA/Sequencer/Address.hs --- a/src/Sound/ALSA/Sequencer/Address.hs +++ b/src/Sound/ALSA/Sequencer/Address.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ForeignFunctionInterface #-} module Sound.ALSA.Sequencer.Address ( Addr.T(Addr.Cons, Addr.client, Addr.port) , Addr.unknown diff --git a/src/Sound/ALSA/Sequencer/Client/InfoMonad.hs b/src/Sound/ALSA/Sequencer/Client/InfoMonad.hs --- a/src/Sound/ALSA/Sequencer/Client/InfoMonad.hs +++ b/src/Sound/ALSA/Sequencer/Client/InfoMonad.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Sound.ALSA.Sequencer.Client.InfoMonad ( T, diff --git a/src/Sound/ALSA/Sequencer/Connect.hs b/src/Sound/ALSA/Sequencer/Connect.hs --- a/src/Sound/ALSA/Sequencer/Connect.hs +++ b/src/Sound/ALSA/Sequencer/Connect.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ForeignFunctionInterface #-} module Sound.ALSA.Sequencer.Connect ( Connect.T(Connect.Cons, Connect.source, Connect.dest), reverse, diff --git a/src/Sound/ALSA/Sequencer/Event.hs b/src/Sound/ALSA/Sequencer/Event.hs --- a/src/Sound/ALSA/Sequencer/Event.hs +++ b/src/Sound/ALSA/Sequencer/Event.hs @@ -13,6 +13,7 @@ -- -------------------------------------------------------------------------------- +{-# LANGUAGE ForeignFunctionInterface #-} module Sound.ALSA.Sequencer.Event ( -- * Output diff --git a/src/Sound/ALSA/Sequencer/Event/Remove.hsc b/src/Sound/ALSA/Sequencer/Event/Remove.hsc --- a/src/Sound/ALSA/Sequencer/Event/Remove.hsc +++ b/src/Sound/ALSA/Sequencer/Event/Remove.hsc @@ -1,3 +1,5 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Sound.ALSA.Sequencer.Event.Remove ( T, malloc, diff --git a/src/Sound/ALSA/Sequencer/Event/RemoveMonad.hs b/src/Sound/ALSA/Sequencer/Event/RemoveMonad.hs --- a/src/Sound/ALSA/Sequencer/Event/RemoveMonad.hs +++ b/src/Sound/ALSA/Sequencer/Event/RemoveMonad.hs @@ -14,6 +14,7 @@ The @put@ and @get@ functions would become useful for manipulating the remove criterion record, that ALSA maintains. -} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Sound.ALSA.Sequencer.Event.RemoveMonad ( T, run, diff --git a/src/Sound/ALSA/Sequencer/Marshal/Client.hsc b/src/Sound/ALSA/Sequencer/Marshal/Client.hsc --- a/src/Sound/ALSA/Sequencer/Marshal/Client.hsc +++ b/src/Sound/ALSA/Sequencer/Marshal/Client.hsc @@ -20,6 +20,7 @@ -- Thus you should use our wrapper types whereever possible. -------------------------------------------------------------------------------- +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Sound.ALSA.Sequencer.Marshal.Client where #include diff --git a/src/Sound/ALSA/Sequencer/Marshal/ClientInfo.hsc b/src/Sound/ALSA/Sequencer/Marshal/ClientInfo.hsc --- a/src/Sound/ALSA/Sequencer/Marshal/ClientInfo.hsc +++ b/src/Sound/ALSA/Sequencer/Marshal/ClientInfo.hsc @@ -13,6 +13,7 @@ -- -------------------------------------------------------------------------------- +{-# LANGUAGE ForeignFunctionInterface #-} module Sound.ALSA.Sequencer.Marshal.ClientInfo where #include diff --git a/src/Sound/ALSA/Sequencer/Marshal/Event.hsc b/src/Sound/ALSA/Sequencer/Marshal/Event.hsc --- a/src/Sound/ALSA/Sequencer/Marshal/Event.hsc +++ b/src/Sound/ALSA/Sequencer/Marshal/Event.hsc @@ -20,6 +20,7 @@ -- Thus you should use our wrapper types whereever possible. -------------------------------------------------------------------------------- +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Sound.ALSA.Sequencer.Marshal.Event where #include diff --git a/src/Sound/ALSA/Sequencer/Marshal/Port.hsc b/src/Sound/ALSA/Sequencer/Marshal/Port.hsc --- a/src/Sound/ALSA/Sequencer/Marshal/Port.hsc +++ b/src/Sound/ALSA/Sequencer/Marshal/Port.hsc @@ -20,6 +20,7 @@ -- Thus you should use our wrapper types whereever possible. -------------------------------------------------------------------------------- +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Sound.ALSA.Sequencer.Marshal.Port where #include diff --git a/src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc b/src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc --- a/src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc +++ b/src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc @@ -13,6 +13,7 @@ -- -------------------------------------------------------------------------------- +{-# LANGUAGE ForeignFunctionInterface #-} module Sound.ALSA.Sequencer.Marshal.PortInfo where #include diff --git a/src/Sound/ALSA/Sequencer/Marshal/Queue.hsc b/src/Sound/ALSA/Sequencer/Marshal/Queue.hsc --- a/src/Sound/ALSA/Sequencer/Marshal/Queue.hsc +++ b/src/Sound/ALSA/Sequencer/Marshal/Queue.hsc @@ -20,6 +20,7 @@ -- Thus you should use our wrapper types whereever possible. -------------------------------------------------------------------------------- +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Sound.ALSA.Sequencer.Marshal.Queue where #include diff --git a/src/Sound/ALSA/Sequencer/Poll.hs b/src/Sound/ALSA/Sequencer/Poll.hs --- a/src/Sound/ALSA/Sequencer/Poll.hs +++ b/src/Sound/ALSA/Sequencer/Poll.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ForeignFunctionInterface #-} module Sound.ALSA.Sequencer.Poll ( descriptors ) where diff --git a/src/Sound/ALSA/Sequencer/Port.hs b/src/Sound/ALSA/Sequencer/Port.hs --- a/src/Sound/ALSA/Sequencer/Port.hs +++ b/src/Sound/ALSA/Sequencer/Port.hs @@ -13,6 +13,7 @@ -- -------------------------------------------------------------------------------- +{-# LANGUAGE ForeignFunctionInterface #-} module Sound.ALSA.Sequencer.Port ( Port.T(Port.Cons) , create diff --git a/src/Sound/ALSA/Sequencer/Port/InfoMonad.hs b/src/Sound/ALSA/Sequencer/Port/InfoMonad.hs --- a/src/Sound/ALSA/Sequencer/Port/InfoMonad.hs +++ b/src/Sound/ALSA/Sequencer/Port/InfoMonad.hs @@ -13,6 +13,7 @@ -- -------------------------------------------------------------------------------- +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Sound.ALSA.Sequencer.Port.InfoMonad ( T, diff --git a/src/Sound/ALSA/Sequencer/Queue.hs b/src/Sound/ALSA/Sequencer/Queue.hs --- a/src/Sound/ALSA/Sequencer/Queue.hs +++ b/src/Sound/ALSA/Sequencer/Queue.hs @@ -13,6 +13,7 @@ -- -------------------------------------------------------------------------------- +{-# LANGUAGE ForeignFunctionInterface #-} module Sound.ALSA.Sequencer.Queue ( -- * General Queue Functions Queue.T diff --git a/src/Sound/ALSA/Sequencer/Sequencer.hs b/src/Sound/ALSA/Sequencer/Sequencer.hs --- a/src/Sound/ALSA/Sequencer/Sequencer.hs +++ b/src/Sound/ALSA/Sequencer/Sequencer.hs @@ -3,6 +3,7 @@ -} +{-# LANGUAGE ForeignFunctionInterface #-} module Sound.ALSA.Sequencer.Sequencer where import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq diff --git a/src/Sound/ALSA/Sequencer/Subscribe.hsc b/src/Sound/ALSA/Sequencer/Subscribe.hsc --- a/src/Sound/ALSA/Sequencer/Subscribe.hsc +++ b/src/Sound/ALSA/Sequencer/Subscribe.hsc @@ -12,6 +12,7 @@ -- -------------------------------------------------------------------------------- +{-# LANGUAGE ForeignFunctionInterface #-} module Sound.ALSA.Sequencer.Subscribe ( T diff --git a/src/Sound/ALSA/Sequencer/Subscribe/Query.hsc b/src/Sound/ALSA/Sequencer/Subscribe/Query.hsc --- a/src/Sound/ALSA/Sequencer/Subscribe/Query.hsc +++ b/src/Sound/ALSA/Sequencer/Subscribe/Query.hsc @@ -12,6 +12,7 @@ -- -------------------------------------------------------------------------------- +{-# LANGUAGE ForeignFunctionInterface #-} module Sound.ALSA.Sequencer.Subscribe.Query ( T , Type(..)