alsa-seq 0.5.1.1 → 0.6

raw patch · 63 files changed

+3255/−1944 lines, 63 filesdep +bytestringdep +polldep +transformersdep ~data-accessordep ~enumsetnew-component:exe:alsa-seq-beatnew-component:exe:alsa-seq-list-portsnew-component:exe:alsa-seq-sysexPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, poll, transformers

Dependency ranges changed: data-accessor, enumset

API changes (from Hackage documentation)

Files

• alsa-seq.cabal +188/−55
• examples/Common.hs +35/−0
• examples/beat.hs +201/−0
• examples/broadcast.hs +7/−6
• examples/dump.hs +1/−1
• examples/list-clients.hs +0/−13
• examples/list-ports.hs +31/−0
• examples/list-subscribers.hs +1/−1
• examples/melody.hs +16/−37
• examples/send-note.hs +6/−29
• examples/sysex.hs +46/−0
• filter/modify/Sound/ALSA/Sequencer/Client/Info/EventFilter.hs +14/−15
• filter/setget/Sound/ALSA/Sequencer/Client/Info/EventFilter.hs +7/−12
• src/Sound/ALSA/Sequencer.hs +2/−13
• src/Sound/ALSA/Sequencer/Address.hs +24/−5
• src/Sound/ALSA/Sequencer/Area.h +188/−0
• src/Sound/ALSA/Sequencer/Area.hs +38/−0
• src/Sound/ALSA/Sequencer/Area.hsc +0/−315
• src/Sound/ALSA/Sequencer/Client.hs +4/−7
• src/Sound/ALSA/Sequencer/Client/Info.hs +11/−100
• src/Sound/ALSA/Sequencer/Client/InfoMonad.hs +82/−0
• src/Sound/ALSA/Sequencer/Concurrent.hs +107/−0
• src/Sound/ALSA/Sequencer/Connect.hs +86/−0
• src/Sound/ALSA/Sequencer/Event.hs +146/−69
• src/Sound/ALSA/Sequencer/Event/Accessor.hs +16/−11
• src/Sound/ALSA/Sequencer/Event/Remove.hsc +94/−0
• src/Sound/ALSA/Sequencer/Event/RemoveMonad.hs +241/−0
• src/Sound/ALSA/Sequencer/Marshal/Address.hsc +33/−4
• src/Sound/ALSA/Sequencer/Marshal/Client.hsc +15/−11
• src/Sound/ALSA/Sequencer/Marshal/ClientInfo.hsc +104/−0
• src/Sound/ALSA/Sequencer/Marshal/Connect.hsc +24/−0
• src/Sound/ALSA/Sequencer/Marshal/Event.hsc +246/−195
• src/Sound/ALSA/Sequencer/Marshal/Port.hsc +17/−13
• src/Sound/ALSA/Sequencer/Marshal/PortInfo.hsc +126/−0
• src/Sound/ALSA/Sequencer/Marshal/QuerySubscribe.hsc +0/−21
• src/Sound/ALSA/Sequencer/Marshal/Queue.hsc +40/−11
• src/Sound/ALSA/Sequencer/Marshal/QueueTimer.hsc +0/−46
• src/Sound/ALSA/Sequencer/Marshal/RealTime.hsc +6/−4
• src/Sound/ALSA/Sequencer/Marshal/Sequencer.hsc +3/−9
• src/Sound/ALSA/Sequencer/Marshal/Template.h +31/−0
• src/Sound/ALSA/Sequencer/Marshal/Time.hsc +107/−0
• src/Sound/ALSA/Sequencer/Poll.hs +29/−0
• src/Sound/ALSA/Sequencer/Port.hs +16/−9
• src/Sound/ALSA/Sequencer/Port/Info.hs +11/−145
• src/Sound/ALSA/Sequencer/Port/InfoMonad.hs +147/−0
• src/Sound/ALSA/Sequencer/Query.hs +47/−0
• src/Sound/ALSA/Sequencer/Queue.hs +70/−17
• src/Sound/ALSA/Sequencer/Queue/Info.hs +0/−95
• src/Sound/ALSA/Sequencer/Queue/Info.hsc +61/−0
• src/Sound/ALSA/Sequencer/Queue/Status.hs +0/−106
• src/Sound/ALSA/Sequencer/Queue/Status.hsc +56/−0
• src/Sound/ALSA/Sequencer/Queue/Tempo.hs +0/−91
• src/Sound/ALSA/Sequencer/Queue/Tempo.hsc +59/−0
• src/Sound/ALSA/Sequencer/Queue/Timer.hs +0/−80
• src/Sound/ALSA/Sequencer/Queue/Timer.hsc +80/−0
• src/Sound/ALSA/Sequencer/RealTime.hs +14/−5
• src/Sound/ALSA/Sequencer/Sequencer.hs +56/−96
• src/Sound/ALSA/Sequencer/Subscribe.hs +0/−147
• src/Sound/ALSA/Sequencer/Subscribe.hsc +115/−0
• src/Sound/ALSA/Sequencer/Subscribe/Query.hs +0/−150
• src/Sound/ALSA/Sequencer/Subscribe/Query.hsc +128/−0
• src/Sound/ALSA/Sequencer/Time.hs +7/−0
• src/Sound/ALSA/Sequencer/Utility.hs +15/−0

@@ -1,12 +1,12 @@ Name:           alsa-seq-Version:        0.5.1.1-Copyright:      Bjorn Bringert, Iavor S. Diatchki, Henning Thielemann-Maintainer:     Henning Thielemann <alsa@henning-thielemann.de>+Version:        0.6 Author:   Henning Thielemann <alsa@henning-thielemann.de>,   Dylan Simon <dylan@dylex.net>,   Bjorn Bringert <bjorn@bringert.net>,   Iavor S. Diatchki <iavor.diatchki@gmail.com>+Maintainer:     Henning Thielemann <alsa@henning-thielemann.de>+Copyright:      Bjorn Bringert, Iavor S. Diatchki, Dylan Simon, Henning Thielemann Category:       Sound, Music License:        BSD3 License-file:   LICENSE@@ -23,15 +23,12 @@ Extra-Source-Files:   filter/modify/Sound/ALSA/Sequencer/Client/Info/EventFilter.hs   filter/setget/Sound/ALSA/Sequencer/Client/Info/EventFilter.hs+  src/Sound/ALSA/Sequencer/Marshal/Template.h+  src/Sound/ALSA/Sequencer/Area.h  Source-Repository head   type:     darcs-  location: http://code.haskell.org/~thielema/alsa-seq/--Source-Repository this-  type:     darcs-  location: http://code.haskell.org/~thielema/alsa-seq/-  tag:      0.5.1.1+  location: http://code.haskell.org/alsa/seq/  Flag buildExamples   description: Build example executables@@ -44,12 +41,15 @@ Library   Build-depends:     alsa-core >=0.5 && <0.6,-    enumset >= 0.0.2 && <0.1,-    array >= 0.1 && <0.5,-    data-accessor >=0.2.1 && <0.3,-    utility-ht >= 0.0.7 && <0.1,+    enumset >=0.0.3 && <0.1,+    transformers >=0.2 && <0.4,+    array >=0.1 && <0.5,+    bytestring >=0.9 && <0.10,+    data-accessor >=0.2.2 && <0.3,+    utility-ht >=0.0.7 && <0.1,+    poll >=0.0 && <0.1,     extensible-exceptions >=0.1.1 && <0.2,-    base >= 3 && <5+    base >=3 && <5    GHC-Options: -Wall   Extensions:@@ -58,6 +58,7 @@     EmptyDataDecls    Hs-Source-Dirs: src+  Include-Dirs: src   If flag(modifyFilter)     PkgConfig-Depends: alsa >= 1.0.17     Hs-Source-Dirs: filter/modify@@ -70,29 +71,40 @@     Sound.ALSA.Sequencer.Address     Sound.ALSA.Sequencer.Client     Sound.ALSA.Sequencer.Client.Info+    Sound.ALSA.Sequencer.Client.InfoMonad+    Sound.ALSA.Sequencer.Connect     Sound.ALSA.Sequencer.Port     Sound.ALSA.Sequencer.Port.Info+    Sound.ALSA.Sequencer.Port.InfoMonad     Sound.ALSA.Sequencer.Event     Sound.ALSA.Sequencer.Event.Accessor-    Sound.ALSA.Sequencer.RealTime+    Sound.ALSA.Sequencer.Event.RemoveMonad+    Sound.ALSA.Sequencer.Query     Sound.ALSA.Sequencer.Queue     Sound.ALSA.Sequencer.Queue.Info     Sound.ALSA.Sequencer.Queue.Status     Sound.ALSA.Sequencer.Queue.Tempo     Sound.ALSA.Sequencer.Queue.Timer+    Sound.ALSA.Sequencer.RealTime+    Sound.ALSA.Sequencer.Time+    Sound.ALSA.Sequencer.Concurrent     Sound.ALSA.Sequencer.Subscribe     Sound.ALSA.Sequencer.Subscribe.Query+    Sound.ALSA.Sequencer.Poll    Other-modules:+    Sound.ALSA.Sequencer.Event.Remove     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.QueueTimer     Sound.ALSA.Sequencer.Marshal.Event     Sound.ALSA.Sequencer.Marshal.RealTime-    Sound.ALSA.Sequencer.Marshal.QuerySubscribe+    Sound.ALSA.Sequencer.Marshal.Time     Sound.ALSA.Sequencer.Client.Info.EventFilter     Sound.ALSA.Sequencer.Area     Sound.ALSA.Sequencer.Sequencer@@ -105,11 +117,12 @@   If !flag(buildExamples)     Buildable: False   Hs-Source-Dirs: src, examples+  Include-Dirs: src   If flag(modifyFilter)     Hs-Source-Dirs: filter/modify   Else     Hs-Source-Dirs: filter/setget-  GHC-Options: -Wall -threaded+  GHC-Options: -Wall   Extensions:     ForeignFunctionInterface     GeneralizedNewtypeDeriving@@ -118,19 +131,24 @@     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.QueueTimer     Sound.ALSA.Sequencer.Marshal.Event     Sound.ALSA.Sequencer.Marshal.RealTime-    Sound.ALSA.Sequencer.Marshal.QuerySubscribe+    Sound.ALSA.Sequencer.Marshal.Time     Sound.ALSA.Sequencer.Area     Sound.ALSA.Sequencer.Sequencer   Build-Depends:     alsa-core >=0.5 && <0.6,-    enumset >= 0.0.2 && <0.1,-    array >= 0.1 && <0.5,-    utility-ht >= 0.0.7 && <0.1,+    enumset >=0.0.3 && <0.1,+    transformers >=0.2 && <0.4,+    array >=0.1 && <0.5,+    bytestring >=0.9 && <0.10,+    data-accessor >=0.2.2 && <0.3,+    utility-ht >=0.0.7 && <0.1,     base >=3 && <5  Executable alsa-seq-send-note@@ -138,11 +156,12 @@   If !flag(buildExamples)     Buildable: False   Hs-Source-Dirs: src, examples+  Include-Dirs: src   If flag(modifyFilter)     Hs-Source-Dirs: filter/modify   Else     Hs-Source-Dirs: filter/setget-  GHC-Options: -Wall -threaded+  GHC-Options: -Wall   Extensions:     ForeignFunctionInterface     GeneralizedNewtypeDeriving@@ -151,19 +170,25 @@     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.QueueTimer     Sound.ALSA.Sequencer.Marshal.Event     Sound.ALSA.Sequencer.Marshal.RealTime-    Sound.ALSA.Sequencer.Marshal.QuerySubscribe+    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.2 && <0.1,-    array >= 0.1 && <0.5,-    utility-ht >= 0.0.7 && <0.1,+    enumset >=0.0.3 && <0.1,+    transformers >=0.2 && <0.4,+    array >=0.1 && <0.5,+    bytestring >=0.9 && <0.10,+    data-accessor >=0.2.2 && <0.3,+    utility-ht >=0.0.7 && <0.1,     base >=3 && <5  Executable alsa-seq-broadcast@@ -171,11 +196,12 @@   If !flag(buildExamples)     Buildable: False   Hs-Source-Dirs: src, examples+  Include-Dirs: src   If flag(modifyFilter)     Hs-Source-Dirs: filter/modify   Else     Hs-Source-Dirs: filter/setget-  GHC-Options: -Wall -threaded+  GHC-Options: -Wall   Extensions:     ForeignFunctionInterface     GeneralizedNewtypeDeriving@@ -184,31 +210,37 @@     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.QueueTimer     Sound.ALSA.Sequencer.Marshal.Event     Sound.ALSA.Sequencer.Marshal.RealTime-    Sound.ALSA.Sequencer.Marshal.QuerySubscribe+    Sound.ALSA.Sequencer.Marshal.Time     Sound.ALSA.Sequencer.Area     Sound.ALSA.Sequencer.Sequencer   Build-Depends:     alsa-core >=0.5 && <0.6,-    enumset >= 0.0.2 && <0.1,-    array >= 0.1 && <0.5,-    utility-ht >= 0.0.7 && <0.1,+    enumset >=0.0.3 && <0.1,+    transformers >=0.2 && <0.4,+    array >=0.1 && <0.5,+    bytestring >=0.9 && <0.10,+    data-accessor >=0.2.2 && <0.3,+    utility-ht >=0.0.7 && <0.1,     base >=3 && <5 -Executable alsa-seq-list-clients-  Main-Is: list-clients.hs+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   Else     Hs-Source-Dirs: filter/setget-  GHC-Options: -Wall -threaded+  GHC-Options: -Wall   Extensions:     ForeignFunctionInterface     GeneralizedNewtypeDeriving@@ -217,19 +249,24 @@     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.QueueTimer     Sound.ALSA.Sequencer.Marshal.Event     Sound.ALSA.Sequencer.Marshal.RealTime-    Sound.ALSA.Sequencer.Marshal.QuerySubscribe+    Sound.ALSA.Sequencer.Marshal.Time     Sound.ALSA.Sequencer.Area     Sound.ALSA.Sequencer.Sequencer   Build-Depends:     alsa-core >=0.5 && <0.6,-    enumset >= 0.0.2 && <0.1,-    array >= 0.1 && <0.5,-    utility-ht >= 0.0.7 && <0.1,+    enumset >=0.0.3 && <0.1,+    transformers >=0.2 && <0.4,+    array >=0.1 && <0.5,+    bytestring >=0.9 && <0.10,+    data-accessor >=0.2.2 && <0.3,+    utility-ht >=0.0.7 && <0.1,     base >=3 && <5  Executable alsa-seq-melody@@ -237,11 +274,12 @@   If !flag(buildExamples)     Buildable: False   Hs-Source-Dirs: src, examples+  Include-Dirs: src   If flag(modifyFilter)     Hs-Source-Dirs: filter/modify   Else     Hs-Source-Dirs: filter/setget-  GHC-Options: -Wall -threaded+  GHC-Options: -Wall   Extensions:     ForeignFunctionInterface     GeneralizedNewtypeDeriving@@ -250,19 +288,25 @@     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.QueueTimer     Sound.ALSA.Sequencer.Marshal.Event     Sound.ALSA.Sequencer.Marshal.RealTime-    Sound.ALSA.Sequencer.Marshal.QuerySubscribe+    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.2 && <0.1,-    array >= 0.1 && <0.5,-    utility-ht >= 0.0.7 && <0.1,+    enumset >=0.0.3 && <0.1,+    transformers >=0.2 && <0.4,+    array >=0.1 && <0.5,+    bytestring >=0.9 && <0.10,+    data-accessor >=0.2.2 && <0.3,+    utility-ht >=0.0.7 && <0.1,     base >=3 && <5  Executable alsa-seq-list-subscribers@@ -270,11 +314,12 @@   If !flag(buildExamples)     Buildable: False   Hs-Source-Dirs: src, examples+  Include-Dirs: src   If flag(modifyFilter)     Hs-Source-Dirs: filter/modify   Else     Hs-Source-Dirs: filter/setget-  GHC-Options: -Wall -threaded+  GHC-Options: -Wall   Extensions:     ForeignFunctionInterface     GeneralizedNewtypeDeriving@@ -283,17 +328,105 @@     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.QueueTimer     Sound.ALSA.Sequencer.Marshal.Event     Sound.ALSA.Sequencer.Marshal.RealTime-    Sound.ALSA.Sequencer.Marshal.QuerySubscribe+    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.2 && <0.1,-    array >= 0.1 && <0.5,-    utility-ht >= 0.0.7 && <0.1,+    enumset >=0.0.3 && <0.1,+    transformers >=0.2 && <0.4,+    array >=0.1 && <0.5,+    bytestring >=0.9 && <0.10,+    data-accessor >=0.2.2 && <0.3,+    utility-ht >=0.0.7 && <0.1,+    base >=3 && <5++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+  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 >=0.1 && <0.5,+    bytestring >=0.9 && <0.10,+    data-accessor >=0.2.2 && <0.3,+    utility-ht >=0.0.7 && <0.1,+    base >=3 && <5++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+  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 >=0.1 && <0.5,+    bytestring >=0.9 && <0.10,+    data-accessor >=0.2.2 && <0.3,+    utility-ht >=0.0.7 && <0.1,     base >=3 && <5

@@ -0,0 +1,35 @@+module Common where++import qualified Sound.ALSA.Sequencer.Connect as Connect+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 System.Exit as Exit+import qualified System.IO as IO+++parseAndConnect ::+   (SndSeq.AllowOutput mode) =>+   SndSeq.T mode -> Port.T -> String -> IO Connect.T+parseAndConnect h p dest =+   Connect.createTo h p =<< Addr.parse h dest++parseDestArgs ::+   (SndSeq.AllowOutput mode) =>+   SndSeq.T mode -> Addr.T -> [String] -> IO Connect.T+parseDestArgs h me args = do+   let p = Addr.port me+   case args of+      [] -> do+         putStrLn "Enter destination or connect to a synthesizer and hit ENTER"+         destStr <- getLine+         if null destStr+           then return (Connect.toSubscribers me)+           else parseAndConnect h p destStr+      [destStr] ->+         parseAndConnect h p destStr+      _ ->+         IO.hPutStrLn IO.stderr "too many arguments"+         >>+         Exit.exitFailure

@@ -0,0 +1,201 @@+{- |+Play two precisely timed beats simultaneously+where the speed can be controlled by MIDI controllers.++Whenever the speed is changed we have to cancel+the events that are already scheduled.+So we use this example to demonstrate removing output events.+-}+import qualified Sound.ALSA.Sequencer.Connect as Connect+import qualified Sound.ALSA.Sequencer.Address as Addr+import qualified Sound.ALSA.Sequencer.Client as Client+import qualified Sound.ALSA.Sequencer.Port.InfoMonad as PortInfo+import qualified Sound.ALSA.Sequencer.Port as Port+import qualified Sound.ALSA.Sequencer.Event.RemoveMonad as Remove+import qualified Sound.ALSA.Sequencer.Event as Event+import qualified Sound.ALSA.Sequencer.Queue as Queue+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 Control.Monad (mplus, )+import Data.Maybe.HT (toMaybe, )+++data Message = Echo Event.Tag | Tempo Event.Tag Event.Value Double+  deriving (Show)+++data Track =+  Track {+    tag :: Event.Tag,+    pitch :: Event.Pitch,+    defaultPeriod, range :: Double,+    cc :: Event.Parameter+  }+++trackA, trackB :: Track++trackA =+  Track {+    tag = Event.Tag 0,+    pitch = Event.Pitch 60,+    defaultPeriod = 1,+    range = 2,+    cc = Event.Parameter 16+  }++trackB =+  Track {+    tag = Event.Tag 1,+    pitch = Event.Pitch 64,+    defaultPeriod = 1/7,+    range = 2,+    cc = Event.Parameter 17+  }+++data State = State { _lastTime, _remainingPortion, _period :: Double }++initState :: Track -> State+initState track = State 0 0 (defaultPeriod track)+++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++  PortInfo.modify h public $ do+     PortInfo.setTimestamping True+     PortInfo.setTimestampReal True+     PortInfo.setTimestampQueue q++  c <- Client.getId h+  let publicAddr  = Addr.Cons c public+      privateAddr = Addr.Cons c private+  args <- getArgs+  case args of+     [input, output] ->+        (Connect.createFrom h public =<< Addr.parse h input)+        >>+        (Connect.createTo   h public =<< Addr.parse h output)+        >>+        return ()+     _ ->+       IO.hPutStrLn IO.stderr "need arguments: input-client output-client"+       >>+       Exit.exitFailure++  let mkEv tg t e =+         (Event.simple publicAddr e) {+             Event.tag = tg,+             Event.queue = q,+             Event.time = Time.consAbs $ Time.Real $ RealTime.fromDouble t+          }++      play tg t onoff p =+         (Event.output h $ mkEv tg t $ Event.NoteEv onoff $+          Event.simpleNote (Event.Channel 0) p Event.normalVelocity)+         >>+         return ()++      echo tg t =+         Event.output h+            ((mkEv tg t $ Event.CustomEv Event.Echo $ Event.Custom 0 0 0) {+               Event.dest = privateAddr+            })+         >>+         return ()++  Queue.control h q Event.QueueStart Nothing++  let start track = do+         play (tag track) 0 Event.NoteOn (pitch track)+         echo (tag track) 0++  start trackA+  start trackB+  _ <- Event.drainOutput h++  let checkCC ctrl track =+         toMaybe (Event.ctrlParam ctrl == cc track) (tag track)++      wait = do+         ev <- Event.input h+         case Event.body ev of+            Event.CustomEv Event.Echo _ ->+               if Event.dest ev == privateAddr+                 then return $ Echo $ Event.tag ev+                 else wait+            Event.CtrlEv Event.Controller ctrl ->+               case mplus (checkCC ctrl trackA) (checkCC ctrl trackB) of+                  Just tg ->+                     case Event.time ev of+                        Time.Cons Time.Absolute (Time.Real t) ->+                           return $ Tempo tg (Event.ctrlValue ctrl) $+                              RealTime.toDouble t+                        _ -> error "got time in a format that we did not request"+                  Nothing -> wait+            _ -> wait++  let schedule track t = do+         play (tag track) t Event.NoteOff (pitch track)+         play (tag track) t Event.NoteOn  (pitch track)+         echo (tag track) t+         _ <- Event.drainOutput h+         return ()++  {-+  Cancel the Echo and Notes we already sent,+  and replace them by ones with updated timestamp.+  -}+  let tempo track val t1 (State t0 r0 p0) = do+         Remove.run h $ do+            Remove.setOutput+            Remove.setTag $ tag track+         let r1 = r0 - (t1-t0) / p0+         let p1 = defaultPeriod track *+                     range track ** ((fromIntegral val - 64) / 64)+         schedule track $ t1 + r1 * p1+         return (State t1 r1 p1)++  let next track (State t0 r p) =+         let {-+             t1 should be the current time.+             In principle we could use the timestamp from the Echo message,+             but this will be slightly later than the reference time.+             -}+             t1 = t0 + r*p+         in  schedule track (t1+p) >> return (State t1 1 p)++  let go (sa, sb) = do+         msg <- wait+         case msg of+            Echo tg ->+               if tg == tag trackA+                 then next trackA sa >>= \s -> go (s, sb)+                 else next trackB sb >>= \s -> go (sa, s)+            Tempo tg (Event.Value val) t ->+               if tg == tag trackA+                 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

@@ -8,18 +8,19 @@ main :: IO () main = (do   putStrLn "Starting."-  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do+  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)-  -- tgt_addr <- Addr.parse h "HS1:255"-  let tgt_addr = Addr.Cons Client.broadcast Port.unknown-  print tgt_addr+  -- 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 0 60 64))-         {Event.dest = tgt_addr}+            (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

@@ -8,7 +8,7 @@ main :: IO () main = (do   putStrLn "Starting."-  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do+  SndSeq.withDefault SndSeq.Block $ \h -> do   Client.setName (h :: SndSeq.T SndSeq.InputMode) "Haskell-Dump"   putStrLn "Created sequencer."   Port.withSimple h "primary"

@@ -1,13 +0,0 @@-import qualified Sound.ALSA.Sequencer.Client.Info as ClientInfo-import qualified Sound.ALSA.Sequencer as SndSeq--import Control.Monad (when, )--main :: IO ()-main =-  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do-  i <- ClientInfo.queryFirst (h :: SndSeq.T SndSeq.OutputMode)-  let loop = do putStrLn =<< ClientInfo.getName i-                more <- ClientInfo.queryNext h i-                when more loop-  loop

@@ -0,0 +1,31 @@+import qualified Sound.ALSA.Sequencer.Client.Info as ClientInfo+import qualified Sound.ALSA.Sequencer.Port.Info as PortInfo+import qualified Sound.ALSA.Sequencer.Client as Client+import qualified Sound.ALSA.Sequencer.Port as Port+import qualified Sound.ALSA.Sequencer as SndSeq+import qualified Data.EnumSet as EnumSet+import Text.Printf (printf, )+import Control.Monad (liftM5, join, )++main :: IO ()+main = do+  putStrLn " Port    Client name                      Port name                Caps"+  SndSeq.withDefault SndSeq.Block $ \h ->+    ClientInfo.queryLoop_ (h :: SndSeq.T SndSeq.OutputMode) $ \cinfo -> do+      client <- ClientInfo.getClient cinfo+      PortInfo.queryLoop_ h client $ \pinfo -> do+        join $ liftM5 (printf "%3d:%-3d  %-32.32s %-24.24s %s\n")+          (fmap (\(Client.Cons p) -> p) $ PortInfo.getClient pinfo)+          (fmap (\(Port.Cons p) -> p) $ PortInfo.getPort pinfo)+          (ClientInfo.getName cinfo)+          (PortInfo.getName pinfo)+          (do+             caps <- PortInfo.getCapability pinfo+             let disp (cap, char) =+                    if EnumSet.disjoint caps cap then ' ' else char+             return $ map disp $+               (Port.capRead, 'r') :+               (Port.capSubsRead, 'R') :+               (Port.capWrite, 'w') :+               (Port.capSubsWrite, 'W') :+               [])

@@ -8,7 +8,7 @@ main :: IO () main = (do   args <- getArgs-  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> forM_ args $ \arg -> do+  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

@@ -3,67 +3,45 @@ Demonstrate how to wait on the end of a performance of events, by sending an Echo message to ourselves. -}+import Common (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.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 qualified System.Exit as Exit-import qualified System.IO as IO import System.Environment (getArgs, )  import Control.Monad (zipWithM_, )  -parseAndConnect ::-   (SndSeq.AllowOutput mode) =>-   SndSeq.T mode -> Port.T -> String -> IO Addr.T-parseAndConnect h p destStr = do-  dest <- Addr.parse h destStr-  SndSeq.connectTo h p dest-  return dest- main :: IO () main = (do-  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> 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-  args <- getArgs-  dest <--     case args of-        [] -> do-           putStrLn "Enter destination or connect to a synthesizer and hit ENTER"-           destStr <- getLine-           if null destStr-             then return Addr.subscribers-             else parseAndConnect h p destStr-        [destStr] ->-           parseAndConnect h p destStr-        _ ->-           IO.hPutStrLn IO.stderr "too many arguments"-           >>-           Exit.exitFailure-   c <- Client.getId h   let me = Addr.Cons c p-      ev t e =-         (Event.simple me e) {+  conn <- parseDestArgs h me =<< getArgs++  let ev t e =+         (Event.forConnection conn e) {              Event.queue = q,-             Event.dest = dest,-             Event.timestamp = Event.TickTime t+             Event.time = Time.consAbs $ Time.Tick t           }-      play t chan pitch vel =+      play t chan pitch =          Event.output h (ev t $-            Event.NoteEv Event.NoteOn $ Event.simpleNote chan pitch vel)+            Event.NoteEv Event.NoteOn $ Event.simpleNote chan pitch Event.normalVelocity)          >>          Event.output h (ev (t+1) $-            Event.NoteEv Event.NoteOn $ Event.simpleNote chan pitch 0)+            Event.NoteEv Event.NoteOff $ Event.simpleNote chan pitch Event.normalVelocity)          >>          return () @@ -73,12 +51,13 @@                Event.dest = me             }) -  Queue.control h q Event.QueueStart 0 Nothing-  Queue.control h q Event.QueueTempo 10000000 Nothing+  Queue.control h q Event.QueueStart Nothing+  Queue.control h q (Event.QueueTempo (Event.Tempo 10000000)) Nothing   zipWithM_ (\t ->-        maybe (echo t) (\n -> play t 0 n 64)) [0..] $+        maybe (echo t) (play t (Event.Channel 0))) [0..] $      (++[Nothing]) $      concat $ concatMap (replicate 4 . map Just) $+     map (map Event.Pitch) $         [57, 59, 60, 64] :         [57, 59, 60, 65] :         [57, 62, 64, 65] :

@@ -1,3 +1,5 @@+import Common (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@@ -5,48 +7,23 @@ import qualified Sound.ALSA.Sequencer as SndSeq import qualified Sound.ALSA.Exception as AlsaExc -import qualified System.Exit as Exit-import qualified System.IO as IO import System.Environment (getArgs, ) -parseAndConnect ::-   (SndSeq.AllowOutput mode) =>-   SndSeq.T mode -> Port.T -> String -> IO Addr.T-parseAndConnect h p destStr = do-  dest <- Addr.parse h destStr-  SndSeq.connectTo h p dest-  return dest  main :: IO () main = (do   putStrLn "Starting."-  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do+  SndSeq.withDefault SndSeq.Block $ \h -> do   Client.setName (h :: SndSeq.T SndSeq.OutputMode) "Haskell-Send-Note"   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."-  args <- getArgs-  dest <--     case args of-        [] -> do-           putStrLn "Enter destination or connect to a synthesizer and hit ENTER"-           destStr <- getLine-           if null destStr-             then return Addr.subscribers-             else parseAndConnect h p destStr-        [destStr] ->-           parseAndConnect h p destStr-        _ ->-           IO.hPutStrLn IO.stderr "too many arguments"-           >>-           Exit.exitFailure-+  conn <- parseDestArgs h (Addr.Cons c p) =<< getArgs   let ev n =-         (Event.simple (Addr.Cons c p) $-            Event.NoteEv n $ Event.simpleNote 0 60 64)-         {Event.dest = dest}+         Event.forConnection conn $ Event.NoteEv n $+            Event.simpleNote (Event.Channel 0) (Event.Pitch 60) Event.normalVelocity   _ <- Event.outputDirect h $ ev Event.NoteOn   putStrLn "press Enter for stopping the note"   _ <- getChar

@@ -0,0 +1,46 @@+import Common (parseDestArgs, )++import qualified Sound.ALSA.Sequencer.Connect as Connect+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 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"+  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++  putStrLn "enter a text line for submission as SysEx message"+  text <- getLine+  let dat =+         Event.ExtEv Event.SysEx $+         B.pack $ map (fromIntegral . fromEnum) text+  _ <- Event.outputDirect h $ Event.forConnection conn dat+  _ <- Event.outputDirect h $ Event.forConnection (Connect.Cons me me) dat+  let waitForSysEx = do+         ev <- Event.input h+         case Event.body ev of+            Event.ExtEv Event.SysEx str ->+               putStrLn $ "got: " ++ show str+            _ -> waitForSysEx+  waitForSysEx+  return ())+  `AlsaExc.catch` \e ->+     putStrLn $ "alsa_exception: " ++ AlsaExc.show e

@@ -1,42 +1,41 @@ module Sound.ALSA.Sequencer.Client.Info.EventFilter where -import qualified Sound.ALSA.Sequencer.Area as Area+import Sound.ALSA.Sequencer.Marshal.ClientInfo (T, T_, with, ) import qualified Sound.ALSA.Sequencer.Marshal.Event as Event -import Foreign.C.Types(CInt, )+import qualified Foreign.C.Types as C import Foreign.Ptr(Ptr, )  -type T  = Area.ClientInfo-type T_ = Area.ClientInfo_-- clear :: T -> IO () add :: Event.Type e => T -> e -> IO () delete :: Event.Type e => T -> e -> IO () check :: Event.Type e => T -> e -> IO Bool  -clear i =-  Area.with_client_info i snd_seq_client_info_event_filter_clear+clear i = with i clear_  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_event_filter_clear"-  snd_seq_client_info_event_filter_clear :: Ptr T_ -> IO ()+  clear_ :: Ptr T_ -> IO ()  add i e =-  Area.with_client_info i (`snd_seq_client_info_event_filter_add` fromIntegral (Event.expEv e))+  with i (flip add_ $ unpackEType e)  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_event_filter_add"-  snd_seq_client_info_event_filter_add :: Ptr T_ -> CInt -> IO ()+  add_ :: Ptr T_ -> C.CInt -> IO ()  delete i e =-  Area.with_client_info i (`snd_seq_client_info_event_filter_del` fromIntegral (Event.expEv e))+  with i (flip del_ $ unpackEType e)  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_event_filter_del"-  snd_seq_client_info_event_filter_del :: Ptr T_ -> CInt -> IO ()+  del_ :: Ptr T_ -> C.CInt -> IO ()  check i e =-  fmap (/= 0) $ Area.with_client_info i (`snd_seq_client_info_event_filter_check` fromIntegral (Event.expEv e))+  fmap (/= 0) $ with i (flip check_ $ unpackEType e)  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_event_filter_check"-  snd_seq_client_info_event_filter_check :: Ptr T_ -> CInt -> IO CInt+  check_ :: Ptr T_ -> C.CInt -> IO C.CInt+++unpackEType :: Event.Type e => e -> C.CInt+unpackEType e = fromIntegral $ Event.unEType $ Event.expEv e

@@ -1,7 +1,7 @@ -- | Emulate new api using the old functions module Sound.ALSA.Sequencer.Client.Info.EventFilter where -import qualified Sound.ALSA.Sequencer.Area as Area+import Sound.ALSA.Sequencer.Marshal.ClientInfo (T, T_, with, ) import qualified Sound.ALSA.Sequencer.Marshal.Event as Event  import Foreign.C.Types (CUInt, )@@ -11,9 +11,6 @@ import Data.Bits (testBit, setBit, clearBit, )  -type T  = Area.ClientInfo-type T_ = Area.ClientInfo_- {- | Although alsa/seq.h says CUChar, that's not true, because internally it uses CUInt and@@ -28,13 +25,12 @@ delete :: Event.Type e => T -> e -> IO () check :: Event.Type e => T -> e -> IO Bool -clear i =-  Area.with_client_info i (`snd_seq_client_info_set_event_filter` nullPtr)+clear i = with i (flip set_ nullPtr)  bit :: Event.Type e => e -> (Int, Int) bit e =   divMod-    (fromIntegral $ Event.expEv e)+    (fromIntegral $ Event.unEType $ Event.expEv e)     (8 * sizeOf (undefined :: EventTypeSubset))  size :: Int@@ -42,7 +38,7 @@   -- succ $ fst $ bit Event.maxEventType  get :: T -> IO EventTypeSet-get i = Area.with_client_info i snd_seq_client_info_get_event_filter+get i = with i get_  check i e = do   ef <- get i@@ -51,8 +47,7 @@   return $ testBit w b  set :: T -> EventTypeSet -> IO ()-set i ef =-  Area.with_client_info i (`snd_seq_client_info_set_event_filter` ef)+set i ef = with i (flip set_ ef)  modify :: T -> (EventTypeSet -> IO ()) -> IO () modify i f =@@ -74,7 +69,7 @@ delete = modifyByte clearBit  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_get_event_filter"-  snd_seq_client_info_get_event_filter :: Ptr T_ -> IO EventTypeSet+  get_ :: Ptr T_ -> IO EventTypeSet  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_set_event_filter"-  snd_seq_client_info_set_event_filter :: Ptr T_ -> EventTypeSet -> IO ()+  set_ :: Ptr T_ -> EventTypeSet -> IO ()

@@ -26,8 +26,10 @@   , BlockMode(..)    , open+  , openDefault   , close   , with+  , withDefault   , defaultName   , getName   , setBlocking@@ -44,20 +46,7 @@   , resetPoolOutput   , setPoolInput   , resetPoolInput---  -- ** Connections-  , connectFrom-  , connectTo-  , disconnectFrom-  , disconnectTo   ) where  import Sound.ALSA.Sequencer.Marshal.Sequencer as Seq import Sound.ALSA.Sequencer.Sequencer------ | This is the name that should be passed to 'open' in most cases.-defaultName :: String-defaultName = "default"

@@ -1,20 +1,39 @@ module Sound.ALSA.Sequencer.Address   ( Addr.T(Addr.Cons, Addr.client, Addr.port)+  , Addr.unknown   , Addr.subscribers+  , Addr.broadcast+  , Addr.systemTimer+  , Addr.systemAnnounce   , parse   ) where  import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr-import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as MSeq-import qualified Sound.ALSA.Sequencer.Sequencer as Seq+import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified Sound.ALSA.Exception as Exc +import qualified Foreign.C.Types as C+import Foreign.C.String (CString, withCAString, )+import Foreign.Ptr (Ptr, )+import Foreign.Marshal.Alloc (alloca, )+import Foreign.Storable (peek, )++ {- | Parse the given string into sequencer address. The client and port are separated by either colon or period, e.g. 128:1.-The function also accepts client names.+The function also accepts client names or prefixes thereof.+Throws @(Errno 2)@ exception if no client name matches. -} parse-  :: MSeq.T mode  -- ^ Sequencer handle.+  :: Seq.T mode  -- ^ Sequencer handle.   -> String       -- ^ String to be parsed.   -> IO Addr.T    -- ^ The parsed address.-parse = Seq.parseAddress+parse (Seq.Cons h) s =+  alloca $ \pa ->+  withCAString s $ \ps ->+    do Exc.checkResult_ "Address.parse" =<< snd_seq_parse_address h pa ps+       peek pa++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_parse_address"+  snd_seq_parse_address :: Ptr Seq.Core -> Ptr Addr.T -> CString -> IO C.CInt

@@ -0,0 +1,188 @@+#include <stdio.h>++#define hsc_alignment(t) \+    printf("(%ld)", (unsigned long)offsetof(struct {char x__; t (y__); }, y__));++char *area_name = NULL;++#define hsc_area(y) \+    area_name = ""y""; \+    puts( \+        "data T_\n" \+        "newtype T = Cons (Area.ForeignPtr T_)\n" \+        "\n" \+        "with :: T -> (Area.Ptr T_ -> IO a) -> IO a\n" \+        "with (Cons p) f = Area.withForeignPtr p f\n" \+        "\n" \+        "-- | Allocate an uninitialized object. (Not exported)\n" \+        "malloc :: IO T\n" \+        "malloc = Area.alloca $ \\p ->\n" \+        "  do Exc.checkResult_ \"Sequencer."y"\" =<< malloc_ p\n" \+        "     fmap Cons (Area.newForeignPtr free =<< Area.peek p)\n" \+        "\n" \+        "foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_malloc\"\n" \+        "  malloc_ :: Area.Ptr (Area.Ptr T_) -> IO C.CInt\n" \+        "\n" \+        "foreign import ccall unsafe \"alsa/asoundlib.h &snd_seq_"y"_free\"\n" \+        "  free :: Area.FunPtr (Area.Ptr T_ -> IO ())\n" \+        "\n" \+        "-- | Copy the content of one object into another.\n" \+        "copy\n" \+        "  :: T     -- ^ Destination\n" \+        "  -> T     -- ^ Source\n" \+        "  -> IO ()\n" \+        "\n" \+        "copy to from =\n" \+        "  with to $ \\p1 ->\n" \+        "  with from $ \\p2 ->\n" \+        "    copy_ p1 p2\n" \+        "\n" \+        "foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_copy\"\n" \+        "  copy_ :: Area.Ptr T_ -> Area.Ptr T_ -> IO ()\n" \+        "\n" \+        "-- | Copy the content of an object to a newly created object.\n" \+        "clone :: T -> IO T\n" \+        "clone from =\n" \+        "  do to <- malloc\n" \+        "     copy to from\n" \+        "     return to\n" \+        "\n" \+        "instance Area.C T where\n" \+        "  malloc = malloc\n" \+        "  copy = copy\n" \+        "  clone = clone\n" \+        "\n" \+    );++#define hsc_get_area(x) \+    printf( \+        "get :: Seq.T mode -> "x" -> IO T\n" \+        "get h q =\n" \+        "  do status <- malloc\n" \+        "     Exc.checkResult_ \"get_%s\"\n" \+        "       =<< with status (get_ h q)\n" \+        "     return status\n" \+        "\n" \+        "foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_get_%s\"\n" \+        "  get_ :: Seq.T mode -> "x" -> Area.Ptr T_ -> IO C.CInt\n" \+    , area_name, area_name);++#define hsc_set_area(x) \+    printf( \+        "set :: Seq.T mode -> "x" -> T -> IO ()\n" \+        "set h q info =\n" \+        "  Exc.checkResult_ \"set_%s\" =<< with info (set_ h q)\n" \+        "\n" \+        "foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_set_%s\"\n" \+        "  set_ :: Seq.T mode -> "x" -> Area.Ptr T_ -> IO C.CInt\n" \+    , area_name, area_name);++++#define hsc_get_set_name() \+    printf( \+        "getName :: T -> IO String\n" \+        "getName i = Area.peekCString =<< with i getName_\n" \+        "\n" \+        "foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_%s_get_name\"\n" \+        "  getName_ :: Area.Ptr T_ -> IO Area.CString\n" \+        "\n" \+        "setName :: T -> String -> IO ()\n" \+        "setName i c =\n" \+        "  Area.withCAString c $ \\p -> with i (flip setName_ p)\n" \+        "\n" \+        "foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_%s_set_name\"\n" \+        "  setName_ :: Area.Ptr T_ -> Area.CString -> IO ()\n" \+        "\n" \+    , area_name, area_name);++#define hsc_get_bool(z,nm) \+    printf( \+        "get"nm" :: T -> IO Bool\n" \+        "get"nm" i =\n" \+        "  fmap (0 /=) $ with i get"nm"_\n" \+        "\n" \+        "foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_%s_get_"z"\"\n" \+        "  get"nm"_ :: Area.Ptr T_ -> IO C.CInt\n" \+        "\n" \+    , area_name);++#define hsc_set_bool(z,nm) \+    printf( \+        "set"nm" :: T -> Bool -> IO ()\n" \+        "set"nm" i c =\n" \+        "  let x = if c then 1 else 0\n" \+        "  in  with i (flip set"nm"_ x)\n" \+        "\n" \+        "foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_%s_set_"z"\"\n" \+        "  set"nm"_ :: Area.Ptr T_ -> C.CInt -> IO ()\n" \+        "\n" \+    , area_name);++#define hsc_get_set_bool(z,nm) \+    hsc_get_bool(z,nm) \+    hsc_set_bool(z,nm)++#define hsc_get_int_gen(z,nm,t,mk,int) \+    printf( \+        "get"nm" :: T -> IO "t"\n" \+        "get"nm" i =\n" \+        "  fmap "mk" $ with i get"nm"_\n" \+        "\n" \+        "foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_%s_get_"z"\"\n" \+        "  get"nm"_ :: Area.Ptr T_ -> IO "int"\n" \+        "\n" \+    , area_name);++#define hsc_set_int_gen(z,nm,t,brk,int) \+    printf( \+        "set"nm" :: T -> "t" -> IO ()\n" \+        "set"nm" i c =\n" \+        "  with i (flip set"nm"_ ("brk" c))\n" \+        "\n" \+        "foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_%s_set_"z"\"\n" \+        "  set"nm"_  :: Area.Ptr T_ -> "int" -> IO ()\n" \+        "\n" \+    , area_name);++#define hsc_get_set_int_gen(z,nm,t,mk,brk,int) \+    hsc_get_int_gen(z,nm,t,mk,int) \+    hsc_set_int_gen(z,nm,t,brk,int)+++#define hsc_get_int(z,nm,t,mk) \+    hsc_get_int_gen(z,nm,t,mk,"C.CInt")++#define hsc_set_int(z,nm,t,brk) \+    hsc_set_int_gen(z,nm,t,brk,"C.CInt")++#define hsc_get_set_int(z,nm,t,mk,brk) \+    hsc_get_int(z,nm,t,mk) \+    hsc_set_int(z,nm,t,brk)+++#define hsc_get_ptr(z,nm,t) \+    printf( \+        "get"nm" :: T -> IO "t"\n" \+        "get"nm" i =\n" \+        "  Area.peek =<< with i get"nm"_\n" \+        "\n" \+        "foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_%s_get_"z"\"\n" \+        "  get"nm"_ :: Area.Ptr T_ -> IO (Area.Ptr "t")\n" \+        "\n" \+    , area_name);++#define hsc_set_ptr(z,nm,t) \+    printf( \+        "set"nm" :: T -> "t" -> IO ()\n" \+        "set"nm" i c =\n" \+        "  with i (\\iptr -> Area.with c (set"nm"_ iptr))\n" \+        "\n" \+        "foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_%s_set_"z"\"\n" \+        "  set"nm"_  :: Area.Ptr T_ -> (Area.Ptr "t") -> IO ()\n" \+        "\n" \+    , area_name);++#define hsc_get_set_ptr(z,nm,t) \+    hsc_get_ptr(z,nm,t) \+    hsc_set_ptr(z,nm,t)

@@ -0,0 +1,38 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Sound.ALSA.Sequencer.Area+-- Copyright : (c) Henning Thielemann, 2010-2012+--             (c) Iavor S. Diatchki, 2007+-- License   : BSD3+--+-- Maintainer: Henning Thielemann+-- Stability : provisional+--+-- PRIVATE MODULE.+--+-- Here we have macros to deal with the various information+-- areas present in the library.+--------------------------------------------------------------------------------++module Sound.ALSA.Sequencer.Area (+  C(..),+  MU.with,+  MA.alloca,+  St.peek,+  Ptr.Ptr, Ptr.FunPtr,+  FPtr.ForeignPtr, FPtr.newForeignPtr, FPtr.withForeignPtr,+  CStr.CString, CStr.peekCString, CStr.withCAString,+  ) where++import qualified Foreign.Marshal.Utils as MU+import qualified Foreign.Marshal.Alloc as MA+import qualified Foreign.C.String as CStr+import qualified Foreign.Storable as St+import qualified Foreign.ForeignPtr as FPtr+import qualified Foreign.Ptr as Ptr+++class C area where+   malloc :: IO area+   copy :: area -> area -> IO ()+   clone :: area -> IO area

@@ -1,315 +0,0 @@------------------------------------------------------------------------------------ |--- Module    : Sound.ALSA.Sequencer.Area--- Copyright : (c) Henning Thielemann, 2010---             (c) Iavor S. Diatchki, 2007--- License   : BSD3------ Maintainer: Henning Thielemann--- Stability : provisional------ PRIVATE MODULE.------ Here we have macros to deal with the various information--- areas present in the library.-----------------------------------------------------------------------------------module Sound.ALSA.Sequencer.Area where--import qualified Sound.ALSA.Sequencer.Marshal.Client as Client-import qualified Sound.ALSA.Sequencer.Marshal.Port as Port-import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue-import qualified Sound.ALSA.Sequencer.Marshal.QueueTimer as QueueTimer-import qualified Sound.ALSA.Sequencer.Marshal.QuerySubscribe as QuerySubscribe-import qualified Sound.ALSA.Exception as Exc--import qualified Data.EnumSet as EnumSet-import Foreign.C.Types (CInt, )-import Foreign.C.String (CString, peekCString, withCAString, )-import Foreign.Storable (Storable, peek, )-import Foreign.Marshal.Alloc (alloca, )-import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr, )-import Foreign.Ptr (Ptr, FunPtr, )-import Data.Word (Word, )---class C area where-   malloc :: IO area-   copy :: area -> area -> IO ()-   clone :: area -> IO area--#{let area x,y =-"data "x"_\n"-"newtype "x" = "x" (ForeignPtr "x"_)\n"-"\n"-"with_"y" :: "x" -> (Ptr "x"_ -> IO a) -> IO a\n"-"with_"y" ("x" p) f = withForeignPtr p f\n"-"\n"-"-- | Allocate an uninitialized object. (Not exported)\n"-y"_malloc :: IO "x"\n"-y"_malloc = alloca $ \\p ->\n"-"  do Exc.checkResult_ \"Sequencer."y"\" =<< snd_seq_"y"_malloc p\n"-"     "x" `fmap` (newForeignPtr snd_seq_"y"_free =<< peek p)\n"-"\n"-"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_malloc\"\n"-"  snd_seq_"y"_malloc :: Ptr (Ptr "x"_) -> IO CInt\n"-"\n"-"foreign import ccall unsafe \"alsa/asoundlib.h &snd_seq_"y"_free\"\n"-"   snd_seq_"y"_free :: FunPtr (Ptr "x"_ -> IO ())\n"-"\n"-"-- | Copy the content of one object into another.\n"-y"_copy\n"-"  :: "x"     -- ^ Destination\n"-"  -> "x"     -- ^ Source\n"-"  -> IO ()\n"-"\n"-y"_copy to from =\n"-"  with_"y" to $ \\p1 ->\n"-"  with_"y" from $ \\p2 ->\n"-"    snd_seq_"y"_copy p1 p2\n"-"\n"-"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_copy\"\n"-"  snd_seq_"y"_copy :: Ptr "x"_ -> Ptr "x"_ -> IO ()\n"-"\n"-"-- | Copy the content of an object to a newly created object.\n"-y"_clone :: "x" -> IO "x"\n"-y"_clone from =\n"-"  do to <- "y"_malloc\n"-"     "y"_copy to from\n"-"     return to\n"-"\n"-"instance C "x" where\n"-"  malloc = "y"_malloc\n"-"  copy = "y"_copy\n"-"  clone = "y"_clone\n"-}--#{let get_set_name x,y =-y"_get_name :: "x" -> IO String\n"-y"_get_name i = peekCString =<< with_"y" i snd_seq_"y"_get_name\n"-"\n"-"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_get_name\"\n"-"  snd_seq_"y"_get_name :: Ptr "x"_ -> IO CString\n"-"\n"-y"_set_name :: "x" -> String -> IO ()\n"-y"_set_name i c =\n"-"  withCAString c $ \\p -> with_"y" i (`snd_seq_"y"_set_name` p)\n"-"\n"-"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_set_name\"\n"-"  snd_seq_"y"_set_name :: Ptr "x"_ -> CString -> IO ()\n"-}--#{let get_bool x,y,z =-y"_get_"z" :: "x" -> IO Bool\n"-y"_get_"z" i =\n"-"  (0 /=) `fmap` with_"y" i snd_seq_"y"_get_"z"\n"-"\n"-"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_get_"z"\"\n"-"  snd_seq_"y"_get_"z" :: Ptr "x"_ -> IO CInt\n"-}--#{let get_set_bool x,y,z =-y"_get_"z" :: "x" -> IO Bool\n"-y"_get_"z" i =\n"-"  (0 /=) `fmap` with_"y" i snd_seq_"y"_get_"z"\n"-"\n"-"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_get_"z"\"\n"-"  snd_seq_"y"_get_"z" :: Ptr "x"_ -> IO CInt\n"-"\n"-y"_set_"z" :: "x" -> Bool -> IO ()\n"-y"_set_"z" i c =\n"-"  let x = if c then 1 else 0\n"-"  in with_"y" i (`snd_seq_"y"_set_"z"` x)\n"-"\n"-"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_set_"z"\"\n"-"  snd_seq_"y"_set_"z" :: Ptr "x"_ -> CInt -> IO ()\n"-}--#{let get_int x,y,z,t,mk =-y"_get_"z" :: "x" -> IO "t"\n"-y"_get_"z" i =\n"-"  "mk"\n"-"      `fmap` with_"y" i snd_seq_"y"_get_"z"\n"-"\n"-"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_get_"z"\"\n"-"  snd_seq_"y"_get_"z" :: Ptr "x"_ -> IO CInt\n"-}--#{let set_int x,y,z,t,brk =-y"_set_"z" :: "x" -> "t" -> IO ()\n"-y"_set_"z" i c =\n"-"  with_"y" i (`snd_seq_"y"_set_"z"` "brk" c)\n"-"\n"-"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_set_"z"\"\n"-"  snd_seq_"y"_set_"z"  :: Ptr "x"_ -> CInt -> IO ()\n"-}------ Client.T Info ------------------------------------------------------------------#area "ClientInfo",  "client_info"---- read/write-#get_set_name "ClientInfo", "client_info"-#get_set_bool "ClientInfo", "client_info", "broadcast_filter"-#get_set_bool "ClientInfo", "client_info", "error_bounce"-#{get_int "ClientInfo", "client_info", "client",-          "Client.T", "Client.imp"}-#{set_int "ClientInfo", "client_info", "client",-          "Client.T", "Client.exp"}---- read only-#{get_int "ClientInfo", "client_info", "type",-          "Client.Type", "Client.impType"}-#{get_int "ClientInfo", "client_info", "num_ports",-          "Word", "fromIntegral"}-#{get_int "ClientInfo", "client_info", "event_lost",-          "Word", "fromIntegral"}----- Port Info --------------------------------------------------------------------#area "PortInfo",    "port_info"---- read/write-#get_set_name "PortInfo", "port_info"--#get_set_bool "PortInfo", "port_info", "port_specified"-#get_set_bool "PortInfo", "port_info", "timestamping"-#get_set_bool "PortInfo", "port_info", "timestamp_real"--#{get_int "PortInfo", "port_info", "port",-          "Port.T", "Port.imp"}-#{set_int "PortInfo", "port_info", "port",-          "Port.T", "Port.exp"}-#{get_int "PortInfo", "port_info", "client",-          "Client.T","Client.imp"}-#{set_int "PortInfo", "port_info", "client",-          "Client.T","Client.exp"}-#{get_int "PortInfo", "port_info", "capability",-          "Port.Cap","(EnumSet.Cons . fromIntegral)"}-#{set_int "PortInfo", "port_info", "capability",-          "Port.Cap","(fromIntegral . EnumSet.decons)"}--#{get_int "PortInfo", "port_info", "midi_channels",-          "Word","fromIntegral"}-#{set_int "PortInfo", "port_info", "midi_channels",-          "Word","fromIntegral"}-#{get_int "PortInfo", "port_info", "midi_voices",-          "Word","fromIntegral"}-#{set_int "PortInfo", "port_info", "midi_voices",-          "Word","fromIntegral"}-#{get_int "PortInfo", "port_info", "synth_voices",-          "Word","fromIntegral"}-#{set_int "PortInfo", "port_info", "synth_voices",-          "Word","fromIntegral"}--#{get_int "PortInfo", "port_info", "timestamp_queue",-          "Queue.T","Queue.imp"}-#{set_int "PortInfo", "port_info", "timestamp_queue",-          "Queue.T","Queue.exp"}---- read only-#{get_int "PortInfo", "port_info", "read_use",-          "Word","fromIntegral"}-#{get_int "PortInfo", "port_info", "write_use",-          "Word","fromIntegral"}---- Subscribe Port -----------------------------------------------------------------#area "PortSubscribe",	"port_subscribe"--#{get_int "PortSubscribe", "port_subscribe", "queue",-           "Queue.T","Queue.imp"}-#{set_int "PortSubscribe", "port_subscribe", "queue",-           "Queue.T","Queue.exp"}-#get_set_bool "PortSubscribe", "port_subscribe", "exclusive"-#get_set_bool "PortSubscribe", "port_subscribe", "time_update"-#get_set_bool "PortSubscribe", "port_subscribe", "time_real"---- Subscribe Query ----------------------------------------------------------------#area "QuerySubscribe", "query_subscribe"--#{get_int "QuerySubscribe", "query_subscribe", "client",-          "Client.T", "Client.imp"}-#{set_int "QuerySubscribe", "query_subscribe", "client",-          "Client.T", "Client.exp"}-#{get_int "QuerySubscribe", "query_subscribe", "port",-          "Port.T", "Port.imp"}-#{set_int "QuerySubscribe", "query_subscribe", "port",-          "Port.T", "Port.exp"}-#{get_int "QuerySubscribe", "query_subscribe", "type",-          "QuerySubscribe.Type", "QuerySubscribe.impType"}-#{set_int "QuerySubscribe", "query_subscribe", "type",-          "QuerySubscribe.Type", "QuerySubscribe.expType"}-#{get_int "QuerySubscribe", "query_subscribe", "index",-          "Word", "fromIntegral"}-#{set_int "QuerySubscribe", "query_subscribe", "index",-          "Word", "fromIntegral"}---- RO-#{get_int "QuerySubscribe", "query_subscribe", "num_subs",-          "Word", "fromIntegral"}-#{get_int "QuerySubscribe", "query_subscribe", "queue",-          "Queue.T", "Queue.imp"}-#get_bool "QuerySubscribe", "query_subscribe", "exclusive"-#get_bool "QuerySubscribe", "query_subscribe", "time_update"-#get_bool "QuerySubscribe", "query_subscribe", "time_real"---- Queue.T Info -------------------------------------------------------------------#area "QueueInfo",   "queue_info"-#get_set_name "QueueInfo", "queue_info"-#get_set_bool "QueueInfo", "queue_info", "locked"--#{get_int "QueueInfo", "queue_info", "owner",-          "Client.T", "Client.imp"}-#{set_int "QueueInfo", "queue_info", "owner",-          "Client.T", "Client.exp"}-#{get_int "QueueInfo", "queue_info", "flags",-          "Word", "fromIntegral"}-#{set_int "QueueInfo", "queue_info", "flags",-          "Word", "fromIntegral"}---- RO-#{get_int "QueueInfo", "queue_info", "queue",-           "Queue.T","Queue.imp"}---- Queue.T Status -----------------------------------------------------------------#area "QueueStatus", "queue_status"---- Queue.T Tempo ------------------------------------------------------------------#area "QueueTempo",  "queue_tempo"---- RO-#{get_int "QueueTempo", "queue_tempo", "queue",-           "Queue.T","Queue.imp"}---- RW-#{get_int "QueueTempo", "queue_tempo", "tempo", "Word", "fromIntegral"}-#{set_int "QueueTempo", "queue_tempo", "tempo", "Word", "fromIntegral"}--#{get_int "QueueTempo", "queue_tempo", "ppq", "Int", "fromIntegral"}-#{set_int "QueueTempo", "queue_tempo", "ppq", "Int", "fromIntegral"}--#{get_int "QueueTempo", "queue_tempo", "skew", "Word", "fromIntegral"}-#{set_int "QueueTempo", "queue_tempo", "skew", "Word", "fromIntegral"}--#{get_int "QueueTempo", "queue_tempo", "skew_base", "Word", "fromIntegral"}-#{set_int "QueueTempo", "queue_tempo", "skew_base", "Word", "fromIntegral"}---- Queue.T Timer ------------------------------------------------------------------#area "QueueTimer",  "queue_timer"----- RO-#{get_int "QueueTimer", "queue_timer", "queue",-           "Queue.T","Queue.imp"}---- RW--#{get_int "QueueTimer", "queue_timer", "type",-            "QueueTimer.Type", "QueueTimer.impType"}-#{set_int "QueueTimer", "queue_timer", "type",-            "QueueTimer.Type", "QueueTimer.expType"}--#{get_int "QueueTimer", "queue_timer", "resolution", "Word", "fromIntegral"}-#{set_int "QueueTimer", "queue_timer", "resolution", "Word", "fromIntegral"}-

@@ -14,7 +14,7 @@ --------------------------------------------------------------------------------  module Sound.ALSA.Sequencer.Client-  ( Client.T+  ( Client.T(Client.Cons)   , Client.unknown   , Client.system   , Client.subscribers@@ -26,7 +26,7 @@   , Client.Type(..)   ) where -import qualified Sound.ALSA.Sequencer.Client.Info as ClientInfo+import qualified Sound.ALSA.Sequencer.Client.InfoMonad as ClientInfo  import qualified Sound.ALSA.Sequencer.Marshal.Client as Client import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq@@ -41,12 +41,9 @@ -- | Get the client identifier for the sequencer. -- A convinience function. getId :: Seq.T mode -> IO Client.T-getId h = ClientInfo.getClient =<< ClientInfo.get h+getId h = ClientInfo.get h ClientInfo.getClient  -- | Set the name for the sequencer client. -- A convinience function. setName :: Seq.T mode -> String -> IO ()-setName h s =-  do i <- ClientInfo.get h-     ClientInfo.setName i s-     ClientInfo.set h i+setName h s = ClientInfo.modify h $ ClientInfo.setName s

@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module    : Sound.ALSA.Sequencer.Client--- Copyright : (c) Henning Thielemann, 2010+-- Copyright : (c) Henning Thielemann, 2010-2012 --             (c) Iavor S. Diatchki, 2007 -- License   : BSD3 --@@ -20,8 +20,9 @@   , getAny   , queryFirst   , queryNext+  , queryLoop_+  , queryLoop   , set-  , modify    , copy   , clone@@ -45,84 +46,23 @@   , filterCheck   ) where +import Sound.ALSA.Sequencer.Marshal.ClientInfo+ import qualified Sound.ALSA.Sequencer.Client.Info.EventFilter as Filter -import qualified Sound.ALSA.Sequencer.Marshal.Client as Client import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq-import qualified Sound.ALSA.Sequencer.Area as Area import qualified Sound.ALSA.Sequencer.Marshal.Event as Event-import qualified Sound.ALSA.Exception as Exc--import Foreign.C.Types(CInt, )-import Foreign.Ptr(Ptr, )-import Data.Word (Word, )--import Control.Monad (guard, )-------------------------------------------------------------------------------------type T  = Area.ClientInfo-type T_ = Area.ClientInfo_---- | Create a new information area filled with data about the sequencer client.-get :: Seq.T mode -> IO T-get (Seq.Cons h) =-  do info <- Area.client_info_malloc-     Exc.checkResult_ "get_client_info" =<< Area.with_client_info info (snd_seq_get_client_info h)-     return info--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_client_info"-  snd_seq_get_client_info :: Ptr Seq.Core -> Ptr T_ -> IO CInt----- | Create a new information area filled with data about an arbitrary client.-getAny :: Seq.T mode -> Client.T -> IO T-getAny (Seq.Cons h) c =-  do info <- Area.client_info_malloc-     Exc.checkResult_ "get_any_client_info" =<< Area.with_client_info info-                        (snd_seq_get_any_client_info h (Client.exp c))-     return info--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_any_client_info"-  snd_seq_get_any_client_info-    :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt-+import qualified Sound.ALSA.Sequencer.Query as Query   queryFirst :: Seq.T mode -> IO T-queryFirst h =-  do x <- Area.client_info_malloc-     Area.with_client_info x (`Area.snd_seq_client_info_set_client` (-1))-     _b <- queryNext h x-     -- XXX: check that we did get the first client (should be System)-     return x----- | Get information about the client with the next biggest identifier.-queryNext :: Seq.T mode -> T-                    -> IO Bool  -- ^ Was there a next client?-queryNext (Seq.Cons h) info =-  Exc.checkResultMaybe "query_next_client"-         (const True) (\x -> guard (x == -2) >> return False)-      =<< Area.with_client_info info (snd_seq_query_next_client h)--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_next_client"-  snd_seq_query_next_client :: Ptr Seq.Core -> Ptr T_ -> IO CInt----- | Set the information for the sequencer client based on the data--- in the given information area.-set :: Seq.T mode -> T -> IO ()-set (Seq.Cons h) info =-  Exc.checkResult_ "set_client_info" =<< Area.with_client_info info (snd_seq_set_client_info h)--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_client_info"-  snd_seq_set_client_info :: Ptr Seq.Core -> Ptr T_ -> IO CInt+queryFirst = Query.first +queryLoop_ :: Seq.T mode -> (T -> IO ()) -> IO ()+queryLoop_ h = Query.loop_ h (const $ return ()) -modify :: Seq.T mode -> (T -> IO T) -> IO ()-modify ss f = set ss =<< f =<< get ss+queryLoop :: Seq.T mode -> (T -> IO a) -> IO [a]+queryLoop h = Query.loop h (const $ return ())   filterClear :: T -> IO ()@@ -134,32 +74,3 @@ filterAdd   = Filter.add filterDel   = Filter.delete filterCheck = Filter.check---copy :: T -> T -> IO ()-clone :: T -> IO T-getClient :: T -> IO Client.T-getType :: T -> IO Client.Type-getName :: T -> IO String-getBroadcastFilter :: T -> IO Bool-getErrorBounce :: T -> IO Bool-getNumPorts :: T -> IO Word-getEventLost :: T -> IO Word-setClient :: T -> Client.T -> IO ()-setName :: T -> String -> IO ()-setBroadcastFilter :: T -> Bool -> IO ()-setErrorBounce :: T -> Bool -> IO ()--copy               = Area.client_info_copy-clone              = Area.client_info_clone-getClient          = Area.client_info_get_client-getType            = Area.client_info_get_type-getName            = Area.client_info_get_name-getBroadcastFilter = Area.client_info_get_broadcast_filter-getErrorBounce     = Area.client_info_get_error_bounce-getNumPorts        = Area.client_info_get_num_ports-getEventLost       = Area.client_info_get_event_lost-setClient          = Area.client_info_set_client-setName            = Area.client_info_set_name-setBroadcastFilter = Area.client_info_set_broadcast_filter-setErrorBounce     = Area.client_info_set_error_bounce

@@ -0,0 +1,82 @@+module Sound.ALSA.Sequencer.Client.InfoMonad (+  T,++  run,+  get,+  modify,++  getClient,+  getType,+  getName,+  getBroadcastFilter,+  getErrorBounce,+  getNumPorts,+  getEventLost,++  setClient,+  setName,+  setBroadcastFilter,+  setErrorBounce,+  ) where++import qualified Sound.ALSA.Sequencer.Marshal.ClientInfo as ClientInfo+import qualified Sound.ALSA.Sequencer.Marshal.Client as Client+import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq++import qualified Control.Monad.Trans.Reader as MR+import Control.Applicative (Applicative, )++import Data.Word (Word, )+++newtype T a = Cons (MR.ReaderT ClientInfo.T IO a)+   deriving (Functor, Applicative, Monad)+++run :: T a -> ClientInfo.T -> IO a+run (Cons m) = MR.runReaderT m++get :: Seq.T mode -> T a -> IO a+get h m = run m =<< ClientInfo.get h++modify :: Seq.T mode -> T a -> IO a+modify h m = do+  i <- ClientInfo.get h+  a <- run m i+  ClientInfo.set h i+  return a+++liftGet :: (ClientInfo.T -> IO a) -> T a+liftGet f = Cons $ MR.ReaderT f++liftSet :: (ClientInfo.T -> b -> IO a) -> b -> T a+liftSet f x = Cons $ MR.ReaderT $ flip f x+++getClient :: T Client.T+getType :: T Client.Type+getName :: T String+getBroadcastFilter :: T Bool+getErrorBounce :: T Bool+getNumPorts :: T Word+getEventLost :: T Word++getClient          = liftGet ClientInfo.getClient+getType            = liftGet ClientInfo.getType+getName            = liftGet ClientInfo.getName+getBroadcastFilter = liftGet ClientInfo.getBroadcastFilter+getErrorBounce     = liftGet ClientInfo.getErrorBounce+getNumPorts        = liftGet ClientInfo.getNumPorts+getEventLost       = liftGet ClientInfo.getEventLost+++setClient :: Client.T -> T ()+setName :: String -> T ()+setBroadcastFilter :: Bool -> T ()+setErrorBounce :: Bool -> T ()++setClient          = liftSet ClientInfo.setClient+setName            = liftSet ClientInfo.setName+setBroadcastFilter = liftSet ClientInfo.setBroadcastFilter+setErrorBounce     = liftSet ClientInfo.setErrorBounce

@@ -0,0 +1,107 @@+module Sound.ALSA.Sequencer.Concurrent+  ( threadWaitInput+  , threadWaitOutput+  , threadWaitDuplex++  , input+  , output+  , drainOutput+  ) where++import qualified Sound.ALSA.Sequencer.Poll as AlsaPoll+import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified Sound.ALSA.Sequencer.Event as Event+import Sound.ALSA.Exception (code, )++import Control.Concurrent (yield, threadWaitRead, threadWaitWrite, forkIO, killThread, )+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar, )+import Control.Exception (catchJust, catch, )+import Control.Monad (guard, when, )+import Data.Function (fix, )+import Data.Word (Word, )+import Foreign.C.Error (eINTR, )+import System.IO.Error (isFullError, )+import System.Posix.Types (Fd, )+import qualified System.Posix.Poll as Poll+import qualified Data.EnumSet as EnumSet++import Prelude hiding (catch, )+++data WaitFd+  = WaitRead Fd+  | WaitWrite Fd++pollWaits :: Poll.Fd -> [WaitFd]+pollWaits (Poll.Fd f e _) =+  (if EnumSet.subset Poll.inp e then [WaitRead  f] else []) +++  (if EnumSet.subset Poll.out e then [WaitWrite f] else [])++-- | Wait for any of the given events, like poll, and return the one that is ready+threadWaitPolls :: [WaitFd] -> IO WaitFd+threadWaitPolls [] = yield >> return undefined+threadWaitPolls [p@(WaitRead f)] = threadWaitRead f >> return p+threadWaitPolls [p@(WaitWrite f)] = threadWaitWrite f >> return p+threadWaitPolls l = do+  w <- newEmptyMVar+  let poll1 p = catch (threadWaitPolls [p] >>= putMVar w . Right) (putMVar w . Left)+  t <- mapM (forkIO . poll1) l+  r <- takeMVar w+  mapM_ killThread t+  either ioError return r++threadWaitEvents :: Poll.Events -> Seq.T mode -> IO ()+threadWaitEvents e sh =+  AlsaPoll.descriptors sh e >>=+  threadWaitPolls . concatMap pollWaits >>+  return ()++-- | Wait for new input to be available from the sequencer (even if there is already input in the buffer)+threadWaitInput :: Seq.AllowInput mode => Seq.T mode -> IO ()+threadWaitInput = threadWaitEvents Poll.inp++-- | Wait until new output may be drained from the buffer to the sequencer (even if the output buffer is already empty)+threadWaitOutput :: Seq.AllowOutput mode => Seq.T mode -> IO ()+threadWaitOutput = threadWaitEvents Poll.out++-- | Wait until new input is available or new output may be drained+threadWaitDuplex :: (Seq.AllowInput mode, Seq.AllowOutput mode) => Seq.T mode -> IO ()+threadWaitDuplex = threadWaitEvents (Poll.inp EnumSet..|. Poll.out)++catchFull :: IO a -> IO a -> IO a+catchFull f e = catchJust (guard . isFullError) f (\() -> e)++catchIntr :: IO a -> IO a+catchIntr f = catchJust (guard . (eINTR ==) . code) f (\() -> catchIntr f)++-- | A thread-compatible version of @Sound.ALSA.Sequencer.Event.input@.+-- This call is always blocking (unless there are already event in the input+-- buffer) but will not block other threads.  The sequencer, however, must be+-- set non-blocking or this will not work as expected.+input :: Seq.AllowInput mode => Seq.T mode -> IO Event.T+input sh = do+  n <- catchIntr $ Event.inputPending sh True+  when (n == 0) $ threadWaitInput sh+  fix $ catchFull (Event.input sh) . (threadWaitInput sh >>)++-- | A thread-compatible version of @Sound.ALSA.Sequencer.Event.output@.+-- This call is always blocking (unless there is space in the output+-- buffer) but will not block other threads.  The sequencer, however, must be+-- set non-blocking or this will not work as expected.+output :: Seq.AllowOutput mode => Seq.T mode -> Event.T -> IO Word+output sh ev =+  Event.outputBuffer sh ev `catchFull` do+    threadWaitOutput sh+    _ <- Event.drainOutput sh `catchFull` return (-1)+    output sh ev++-- | A thread-compatible version of @Sound.ALSA.Sequencer.Event.drainBuffer@.+-- This call is always blocking but will not block other threads.  The+-- sequencer, however, must be set non-blocking or this will not work as+-- expected.+drainOutput :: Seq.AllowOutput mode => Seq.T mode -> IO ()+drainOutput sh = do+  n <- Event.drainOutput sh `catchFull` return (-1)+  when (n /= 0) $ do+    threadWaitOutput sh+    drainOutput sh

@@ -0,0 +1,86 @@+module Sound.ALSA.Sequencer.Connect (+   Connect.T(Connect.Cons, Connect.source, Connect.dest),+   reverse,+   toSubscribers, fromSubscribers,++   createFrom, deleteFrom, withFrom,+   createTo,   deleteTo,   withTo,+   ) where++import qualified Sound.ALSA.Sequencer.Marshal.Connect as Connect+import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr+import qualified Sound.ALSA.Sequencer.Marshal.Port as Port+import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified Sound.ALSA.Sequencer.Client as Client+import qualified Sound.ALSA.Exception as Exc++import qualified Foreign.C.Types as C+import Foreign.Ptr (Ptr, )++import Control.Exception (bracket, )++import Prelude hiding (reverse, )+++reverse :: Connect.T -> Connect.T+reverse (Connect.Cons src dst) = Connect.Cons dst src++toSubscribers :: Addr.T -> Connect.T+toSubscribers src = Connect.Cons src Addr.subscribers++fromSubscribers :: Addr.T -> Connect.T+fromSubscribers dst = Connect.Cons Addr.subscribers dst+++-- | Simple subscription (w\/o exclusive & time conversion).+createFrom :: Seq.AllowInput mode => Seq.T mode -> Port.T -> Addr.T -> IO Connect.T+createFrom s@(Seq.Cons h) me a =+  do Exc.checkResult_ "connect_from" =<<+        uncurry (snd_seq_connect_from h (Port.exp me)) (Addr.exp a)+     mec <- Client.getId s+     return $ Connect.Cons a (Addr.Cons mec me)++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_connect_from"+  snd_seq_connect_from :: Ptr Seq.Core -> C.CInt -> C.CInt -> C.CInt -> IO C.CInt+++-- | Simple subscription (w\/o exclusive & time conversion).+createTo :: Seq.AllowOutput mode => Seq.T mode -> Port.T -> Addr.T -> IO Connect.T+createTo s@(Seq.Cons h) me a =+  do Exc.checkResult_ "connect_to" =<<+        uncurry (snd_seq_connect_to h (Port.exp me)) (Addr.exp a)+     mec <- Client.getId s+     return $ Connect.Cons (Addr.Cons mec me) a++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_connect_to"+  snd_seq_connect_to :: Ptr Seq.Core -> C.CInt -> C.CInt -> C.CInt -> IO C.CInt+++-- | Simple disconnection.+deleteFrom :: Seq.AllowInput mode => Seq.T mode -> Port.T -> Addr.T -> IO ()+deleteFrom (Seq.Cons h) me a =+  Exc.checkResult_ "disconnect_from" =<< snd_seq_disconnect_from h (Port.exp me) c p+  where (c,p) = Addr.exp a++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_disconnect_from"+  snd_seq_disconnect_from :: Ptr Seq.Core -> C.CInt -> C.CInt -> C.CInt -> IO C.CInt++-- | Simple disconnection.+deleteTo :: Seq.AllowOutput mode => Seq.T mode -> Port.T -> Addr.T -> IO ()+deleteTo (Seq.Cons h) me a =+  Exc.checkResult_ "disconnect_to" =<< snd_seq_disconnect_to h (Port.exp me) c p+  where (c,p) = Addr.exp a++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_disconnect_to"+  snd_seq_disconnect_to :: Ptr Seq.Core -> C.CInt -> C.CInt -> C.CInt -> IO C.CInt+++-- | Temporary subscription.+withFrom :: Seq.AllowInput mode => Seq.T mode -> Port.T -> Addr.T -> (Connect.T -> IO a) -> IO a+withFrom h me a =+  bracket (createFrom h me a) (const $ deleteFrom h me a)++-- | Temporary subscription.+withTo :: Seq.AllowOutput mode => Seq.T mode -> Port.T -> Addr.T -> (Connect.T -> IO a) -> IO a+withTo h me a =+  bracket (createTo h me a) (const $ deleteTo h me a)

@@ -1,11 +1,11 @@ -------------------------------------------------------------------------------- -- | -- Module    : Sound.ALSA.Sequencer.Event--- Copyright : (c) Henning Thielemann, 2010+-- Copyright : (c) Henning Thielemann, 2011 --             (c) Iavor S. Diatchki, 2007 -- License   : BSD3 ----- Maintainer: Iavor S. Diatchki+-- Maintainer: Henning Thielemann -- Stability : provisional -- -- This module contains functions for working with events.@@ -13,63 +13,125 @@ -- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_event.html> -------------------------------------------------------------------------------- -module Sound.ALSA.Sequencer.Event-  ( syncOutputQueue-  , input-  , inputPending-  , output-  , outputBuffer-  , outputDirect-  , outputPending-  , extractOutput-  , removeOutput-  , drainOutput-  , dropOutput-  , dropOutputBuffer-  , dropInput-  , dropInputBuffer+module Sound.ALSA.Sequencer.Event (+  -- * Output -  , TimeStamp(..)-  , InstrCluster-  , Instr(..)-  , Sample(..)-  , Cluster(..)-  , Volume(..), volumeSame+  -- $trouble -  , Event.T(..), simple-  , Event.Data(..)-  , NoteEv(..), Note(..), simpleNote-  , CtrlEv(..), Ctrl(..)-  , CustomEv(..), Custom(..)-  , QueueEv(..)-  , AddrEv(..)-  , ConnEv(..), Connect-  , EmptyEv(..)+  output,+  outputBuffer,+  outputDirect,+  outputPending,+  extractOutput,+  removeOutput,+  drainOutput,+  dropOutput,+  dropOutputBuffer,+  syncOutputQueue,++  -- * Input++  input,+  inputPending,+  dropInput,+  dropInputBuffer,++  -- * Data types++  Event.T(..), simple, forSourcePort, forConnection,+  Event.Data(..),+  Event.Type,+  NoteEv(..), Note(..), simpleNote,+  CtrlEv(..), Ctrl(..),+  CustomEv(..), Custom(..), customZero,+  ExtEv(..),+  QueueEv(..),+  AddrEv(..),+  ConnEv(..),+  EmptyEv(..),++  Tag(..),+  Tempo(..),++  Parameter(..),+  Value(..),+  Channel(..),+  Pitch(..),+  Velocity(..), normalVelocity, offVelocity,+  Duration(..),++{- available in alsa-1.0.14, but gone in 1.0.22+  Instr(..),+  Sample(..),+  Cluster(..),+  VolumeControl(..),++  InstrCluster(..),+  StandardId(..),+  Bank(..),+  Program(..),+  Volume(..), volumeSame,+  Balance(..),+-}   ) where +import Sound.ALSA.Sequencer.Marshal.Event as Event  import qualified Sound.ALSA.Sequencer.Address as Addr+import qualified Sound.ALSA.Sequencer.Port as Port+import qualified Sound.ALSA.Sequencer.Client as Client+import qualified Sound.ALSA.Sequencer.Connect as Connect import qualified Sound.ALSA.Sequencer.Queue as Queue import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq-import Sound.ALSA.Sequencer.Marshal.Event as Event+import qualified Sound.ALSA.Sequencer.Marshal.Time as Time import qualified Sound.ALSA.Exception as Exc -import Foreign.C.Types (CInt, )+import qualified Foreign.C.Types as C import Foreign.Ptr (Ptr, nullPtr, ) import Foreign.Marshal.Alloc (alloca, ) import Foreign.Storable (peek, ) -import Data.Word (Word, Word8, )-import Data.Int (Int16, )+import Data.Word (Word, )  +{- $trouble+If you send an event but you do not hear something,+then check the following conditions:++* Check whether your event was actually delivered.+  E.g. use the event monitor @aseqdump@ in order to see sent messages.++* If the message was not delivered,+  maybe you quit the program too early+  and thus destroyed pending messages.+  Use 'syncOutputQueue' at the end of the program+  in order to wait for all messages to be sent.++* Make sure the sequencer supports output+  and the target port supports input.++* Make sure to setup a connection to the receiver.++* Make sure to have called 'drainOutput' after 'output'.++* If you use a timestamp in an event,+  make sure you also declare a queue (and create one before).++* Make sure you started the queue you used for sending.++* Be aware of that 'Event.QueueStart' clears the queue before running the queue.+  That is, events sent before 'Event.QueueStart' are deleted.+  If you want to keep these events, then use 'Event.QueueContinue' instead.+-}++ -- | Wait until all events of the client are processed. syncOutputQueue :: Seq.T mode -> IO () syncOutputQueue (Seq.Cons h) =   Exc.checkResult_ "syncOutputQueue" =<< snd_seq_sync_output_queue h  foreign import ccall safe "alsa/asoundlib.h snd_seq_sync_output_queue"-  snd_seq_sync_output_queue :: Ptr Seq.Core -> IO CInt+  snd_seq_sync_output_queue :: Ptr Seq.Core -> IO C.CInt   -- | Get an event from the input buffer.@@ -88,10 +150,10 @@      peek =<< peek p  foreign import ccall safe "alsa/asoundlib.h snd_seq_event_input"-  snd_seq_event_input :: Ptr Seq.Core -> Ptr (Ptr Event.T) -> IO CInt+  snd_seq_event_input :: Ptr Seq.Core -> Ptr (Ptr Event.T) -> IO C.CInt  -checkResult :: String -> CInt -> IO Word+checkResult :: String -> C.CInt -> IO Word checkResult loc n =    fmap fromIntegral $ Exc.checkResult loc n @@ -110,7 +172,7 @@   checkResult "inputPending" =<< snd_seq_event_input_pending h (if fill then 1 else 0)  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_event_input_pending"-  snd_seq_event_input_pending :: Ptr Seq.Core -> Int -> IO CInt+  snd_seq_event_input_pending :: Ptr Seq.Core -> Int -> IO C.CInt   @@ -118,17 +180,17 @@ -- Throws exceptions. -- See also: 'outputDirect', 'outputBuffer', --           'outputPending', 'drainOutput', 'dropOutput',---           'extractOutput', 'removeEvents'+--           'extractOutput', 'removeOutput'  output :: Seq.AllowOutput mode              => Seq.T mode              -> Event.T              -> IO Word   -- ^ the number of remaining events (or bytes?) output (Seq.Cons h) e =-  Event.allocaEv e $ \p -> checkResult "output" =<< snd_seq_event_output h p+  Event.with e $ \p -> checkResult "output" =<< snd_seq_event_output h p  foreign import ccall safe "alsa/asoundlib.h snd_seq_event_output"-  snd_seq_event_output :: Ptr Seq.Core -> Ptr Event.T -> IO CInt+  snd_seq_event_output :: Ptr Seq.Core -> Ptr Event.T -> IO C.CInt   @@ -142,10 +204,10 @@                     -> IO Word  -- ^ the byte size of remaining events  outputBuffer (Seq.Cons h) e =-  Event.allocaEv e $ \p -> checkResult "outputBuffer" =<< snd_seq_event_output_buffer h p+  Event.with e $ \p -> checkResult "outputBuffer" =<< snd_seq_event_output_buffer h p  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_event_output_buffer"-  snd_seq_event_output_buffer :: Ptr Seq.Core -> Ptr Event.T -> IO CInt+  snd_seq_event_output_buffer :: Ptr Seq.Core -> Ptr Event.T -> IO C.CInt   -- | Output an event directly to the sequencer, NOT through the output buffer.@@ -159,10 +221,10 @@   -> IO Word  -- ^ number of bytes sent to the sequencer  outputDirect (Seq.Cons h) e =-  Event.allocaEv e $ \p -> checkResult "outputDirect" =<< snd_seq_event_output_direct h p+  Event.with e $ \p -> checkResult "outputDirect" =<< snd_seq_event_output_direct h p  foreign import ccall safe "alsa/asoundlib.h snd_seq_event_output_direct"-  snd_seq_event_output_direct :: Ptr Seq.Core -> Ptr Event.T -> IO CInt+  snd_seq_event_output_direct :: Ptr Seq.Core -> Ptr Event.T -> IO C.CInt   -- | Return the size (in bytes) of pending events on output buffer.@@ -175,11 +237,11 @@   fromIntegral `fmap` snd_seq_event_output_pending h  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_event_output_pending"-  snd_seq_event_output_pending :: Ptr Seq.Core -> IO CInt+  snd_seq_event_output_pending :: Ptr Seq.Core -> IO C.CInt   -- | Extract the first event in output buffer.--- Throws an exception on error.+-- Throws @(Errno 2)@ exception if output buffer is empty. -- See also 'output'. extractOutput   :: Seq.AllowOutput mode@@ -197,7 +259,7 @@ removeOutput (Seq.Cons h) = Exc.checkResult_ "removeOutput" =<< snd_seq_extract_output h nullPtr  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_extract_output"-  snd_seq_extract_output :: Ptr Seq.Core -> Ptr (Ptr Event.T) -> IO CInt+  snd_seq_extract_output :: Ptr Seq.Core -> Ptr (Ptr Event.T) -> IO C.CInt   -- | Drain output buffer to sequencer.@@ -217,19 +279,19 @@ drainOutput (Seq.Cons h) = checkResult "drainOutput" =<< snd_seq_drain_output h  foreign import ccall safe "alsa/asoundlib.h snd_seq_drain_output"-  snd_seq_drain_output :: Ptr Seq.Core -> IO CInt+  snd_seq_drain_output :: Ptr Seq.Core -> IO C.CInt   -- | Remove events from both the user-space output buffer, -- and the kernel-space sequencer queue.--- See also: 'drainOutput', 'dropOutputBuffer', 'removeEvents'.+-- See also: 'drainOutput', 'dropOutputBuffer', 'removeOutput'. dropOutput   :: Seq.AllowOutput mode   => Seq.T mode -> IO () dropOutput (Seq.Cons h) = Exc.checkResult_ "dropOutput" =<< snd_seq_drop_output h  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_drop_output"-  snd_seq_drop_output :: Ptr Seq.Core -> IO CInt+  snd_seq_drop_output :: Ptr Seq.Core -> IO C.CInt   -- | Remove events from the user-space output buffer.@@ -240,19 +302,19 @@ dropOutputBuffer (Seq.Cons h) = Exc.checkResult_ "dropOutputBuffer" =<< snd_seq_drop_output_buffer h  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_drop_output_buffer"-  snd_seq_drop_output_buffer :: Ptr Seq.Core -> IO CInt+  snd_seq_drop_output_buffer :: Ptr Seq.Core -> IO C.CInt   -- | Remove events from both the user-space input buffer, -- and the kernel-space sequencer queue.--- See also: 'dropInputBuffer', 'removeEvents'.+-- See also: 'dropInputBuffer', 'removeOutput'. dropInput   :: Seq.AllowInput mode   => Seq.T mode -> IO () dropInput (Seq.Cons h) = Exc.checkResult_ "dropInput" =<< snd_seq_drop_input h  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_drop_input"-  snd_seq_drop_input :: Ptr Seq.Core -> IO CInt+  snd_seq_drop_input :: Ptr Seq.Core -> IO C.CInt   -- | Remove events from the user-space input buffer.@@ -263,43 +325,58 @@ dropInputBuffer (Seq.Cons h) = Exc.checkResult_ "dropInputBuffer" =<< snd_seq_drop_input_buffer h  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_drop_input_buffer"-  snd_seq_drop_input_buffer :: Ptr Seq.Core -> IO CInt+  snd_seq_drop_input_buffer :: Ptr Seq.Core -> IO C.CInt    -- | Make a note whose unspecified fields contain 0.-simpleNote-  :: Word8  -- ^ Channel.-  -> Word8  -- ^ Note.-  -> Word8  -- ^ Velocity.-  -> Event.Note+simpleNote :: Channel -> Pitch -> Velocity -> Event.Note simpleNote c n v =    Event.Note {       Event.noteChannel = c,       Event.noteNote = n,       Event.noteVelocity = v,-      Event.noteOffVelocity = 0,-      Event.noteDuration = 0+      Event.noteOffVelocity = offVelocity,+      Event.noteDuration = Duration 0    } +normalVelocity, offVelocity :: Velocity+normalVelocity = Velocity 64+offVelocity = Velocity 0+ {- | Construct an ALSA sequencer event from very few information. Most fields are initialized with sensible defaults. You may use this as a start and alter its fields for your special needs. -> (Event.simple myAddr (Event.simpleNote 0 60 64)) {Event.dest = destAddr}+> (Event.simple myAddr (Event.simpleNote (Event.Channel 0) (Event.Pitch 60) Event.normalVelocity)) {Event.dest = destAddr} -} simple :: Addr.T -> Event.Data -> Event.T simple src bdy = Cons   { Event.highPriority = False-  , Event.tag = 0+  , Event.tag = Tag 0   , Event.queue = Queue.direct-  , Event.timestamp = Event.TickTime 0+  , Event.time = Time.consAbs $ Time.Tick 0   , Event.source = src   , Event.dest = Addr.subscribers   , Event.body = bdy   } +forSourcePort :: Port.T -> Event.Data -> Event.T+forSourcePort port =+   simple (Addr.Cons Client.unknown port)++forConnection :: Connect.T -> Event.Data -> Event.T+forConnection (Connect.Cons src dst) bdy =+   (simple src bdy) { Event.dest = dst }+++customZero :: Event.Custom+customZero = Event.Custom 0 0 0+++{- available in alsa-1.0.14, but gone in 1.0.22 -- | Used for volume control: means do not change the volume.-volumeSame :: Int16-volumeSame = -1+volumeSame :: Volume+volumeSame = Volume (-1)+-}

@@ -2,29 +2,31 @@    highPriority,    tag,    queue,-   timestamp,+   time,+   timeStamp,    source,    dest,    connect,    body,    ) where +import qualified Sound.ALSA.Sequencer.Connect as Connect import qualified Sound.ALSA.Sequencer.Address as Addr import qualified Sound.ALSA.Sequencer.Queue as Queue+import qualified Sound.ALSA.Sequencer.Marshal.Time as Time import qualified Sound.ALSA.Sequencer.Marshal.Event as Event  import qualified Data.Accessor.Basic as Acc -import Data.Word (Word8, ) - highPriority :: Acc.T Event.T Bool-tag :: Acc.T Event.T Word8+tag :: Acc.T Event.T Event.Tag queue :: Acc.T Event.T Queue.T-timestamp :: Acc.T Event.T Event.TimeStamp+time :: Acc.T Event.T Time.T+timeStamp :: Acc.T Event.T Time.Stamp source :: Acc.T Event.T Addr.T dest :: Acc.T Event.T Addr.T-connect :: Acc.T Event.T Event.Connect+connect :: Acc.T Event.T Connect.T body :: Acc.T Event.T Event.Data  highPriority =@@ -33,15 +35,18 @@    Acc.fromSetGet (\x ev -> ev{Event.tag = x}) Event.tag queue =    Acc.fromSetGet (\x ev -> ev{Event.queue = x}) Event.queue-timestamp =-   Acc.fromSetGet (\x ev -> ev{Event.timestamp = x}) Event.timestamp+time =+   Acc.fromSetGet (\x ev -> ev{Event.time = x}) Event.time+timeStamp = time Acc..> Time.stampAcc source =    Acc.fromSetGet (\x ev -> ev{Event.source = x}) Event.source dest =    Acc.fromSetGet (\x ev -> ev{Event.dest = x}) Event.dest connect =-   Acc.fromSetGet-      (\(Event.Connect src dst) ev -> ev{Event.source = src, Event.dest = dst})-      (\ev -> Event.Connect (Event.source ev) (Event.dest ev))+   Acc.fromWrapper+      (\(Connect.Cons src dst) -> (src, dst))+      (uncurry Connect.Cons)+   Acc.<.+   Acc.merge source dest body =    Acc.fromSetGet (\x ev -> ev{Event.body = x}) Event.body

@@ -0,0 +1,94 @@+module Sound.ALSA.Sequencer.Event.Remove (+  T,+  malloc,+  run,++  Condition,+  getCondition,+  setCondition,++  condInput,+  condOutput,+  condDest,+  condDestChannel,+  condTimeBefore,+  condTimeAfter,+  condTimeTick,+  condEventType,+  condIgnoreOff,+  condTagMatch,++  getQueue,+  getChannel,+  getEventType,+  getTag,+  getDest,+  getRealTime,+  getTickTime,++  setQueue,+  setChannel,+  setEventType,+  setTag,+  setDest,+  setRealTime,+  setTickTime,+  ) where++#include <alsa/asoundlib.h>+#include <Sound/ALSA/Sequencer/Area.h>++import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr+import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue+import qualified Sound.ALSA.Sequencer.Marshal.Event as Event+import qualified Sound.ALSA.Sequencer.Marshal.RealTime as RealTime+import qualified Sound.ALSA.Sequencer.Marshal.Time as Time+import qualified Sound.ALSA.Sequencer.Area as Area+import qualified Sound.ALSA.Exception as Exc++import qualified Data.EnumSet as EnumSet+import qualified Foreign.C.Types as C+import Foreign.Ptr (Ptr, )+++#area "remove_events"++-- | Remove events according to the given conditions+run :: Seq.T mode -> T -> IO ()+run (Seq.Cons h) info =+  Exc.checkResult_ "EventRemove.run" =<< with info (run_ h)++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_remove_events"+  run_ :: Ptr Seq.Core -> Ptr T_ -> IO C.CInt+++#{get_set_int_gen "condition", "Condition", "Condition", "EnumSet.Cons", "EnumSet.decons", "C.CUInt"}++#{get_set_int "queue", "Queue", "Queue.T", "Queue.imp", "Queue.exp"}+#{get_set_int "channel", "Channel", "Event.Channel", "(Event.Channel . fromIntegral)", "(fromIntegral . Event.unChannel)"}+#{get_set_int "event_type", "EventType", "Event.EType", "(Event.EType . fromIntegral)", "(fromIntegral . Event.unEType)"}+#{get_set_int "tag", "Tag", "Event.Tag", "(Event.Tag . fromIntegral)", "(fromIntegral . Event.unTag)"}+#{get_set_ptr "dest", "Dest", "Addr.T"}+#{get_set_ptr "time", "RealTime", "RealTime.T"}+#{get_set_ptr "time", "TickTime", "Time.Tick"}+++newtype ConditionFlag = ConditionFlag Int+   deriving (Eq, Ord, Enum)++type Condition = EnumSet.T C.CUInt ConditionFlag+++#{enum Condition, EnumSet.Cons+ , condInput       = SND_SEQ_REMOVE_INPUT        /* Flush input queues */+ , condOutput      = SND_SEQ_REMOVE_OUTPUT       /* Flush output queues */+ , condDest        = SND_SEQ_REMOVE_DEST         /* Restrict by destination q:client:port */+ , condDestChannel = SND_SEQ_REMOVE_DEST_CHANNEL /* Restrict by channel */+ , condTimeBefore  = SND_SEQ_REMOVE_TIME_BEFORE  /* Restrict to before time */+ , condTimeAfter   = SND_SEQ_REMOVE_TIME_AFTER   /* Restrict to time or after */+ , condTimeTick    = SND_SEQ_REMOVE_TIME_TICK    /* Time is in ticks */+ , condEventType   = SND_SEQ_REMOVE_EVENT_TYPE   /* Restrict to event type */+ , condIgnoreOff   = SND_SEQ_REMOVE_IGNORE_OFF   /* Do not flush off events */+ , condTagMatch    = SND_SEQ_REMOVE_TAG_MATCH    /* Restrict to events with given tag */+ }

@@ -0,0 +1,241 @@+{- |+This module allows to cancel events according to some criteria.+In all cases other than 'setInput' and 'setOutput'+the criteria are combined by logical AND.+For every criterion we provide three kinds of accessors:++* @set@: enable a criterion++* @put@: enable or disable a criterion++* @get@: query, whether the criterion is enabled or disabled.++Currently only the @set@ functions are really usable.+The @put@ and @get@ functions would become useful+for manipulating the remove criterion record, that ALSA maintains.+-}+module Sound.ALSA.Sequencer.Event.RemoveMonad (+  T,+  run,+  -- no need to export this, since Event.Remove is not exported as well+  -- apply,++  setInput,     putInput,     getInput,+  setOutput,    putOutput,    getOutput,+  setChannel,   putChannel,   getChannel,+  setEventType, putEventType,+  setTag,       putTag,       getTag,+  setDest,      putDest,      getDest,+  setTime,      putTime,      getTime,+  setIgnoreOff, putIgnoreOff, getIgnoreOff,+  ) where++import qualified Sound.ALSA.Sequencer.Event.Remove as Remove++import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr+import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue+import qualified Sound.ALSA.Sequencer.Marshal.Event as Event+import qualified Sound.ALSA.Sequencer.Marshal.Time as Time++import qualified Control.Monad.Trans.Reader as MR+import qualified Control.Monad.Trans.State as MS+import qualified Control.Monad.Trans.Class as MT+import Control.Applicative (Applicative, )++import qualified Data.EnumSet as EnumSet+import Data.EnumSet ((.-.), (.|.), )++import Control.Monad (liftM2, )+import Data.Monoid (mempty, mappend, )+++newtype T a = Cons (MR.ReaderT Remove.T (MS.StateT Remove.Condition IO) a)+   deriving (Functor, Applicative, Monad)+++unpack :: T a -> Remove.T -> Remove.Condition -> IO (a, Remove.Condition)+unpack (Cons m) r = MS.runStateT (MR.runReaderT m r)++-- | apply the changes in the Remove monad to the Remove record+_apply :: T a -> Remove.T -> IO a+_apply m r = do+  c0 <- Remove.getCondition r+  (a,c1) <- unpack m r c0+  Remove.setCondition r c1+  return a++-- | Remove events according to the given conditions+run :: Seq.T mode -> T a -> IO a+run h m = do+  r <- Remove.malloc+  (a,c) <- unpack m r EnumSet.empty+  Remove.setCondition r c+  Remove.run h r+  return a++++liftGet :: (Remove.T -> IO a) -> T a+liftGet f = Cons $ MR.ReaderT $ MT.lift . f++liftGetCond :: (Remove.T -> IO a) -> Remove.Condition -> T (Maybe a)+liftGetCond f cond = do+   b <- getCond cond+   if b+     then fmap Just $ liftGet f+     else return Nothing++liftSet :: (Remove.T -> b -> IO a) -> b -> T a+liftSet f x = Cons $ MR.ReaderT $ MT.lift . flip f x++liftSetCond :: (Remove.T -> a -> IO b) -> Remove.Condition -> a -> T b+liftSetCond f cond x = do+   modifyCond $ mappend cond+   liftSet f x++liftPutCond :: (Remove.T -> a -> IO ()) -> Remove.Condition -> Maybe a -> T ()+liftPutCond f cond mx =+   case mx of+      Nothing -> modifyCond $ (.-. cond)+      Just x -> liftSetCond f cond x++getCond :: Remove.Condition -> T Bool+getCond cond =+   Cons $ MT.lift $ MS.gets $ EnumSet.subset cond++setCond :: Remove.Condition -> T ()+setCond cond =+   modifyCond $ mappend cond++putCond :: Remove.Condition -> Bool -> T ()+putCond cond b =+   modifyCond $ (if b then (.|.) else flip (.-.)) cond++modifyCond :: (Remove.Condition -> Remove.Condition) -> T ()+modifyCond f =+   Cons $ MT.lift $ MS.modify f++{- |+All events in the local input buffer are removed.+The conditions are not checked for these events.+This is equivalent to 'Event.dropInputBuffer'.+-}+setInput :: T ()+putInput :: Bool -> T ()+getInput :: T Bool++{- |+Matching events in the local output buffer are removed, too.+Matching events in the kernel buffer are removed in any case.+If there are no further conditions,+then this is equivalent to 'Event.dropOutputBuffer'.+-}+setOutput :: T ()+putOutput :: Bool -> T ()+getOutput :: T Bool++setChannel :: Event.Channel -> T ()+putChannel :: Maybe Event.Channel -> T ()+getChannel :: T (Maybe Event.Channel)++_setEventType :: Event.EType -> T ()+_getEventType :: T Event.EType+setEventType :: Event.Type e => e -> T ()+putEventType :: Event.Type e => Maybe e -> T ()++setTag :: Event.Tag -> T ()+putTag :: Maybe Event.Tag -> T ()+getTag :: T (Maybe Event.Tag)++{- |+ALSA maintainers say, that destination address and queue are checked together,+at least in the kernel buffer.+However up to ALSA-1.0.22 the check for the queue is missing in libasound+for the local buffer.+-}+setDest :: (Addr.T, Queue.T) -> T ()+putDest :: Maybe (Addr.T, Queue.T) -> T ()+getDest :: T (Maybe (Addr.T, Queue.T))++{- |+NoteOff events are kept in any case.+-}+setIgnoreOff :: T ()+putIgnoreOff :: Bool -> T ()+getIgnoreOff :: T Bool+++getInput = getCond Remove.condInput+setInput = setCond Remove.condInput+putInput = putCond Remove.condInput++getOutput = getCond Remove.condOutput+setOutput = setCond Remove.condOutput+putOutput = putCond Remove.condOutput++getChannel = liftGetCond Remove.getChannel Remove.condDestChannel+setChannel = liftSetCond Remove.setChannel Remove.condDestChannel+putChannel = liftPutCond Remove.setChannel Remove.condDestChannel++_getEventType = liftGet Remove.getEventType+_setEventType = liftSetCond Remove.setEventType Remove.condEventType+setEventType =+   liftSetCond Remove.setEventType Remove.condEventType . Event.expEv+putEventType =+   liftPutCond Remove.setEventType Remove.condEventType . fmap Event.expEv++getTag = liftGetCond Remove.getTag Remove.condTagMatch+setTag = liftSetCond Remove.setTag Remove.condTagMatch+putTag = liftPutCond Remove.setTag Remove.condTagMatch++getDestQueue :: Remove.T -> IO (Addr.T, Queue.T)+getDestQueue r = liftM2 (,) (Remove.getDest r) (Remove.getQueue r)+setDestQueue :: Remove.T -> (Addr.T, Queue.T) -> IO ()+setDestQueue r (a,q) = Remove.setDest r a >> Remove.setQueue r q++getDest = liftGetCond getDestQueue Remove.condDest+setDest = liftSetCond setDestQueue Remove.condDest+putDest = liftPutCond setDestQueue Remove.condDest++getIgnoreOff = getCond Remove.condIgnoreOff+setIgnoreOff = setCond Remove.condIgnoreOff+putIgnoreOff = putCond Remove.condIgnoreOff+++getTime :: T (Maybe Ordering, Time.Stamp)+getTime = do+   ticks <- getCond Remove.condTimeTick+   stamp <-+      if ticks+        then fmap Time.Tick $ liftGet Remove.getTickTime+        else fmap Time.Real $ liftGet Remove.getRealTime+   after  <- getCond Remove.condTimeAfter+   before <- getCond Remove.condTimeBefore+   let mo =+          case (after, before) of+             (False, False) -> Nothing+             (True,  False) -> Just GT+             (False, True ) -> Just LT+             (True,  True ) -> Just EQ+   return (mo, stamp)++setTime :: Ordering -> Time.Stamp -> T ()+setTime o = putTime $ Just o++putTime :: Maybe Ordering -> Time.Stamp -> T ()+putTime mo t = do+   modifyCond ( .-. (Remove.condTimeAfter .|. Remove.condTimeBefore))+   modifyCond $ mappend $+      case mo of+         Nothing -> mempty+         Just LT -> Remove.condTimeBefore+         Just GT -> Remove.condTimeAfter+         Just EQ -> mappend Remove.condTimeBefore Remove.condTimeAfter+   case t of+      Time.Tick x -> do+         modifyCond $ (.-. Remove.condTimeTick)+         liftSet Remove.setTickTime x+      Time.Real x -> do+         modifyCond $ (.|. Remove.condTimeTick)+         liftSet Remove.setRealTime x

@@ -1,13 +1,14 @@ module Sound.ALSA.Sequencer.Marshal.Address where  #include <alsa/asoundlib.h>+#include <Sound/ALSA/Sequencer/Marshal/Template.h>  import qualified Sound.ALSA.Sequencer.Marshal.Client as Client import qualified Sound.ALSA.Sequencer.Marshal.Port as Port  import qualified Sound.ALSA.Sequencer.Utility as U -import Foreign.C.Types (CInt, )+import qualified Foreign.C.Types as C import Foreign.Storable           (Storable, sizeOf, alignment, peek, poke, pokeByteOff, peekByteOff, ) @@ -22,13 +23,13 @@       U.showsRecord prec "Address" [U.showsField c, U.showsField p]  -exp :: T -> (CInt,CInt)+exp :: T -> (C.CInt,C.CInt) exp a = (Client.exp (client a), Port.exp (port a))   instance Storable T where-  sizeOf _    = #size snd_seq_real_time_t-  alignment _ = 4 -- XXX+  sizeOf _    = #{size snd_seq_real_time_t}+  alignment _ = #{alignment snd_seq_real_time_t}   peek p      = do cl <- #{peek snd_seq_addr_t, client} p                    po <- #{peek snd_seq_addr_t, port} p                    return Cons { client = cl, port = po }@@ -36,10 +37,38 @@              >> #{poke snd_seq_addr_t, port}   p (port v)  +unknown :: T+unknown =+   Cons {+      client = Client.unknown,+      port   = Port.unknown+   }+ -- | The address of all subscribed ports. subscribers :: T subscribers =    Cons {       client = Client.subscribers,       port   = Port.unknown+   }++broadcast :: T+broadcast =+   Cons {+      client = Client.broadcast,+      port   = Port.unknown+   }++systemTimer :: T+systemTimer =+   Cons {+      client = Client.system,+      port   = Port.systemTimer+   }++systemAnnounce :: T+systemAnnounce =+   Cons {+      client = Client.system,+      port   = Port.systemAnnounce    }

@@ -13,24 +13,28 @@ -- Here we have the various types used by the library, -- and how they are imported\/exported to C. ----- NOTE: In the translations bellow we make the following assumptions--- about the sizes of C types.--- CChar  = 8 bits--- CShort = 16 bit--- CInt   = 32 bits+-- We use Hsc for expanding C types to Haskell types like Word32.+-- However if a C type is translated to Word32+-- you should not assume that it is translated to Word32 on every platform.+-- On a 64bit machine it may well be Word64.+-- Thus you should use our wrapper types whereever possible. --------------------------------------------------------------------------------  module Sound.ALSA.Sequencer.Marshal.Client where  #include <alsa/asoundlib.h>+#include <Sound/ALSA/Sequencer/Marshal/Template.h>+ import qualified Sound.ALSA.Sequencer.Utility as U-import Foreign.C.Types (CInt, )+import qualified Foreign.C.Types as C+import qualified Data.Word as Word import Foreign.Storable (Storable, )-import Data.Word (Word8, )   -- | The type of client identifiers.-newtype T = Cons Word8 deriving (Eq, Ord, Storable)+newtype T =+   Cons #{intfieldtype snd_seq_addr_t, client}+      deriving (Eq, Ord, Storable)  instance Show T where    showsPrec prec (Cons x) =@@ -46,16 +50,16 @@   -exp :: T -> CInt+exp :: T -> C.CInt exp (Cons c) = fromIntegral c -imp :: CInt -> T+imp :: C.CInt -> T imp p = Cons (fromIntegral p)  -- | The different types of clients. data Type = User | Kernel -impType :: CInt -> Type+impType :: C.CInt -> Type impType x =    if x == #{const SND_SEQ_USER_CLIENT}      then User

@@ -0,0 +1,104 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Sound.ALSA.Sequencer.Client+-- Copyright : (c) Henning Thielemann, 2010-2012+--             (c) Iavor S. Diatchki, 2007+-- License   : BSD3+--+-- Maintainer: Henning Thielemann+-- Stability : provisional+--+-- This module contains functions for working with sequencer clients.+-- Reference:+-- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_client.html>+--------------------------------------------------------------------------------++module Sound.ALSA.Sequencer.Marshal.ClientInfo where++#include <Sound/ALSA/Sequencer/Area.h>++import qualified Sound.ALSA.Sequencer.Marshal.Client as Client+import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified Sound.ALSA.Sequencer.Area as Area+import qualified Sound.ALSA.Sequencer.Query as Query+import qualified Sound.ALSA.Sequencer.Utility as U+import qualified Sound.ALSA.Exception as Exc++import qualified Foreign.C.Types as C+import Foreign.Ptr (Ptr, )+import Data.Word (Word, )+++#area "client_info"++-- read/write+#get_set_name+#get_set_bool "broadcast_filter", "BroadcastFilter"+#get_set_bool "error_bounce", "ErrorBounce"+#{get_set_int "client", "Client",+          "Client.T", "Client.imp", "Client.exp"}++-- read only+#{get_int "type", "Type",+          "Client.Type", "Client.impType"}+#{get_int "num_ports", "NumPorts",+          "Word", "fromIntegral"}+#{get_int "event_lost", "EventLost",+          "Word", "fromIntegral"}++++-- | Create a new information area filled with data about the sequencer client.+get :: Seq.T mode -> IO T+get (Seq.Cons h) =+  do info <- malloc+     Exc.checkResult_ "ClientInfo.get" =<< with info (get_ h)+     return info++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_client_info"+  get_ :: Ptr Seq.Core -> Ptr T_ -> IO C.CInt+++-- | Create a new information area filled with data about an arbitrary client.+getAny :: Seq.T mode -> Client.T -> IO T+getAny (Seq.Cons h) c =+  do info <- malloc+     Exc.checkResult_ "ClientInfo.getAny" =<<+       with info (getAny_ h (Client.exp c))+     return info++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_any_client_info"+  getAny_+    :: Ptr Seq.Core -> C.CInt -> Ptr T_ -> IO C.CInt+++-- | Set the information for the sequencer client based on the data+-- in the given information area.+set :: Seq.T mode -> T -> IO ()+set (Seq.Cons h) info =+  Exc.checkResult_ "set_client_info" =<< with info (set_ h)++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_client_info"+  set_ :: Ptr Seq.Core -> Ptr T_ -> IO C.CInt++++queryInit :: T -> IO ()+queryInit x =+  {-+  we cannot use setClient here,+  since Client uses an unsigned type and thus cannot represent -1+  -}+  with x (flip setClient_ (-1))++-- | Get information about the client with the next biggest identifier.+queryNext :: Seq.T mode -> T -> IO Bool  -- ^ Was there a next client?+queryNext (Seq.Cons h) info =+  U.checkResultQuery "ClientInfo.queryNext" =<< with info (queryNext_ h)++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_next_client"+  queryNext_ :: Ptr Seq.Core -> Ptr T_ -> IO C.CInt++instance Query.C T where+  init = queryInit+  next = queryNext

@@ -0,0 +1,24 @@+module Sound.ALSA.Sequencer.Marshal.Connect where++#include <alsa/asoundlib.h>+#include <Sound/ALSA/Sequencer/Marshal/Template.h>++import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr++import Foreign.Storable+          (Storable, sizeOf, alignment, peek, poke, pokeByteOff, peekByteOff, )+++data T = Cons+   { source :: !Addr.T+   , dest   :: !Addr.T+   } deriving (Show,Eq,Ord)++instance Storable T where+  sizeOf _    = #{size snd_seq_connect_t}+  alignment _ = #{alignment snd_seq_connect_t}+  peek p      = do s <- #{peek snd_seq_connect_t, sender} p+                   d <- #{peek snd_seq_connect_t, dest} p+                   return Cons { source = s, dest = d }+  poke p v    = #{poke snd_seq_connect_t, sender} p (source v)+             >> #{poke snd_seq_connect_t, dest}   p (dest v)

@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module    : Sound.ALSA.Sequencer.Marshal.Event--- Copyright : (c) Henning Thielemann, 2011+-- Copyright : (c) Henning Thielemann, 2011-2012 --             (c) Iavor S. Diatchki, 2007 -- License   : BSD3 --@@ -13,58 +13,46 @@ -- Here we have the various types used by the library, -- and how they are imported\/exported to C. ----- NOTE: In the translations bellow we make the following assumptions--- about the sizes of C types.--- CChar  = 8 bits--- CShort = 16 bit--- CInt   = 32 bits+-- We use Hsc for expanding C types to Haskell types like Word32.+-- However if a C type is translated to Word32+-- you should not assume that it is translated to Word32 on every platform.+-- On a 64bit machine it may well be Word64.+-- Thus you should use our wrapper types whereever possible. --------------------------------------------------------------------------------  module Sound.ALSA.Sequencer.Marshal.Event where  #include <alsa/asoundlib.h>+#include <Sound/ALSA/Sequencer/Marshal/Template.h> +import qualified Sound.ALSA.Sequencer.Marshal.Connect as Connect import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue import qualified Sound.ALSA.Sequencer.Marshal.RealTime as RealTime+import qualified Sound.ALSA.Sequencer.Marshal.Time as Time -import Foreign.C.Types (CUInt, )+import qualified Data.ByteString.Unsafe as BU+import qualified Data.ByteString as B++import qualified Foreign.Marshal.Alloc as MA+import qualified Foreign.C.Types as C+import qualified Data.Int as Int+import qualified Data.Word as Word import Foreign.Storable           (Storable, sizeOf, alignment, peek, poke, pokeByteOff, peekByteOff, ) import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr, )-import Foreign.Marshal.Alloc (alloca, )+import Control.Monad (liftM2, ) import Data.Monoid (mappend, ) import qualified Data.FlagSet as FlagSet-import Data.Int (Int16, Int32, )-import Data.Word (Word8, Word16, Word32, )-import Data.Array (Array, (!), accumArray, )+import Data.Array (Ix, Array, (!), accumArray, )+import Data.Tuple.HT (mapFst, )   data Flag-type Flags     = FlagSet.T Word8 Flag-type FlagValue = FlagSet.MaskedValue Word8 Flag---timeStampTick, timeStampReal :: FlagValue-timeStampTick =-   FlagSet.MaskedValue-      #{const SND_SEQ_TIME_STAMP_MASK}-      #{const SND_SEQ_TIME_STAMP_TICK}-timeStampReal =-   FlagSet.MaskedValue-      #{const SND_SEQ_TIME_STAMP_MASK}-      #{const SND_SEQ_TIME_STAMP_REAL}-+type Flags     = FlagSet.T #{intfieldtype snd_seq_event_t, flags} Flag+type FlagValue = FlagSet.MaskedValue #{intfieldtype snd_seq_event_t, flags} Flag -timeModeAbs, timeModeRel :: FlagValue-timeModeAbs =-   FlagSet.MaskedValue-      #{const SND_SEQ_TIME_MODE_MASK}-      #{const SND_SEQ_TIME_MODE_ABS}-timeModeRel =-   FlagSet.MaskedValue-      #{const SND_SEQ_TIME_MODE_MASK}-      #{const SND_SEQ_TIME_MODE_REL}+instance Time.Flag Flag where   eventLengthFixed, eventLengthVariable, eventLengthVarUser :: FlagValue@@ -93,81 +81,58 @@       #{const SND_SEQ_PRIORITY_NORMAL}  -data Connect = Connect-   { connSource :: !Addr.T-   , connDest   :: !Addr.T-   } deriving (Show,Eq,Ord) -instance Storable Connect where-  sizeOf _    = #size snd_seq_connect_t-  alignment _ = 4 -- XXX-  peek p      = do s <- #{peek snd_seq_connect_t, sender} p-                   d <- #{peek snd_seq_connect_t, dest} p-                   return Connect { connSource = s, connDest = d }-  poke p v    = #{poke snd_seq_connect_t, sender} p (connSource v)-             >> #{poke snd_seq_connect_t, dest}   p (connDest v)---data TimeStamp      = TickTime !Word32-                    | RealTime !RealTime.T-                      deriving Show--peekTimestamp :: Flags -> Ptr TimeStamp -> IO TimeStamp-peekTimestamp flags p =-  if FlagSet.match flags timeStampTick-    then fmap TickTime $ peek $ castPtr p-    else fmap RealTime $ peek $ castPtr p--pokeTimestamp :: Ptr TimeStamp -> TimeStamp -> IO FlagValue-pokeTimestamp p ts = case ts of-  TickTime t -> poke (castPtr p) t >> return timeStampTick-  RealTime t -> poke (castPtr p) t >> return timeStampReal--+{- available in alsa-1.0.14, but gone in 1.0.22+#{newinttype "InstrCluster", snd_seq_instr_cluster_t} -newtype InstrCluster = InstrCluster CUInt-  deriving (Show,Eq,Ord,Num,Enum,Storable)+#{newintfieldtype "StandardId", snd_seq_instr_t, std}+#{newintfieldtype "Bank",       snd_seq_instr_t, bank}+#{newintfieldtype "Program",    snd_seq_instr_t, prg}  data Instr = Instr    { instrCluster :: !InstrCluster     -- XXX: perhaps use Sample?-   , instrStd     :: !Word32-   , instrBank    :: !Word16-   , instrPrg     :: !Word16+   , instrStd     :: !StandardId+   , instrBank    :: !Bank+   , instrPrg     :: !Program    } deriving (Show) -{- instance Storable Instr where   sizeOf _    = #{size snd_seq_instr_t}-  alignment _ = 4 -- XXX+  alignment _ = #{alignment snd_seq_instr_t}   peek p      = do cl <- #{peek snd_seq_instr_t, cluster} p                    st <- #{peek snd_seq_instr_t, std} p                    ba <- #{peek snd_seq_instr_t, bank} p                    pr <- #{peek snd_seq_instr_t, prg} p-                   return Instr { instr_cluster = cl-                                , instr_std     = st-                                , instr_bank    = ba-                                , instr_prg     = pr+                   return Instr { instrCluster = cl+                                , instrStd     = st+                                , instrBank    = ba+                                , instrPrg     = pr                                 }-  poke p v    = #{poke snd_seq_instr_t, cluster} p (instr_cluster v)-             >> #{poke snd_seq_instr_t, std}     p (instr_std v)-             >> #{poke snd_seq_instr_t, bank}    p (instr_bank v)-             >> #{poke snd_seq_instr_t, prg}     p (instr_prg v)+  poke p v    = #{poke snd_seq_instr_t, cluster} p (instrCluster v)+             >> #{poke snd_seq_instr_t, std}     p (instrStd v)+             >> #{poke snd_seq_instr_t, bank}    p (instrBank v)+             >> #{poke snd_seq_instr_t, prg}     p (instrPrg v) -}  +#{newintfieldtype "Channel",  snd_seq_ev_note_t, channel}+#{newintfieldtype "Pitch",    snd_seq_ev_note_t, note}+#{newintfieldtype "Velocity", snd_seq_ev_note_t, velocity}+#{newintfieldtype "Duration", snd_seq_ev_note_t, duration}+ data Note = Note-   { noteChannel      :: !Word8-   , noteNote         :: !Word8-   , noteVelocity     :: !Word8-   , noteOffVelocity  :: !Word8-   , noteDuration     :: !Word32+   { noteChannel      :: !Channel+   , noteNote         :: !Pitch+   , noteVelocity     :: !Velocity+   , noteOffVelocity  :: !Velocity+   , noteDuration     :: !Duration    } deriving (Show)   instance Storable Note where   sizeOf _    = #{size snd_seq_ev_note_t}-  alignment _ = 4 -- XXX+  alignment _ = #{alignment snd_seq_ev_note_t}   peek p      = do c  <- #{peek snd_seq_ev_note_t, channel} p                    n  <- #{peek snd_seq_ev_note_t, note} p                    v  <- #{peek snd_seq_ev_note_t, velocity} p@@ -186,15 +151,18 @@              >> #{poke snd_seq_ev_note_t, duration}     p (noteDuration v)  +#{newintfieldtype "Parameter", snd_seq_ev_ctrl_t, param}+#{newintfieldtype "Value",     snd_seq_ev_ctrl_t, value}+ data Ctrl = Ctrl-   { ctrlChannel  :: !Word8-   , ctrlParam    :: !Word32-   , ctrlValue    :: !Int32+   { ctrlChannel  :: !Channel+   , ctrlParam    :: !Parameter+   , ctrlValue    :: !Value    } deriving (Show)  instance Storable Ctrl where   sizeOf _    = #{size snd_seq_ev_ctrl_t}-  alignment _ = 4 -- XXX+  alignment _ = #{alignment snd_seq_ev_ctrl_t}   peek p      = do ct <- #{peek snd_seq_ev_ctrl_t, channel} p                    pa <- #{peek snd_seq_ev_ctrl_t, param} p                    va <- #{peek snd_seq_ev_ctrl_t, value} p@@ -207,28 +175,40 @@              >> #{poke snd_seq_ev_ctrl_t, value}   p (ctrlValue v)  +pokeQueue ::+  Ptr Data -> QueueEv -> Queue.T -> IO EType+pokeQueue p e q = do+  poke (castPtr p) q+  case e of+    QueueSetPosTick t -> #{poke snd_seq_ev_queue_control_t, param.time.tick} p t+    QueueSetPosTime t -> #{poke snd_seq_ev_queue_control_t, param.time.time} p t+    QueueTempo      t -> #{poke snd_seq_ev_queue_control_t, param.value} p t+    QueueSkew       s -> #{poke snd_seq_ev_queue_control_t, param.skew} p s+    QueueSyncPos    s -> #{poke snd_seq_ev_queue_control_t, param.position} p s+    _ -> return ()+  return (expEv e) ++{- available in alsa-1.0.14, but gone in 1.0.22 data Sample = Sample-   { sampleStd  :: !Word32-   , sampleBank :: !Word16-   , samplePrg  :: !Word16+   { sampleStd  :: !StandardId+   , sampleBank :: !Bank+   , samplePrg  :: !Program    } deriving (Show) -{- instance Storable Sample where   sizeOf _    = #{size snd_seq_ev_sample_t}-  alignment _ = 4 -- XXX+  alignment _ = #{alignment snd_seq_ev_sample_t}   peek p      = do st <- #{peek snd_seq_ev_sample_t, std} p                    ba <- #{peek snd_seq_ev_sample_t, bank} p                    pr <- #{peek snd_seq_ev_sample_t, prg} p-                   return Sample { sample_std     = st-                                 , sample_bank    = ba-                                 , sample_prg     = pr+                   return Sample { sampleStd     = st+                                 , sampleBank    = ba+                                 , samplePrg     = pr                                  }   poke p v    = #{poke snd_seq_ev_sample_t, std}     p (sampleStd v)              >> #{poke snd_seq_ev_sample_t, bank}    p (sampleBank v)              >> #{poke snd_seq_ev_sample_t, prg}     p (samplePrg v)--}   newtype Cluster = Cluster@@ -236,26 +216,29 @@    } deriving (Show, Eq, Storable)  +#{newintfieldtype "Volume",  snd_seq_ev_volume_t, volume}+#{newintfieldtype "Balance", snd_seq_ev_volume_t, lr}+ -- | These are all 14 bit values.-data Volume = Volume-   { volumeVolume  :: !Int16-   , volumeLR      :: !Int16-   , volumeFR      :: !Int16-   , volumeDU      :: !Int16+data VolumeControl = VolumeControl+   { volumeVolume  :: !Volume+   , volumeLR      :: !Balance+   , volumeFR      :: !Balance+   , volumeDU      :: !Balance    } deriving (Show) -{--instance Storable Volume where+instance Storable VolumeControl where   sizeOf _    = #{size snd_seq_ev_volume_t}-  alignment _ = 4 -- XXX+  alignment _ = #{alignment snd_seq_ev_volume_t}   peek p      = do v <- #{peek snd_seq_ev_volume_t, volume} p                    l <- #{peek snd_seq_ev_volume_t, lr} p                    f <- #{peek snd_seq_ev_volume_t, fr} p                    d <- #{peek snd_seq_ev_volume_t, du} p-                   return Volume { volume_volume  = v-                                 , volume_lr      = l-                                 , volume_fr      = f-                                 , volume_du      = d+                   return VolumeControl+                                 { volumeVolume  = v+                                 , volumeLR      = l+                                 , volumeFR      = f+                                 , volumeDU      = d                                  }   poke p v    = #{poke snd_seq_ev_volume_t, volume} p (volumeVolume v)              >> #{poke snd_seq_ev_volume_t, lr}     p (volumeLR v)@@ -264,12 +247,14 @@ -}  -data Custom = Custom { custom0, custom1, custom2 :: !Word32 }-                      deriving (Show)+data Custom =+  Custom {+    custom0, custom1, custom2 :: ! #{intfieldtype snd_seq_ev_raw32_t, d[0]}+  } deriving (Show)  instance Storable Custom where   sizeOf _    = #{size snd_seq_ev_raw32_t}-  alignment _ = 4 -- XXX+  alignment _ = #{alignment snd_seq_ev_raw32_t}   peek p      = do d0 <- #{peek snd_seq_ev_raw32_t, d[0]} p                    d1 <- #{peek snd_seq_ev_raw32_t, d[1]} p                    d2 <- #{peek snd_seq_ev_raw32_t, d[2]} p@@ -282,12 +267,13 @@              >> #{poke snd_seq_ev_raw32_t, d[2]} p (custom2 v)  +#{newintfieldtype "Tag", snd_seq_event_t, tag}  data T = Cons    { highPriority   :: !Bool-   , tag            :: !Word8+   , tag            :: !Tag    , queue          :: !Queue.T-   , timestamp      :: !TimeStamp+   , time           :: !Time.T    , source         :: !Addr.T    , dest           :: !Addr.T    , body           :: !Data@@ -295,13 +281,13 @@  instance Storable T where   sizeOf _    = #{size snd_seq_event_t}-  alignment _ = 4 -- XXX+  alignment _ = #{alignment snd_seq_event_t}   peek p =     do ty    <- #{peek snd_seq_event_t, type} p        flags <- #{peek snd_seq_event_t, flags} p        tg    <- #{peek snd_seq_event_t, tag} p        q     <- #{peek snd_seq_event_t, queue} p-       time  <- peekTimestamp flags (#{ptr snd_seq_event_t, time} p)+       t     <- Time.peek flags (#{ptr snd_seq_event_t, time} p)        src   <- #{peek snd_seq_event_t, source} p        dst   <- #{peek snd_seq_event_t, dest} p        d     <- (peekData ! ty) (#{ptr snd_seq_event_t, data} p)@@ -309,53 +295,78 @@          { highPriority = not $ FlagSet.match flags priorityNormal          , tag = tg          , queue = q-         , timestamp = time+         , time = t          , source = src          , dest = dst          , body = d          }-  poke p e = do-    { ty <- pokeData (#{ptr snd_seq_event_t, data} p) (body e)-    ; #{poke snd_seq_event_t, type} p ty-    ; #{poke snd_seq_event_t, tag} p (tag e)-    ; #{poke snd_seq_event_t, queue} p (queue e)-    ; real <- pokeTimestamp (#{ptr snd_seq_event_t, time} p) (timestamp e)-    ; #{poke snd_seq_event_t, source} p (source e)-    ; #{poke snd_seq_event_t, dest} p (dest e)-    ; let flags =-             (if highPriority e-                then priorityHigh-                else priorityNormal)-             `mappend` real-             `mappend` eventLengthFixed-    ; #{poke snd_seq_event_t, flags} p (FlagSet.fromMaskedValue flags)-    }+  poke p e =+    pokeHeader p e eventLengthFixed+      =<< pokeData (#{ptr snd_seq_event_t, data} p) (body e) -allocaEv :: T -> (Ptr T -> IO a) -> IO a-allocaEv e h = alloca (\p -> poke p e >> h p)+withMaybe :: Maybe T -> (Ptr T -> IO a) -> IO a+withMaybe me f =+  maybe (f nullPtr) (flip with f) me -allocaMaybeEv :: Maybe T -> (Ptr T -> IO a) -> IO a-allocaMaybeEv me h =-  maybe (h nullPtr) (\e -> allocaEv e h) me+with :: T -> (Ptr T -> IO a) -> IO a+with ev f =+  MA.alloca $ \p ->+    case body ev of+      ExtEv e d -> do+        let lengthFlag =+              case e of+                SysEx -> eventLengthVariable+                Bounce -> eventLengthVariable+                _ -> eventLengthVarUser+        pokeHeader p ev lengthFlag (expEv e)+        BU.unsafeUseAsCString d $ \ptr -> do+          #{poke snd_seq_event_t, data.ext.len} p (B.length d)+          #{poke snd_seq_event_t, data.ext.ptr} p ptr+          f p+      b -> do+        pokeHeader p ev eventLengthFixed+          =<< pokeData (#{ptr snd_seq_event_t, data} p) b+        f p + pokeBody ::   (Storable d, Type e) =>-  Ptr Data -> e -> d -> IO Word8+  Ptr Data -> e -> d -> IO EType pokeBody p e d =   poke (castPtr p) d >> return (expEv e) -pokeData :: Ptr Data -> Data -> IO Word8+pokeData :: Ptr Data -> Data -> IO EType pokeData p dt = case dt of   NoteEv   e d -> pokeBody p e d   CtrlEv   e d -> pokeBody p e d+  QueueEv  e d -> pokeQueue p e d   AddrEv   e d -> pokeBody p e d   ConnEv   e d -> pokeBody p e d   CustomEv e d -> pokeBody p e d+  ExtEv    _ _ -> error "cannot simply poke ExtEv, because it needs allocation - use Event.with instead"   EmptyEv  e   -> return (expEv e) +pokeHeader :: Ptr T -> T -> FlagValue -> EType -> IO ()+pokeHeader p e lengthFlag ty = do+  #{poke snd_seq_event_t, type} p ty+  #{poke snd_seq_event_t, tag} p (tag e)+  #{poke snd_seq_event_t, queue} p (queue e)+  real <- Time.poke (#{ptr snd_seq_event_t, time} p) (time e)+  #{poke snd_seq_event_t, source} p (source e)+  #{poke snd_seq_event_t, dest} p (dest e)+  let flags =+         (if highPriority e+            then priorityHigh+            else priorityNormal)+         `mappend` real+         `mappend` lengthFlag+  #{poke snd_seq_event_t, flags} p (FlagSet.fromMaskedValue flags) -peekData :: Array Word8 (Ptr Data -> IO Data)-peekData = accumArray (const id) unknown (0,255)++peekData :: Array EType (Ptr Data -> IO Data)+peekData =+  accumArray (const id) unknown (EType 0, EType 255) $+  map (mapFst EType) $   [ -- result events (2)     (#{const SND_SEQ_EVENT_SYSTEM}, unknown)   , (#{const SND_SEQ_EVENT_RESULT}, unknown)@@ -381,16 +392,16 @@   , (#{const SND_SEQ_EVENT_KEYSIGN},     peekCtrlEv KeySign)    -- queue control (10)-  , (#{const SND_SEQ_EVENT_START}, unknown)-  , (#{const SND_SEQ_EVENT_CONTINUE}, unknown)-  , (#{const SND_SEQ_EVENT_STOP}, unknown)-  , (#{const SND_SEQ_EVENT_SETPOS_TICK}, unknown)-  , (#{const SND_SEQ_EVENT_SETPOS_TIME}, unknown)-  , (#{const SND_SEQ_EVENT_TEMPO}, unknown)-  , (#{const SND_SEQ_EVENT_CLOCK}, unknown)-  , (#{const SND_SEQ_EVENT_TICK}, unknown)-  , (#{const SND_SEQ_EVENT_QUEUE_SKEW}, unknown)-  , (#{const SND_SEQ_EVENT_SYNC_POS}, unknown)+  , (#{const SND_SEQ_EVENT_START},       peekQueueEv  QueueStart)+  , (#{const SND_SEQ_EVENT_CONTINUE},    peekQueueEv  QueueContinue)+  , (#{const SND_SEQ_EVENT_STOP},        peekQueueEv  QueueStop)+  , (#{const SND_SEQ_EVENT_SETPOS_TICK}, peekQueueExt QueueSetPosTick #{peek snd_seq_ev_queue_control_t, param.time.tick})+  , (#{const SND_SEQ_EVENT_SETPOS_TIME}, peekQueueExt QueueSetPosTime #{peek snd_seq_ev_queue_control_t, param.time.time})+  , (#{const SND_SEQ_EVENT_TEMPO},       peekQueueExt QueueTempo      #{peek snd_seq_ev_queue_control_t, param.value})+  , (#{const SND_SEQ_EVENT_CLOCK},       peekQueueEv  QueueClock)+  , (#{const SND_SEQ_EVENT_TICK},        peekQueueEv  QueueTick)+  , (#{const SND_SEQ_EVENT_QUEUE_SKEW},  peekQueueExt QueueSkew       #{peek snd_seq_ev_queue_control_t, param.skew})+  , (#{const SND_SEQ_EVENT_SYNC_POS},    peekQueueExt QueueSyncPos    #{peek snd_seq_ev_queue_control_t, param.position})    -- misc (3)   , (#{const SND_SEQ_EVENT_TUNE_REQUEST}, peekEmptyEv TuneRequest)@@ -410,7 +421,7 @@   , (#{const SND_SEQ_EVENT_PORT_SUBSCRIBED},   peekConnEv PortSubscribed)   , (#{const SND_SEQ_EVENT_PORT_UNSUBSCRIBED}, peekConnEv PortUnsubscribed) -{-+{- available in alsa-1.0.14, but gone in 1.0.22   , (#{const SND_SEQ_EVENT_SAMPLE}, unknown)   , (#{const SND_SEQ_EVENT_SAMPLE_CLUSTER}, unknown)   , (#{const SND_SEQ_EVENT_SAMPLE_START}, unknown)@@ -432,7 +443,7 @@   , (#{const SND_SEQ_EVENT_USR8}, peekCustomEv User8)   , (#{const SND_SEQ_EVENT_USR9}, peekCustomEv User9) -{-+{- available in alsa-1.0.14, but gone in 1.0.22   , (#{const SND_SEQ_EVENT_INSTR_BEGIN}, unknown)   , (#{const SND_SEQ_EVENT_INSTR_END}, unknown)   , (#{const SND_SEQ_EVENT_INSTR_INFO}, unknown)@@ -454,14 +465,13 @@   , (#{const SND_SEQ_EVENT_INSTR_CHANGE}, unknown) -} -  , (#{const SND_SEQ_EVENT_SYSEX}, unknown)-  , (#{const SND_SEQ_EVENT_BOUNCE}, unknown)--  , (#{const SND_SEQ_EVENT_USR_VAR0}, unknown)-  , (#{const SND_SEQ_EVENT_USR_VAR1}, unknown)-  , (#{const SND_SEQ_EVENT_USR_VAR2}, unknown)-  , (#{const SND_SEQ_EVENT_USR_VAR3}, unknown)-  , (#{const SND_SEQ_EVENT_USR_VAR3}, unknown)+  , (#{const SND_SEQ_EVENT_SYSEX},    peekExtEv SysEx   )+  , (#{const SND_SEQ_EVENT_BOUNCE},   peekExtEv Bounce  )+  , (#{const SND_SEQ_EVENT_USR_VAR0}, peekExtEv UserVar0)+  , (#{const SND_SEQ_EVENT_USR_VAR1}, peekExtEv UserVar1)+  , (#{const SND_SEQ_EVENT_USR_VAR2}, peekExtEv UserVar2)+  , (#{const SND_SEQ_EVENT_USR_VAR3}, peekExtEv UserVar3)+  , (#{const SND_SEQ_EVENT_USR_VAR3}, peekExtEv UserVar4)    , (#{const SND_SEQ_EVENT_NONE}, peekEmptyEv None)   ]@@ -480,17 +490,19 @@               | TimeSign | KeySign                 deriving (Show, Eq, Ord, Enum, Bounded) +#{newintfieldtype "Tempo", snd_seq_ev_queue_control_t, param.value}+ data QueueEv  = QueueStart               | QueueContinue               | QueueStop-              | QueueSetPosTick-              | QueueSetPosTime-              | QueueTempo+              | QueueSetPosTick !Time.Tick+              | QueueSetPosTime !RealTime.T+              | QueueTempo      !Tempo               | QueueClock               | QueueTick-              | QueueSkew-              | QueueSyncPos-                deriving (Show, Eq, Ord, Enum, Bounded)+              | QueueSkew       !Queue.Skew+              | QueueSyncPos    !Queue.Position+                deriving (Show, Eq)  data EmptyEv  = TuneRequest | Reset | Sensing | None | Unknown                 deriving (Show, Eq, Ord, Enum, Bounded)@@ -500,6 +512,10 @@               | User5 | User6 | User7 | User8 | User9                 deriving (Show, Eq, Ord, Enum, Bounded) +data ExtEv    = SysEx | Bounce+              | UserVar0 | UserVar1 | UserVar2 | UserVar3 | UserVar4+                deriving (Show, Eq, Ord, Enum, Bounded)+ data AddrEv   = ClientStart | ClientExit | ClientChange               | PortStart | PortExit | PortChange                 deriving (Show, Eq, Ord, Enum, Bounded)@@ -508,18 +524,23 @@                 deriving (Show, Eq, Ord, Enum, Bounded)  +#{newinttype "EType", snd_seq_event_type_t}++-- type EType = #{inttype snd_seq_event_type_t}++ class Type e where-  expEv :: e -> Word8+  expEv :: e -> EType -instance Type NoteEv where - expEv e = case e of+instance Type NoteEv where+ expEv e = EType $ case e of   ANote    -> #{const SND_SEQ_EVENT_NOTE}   NoteOn   -> #{const SND_SEQ_EVENT_NOTEON}   NoteOff  -> #{const SND_SEQ_EVENT_NOTEOFF}   KeyPress -> #{const SND_SEQ_EVENT_KEYPRESS} -instance Type CtrlEv where - expEv e = case e of+instance Type CtrlEv where+ expEv e = EType $ case e of   Controller  -> #{const SND_SEQ_EVENT_CONTROLLER}   PgmChange   -> #{const SND_SEQ_EVENT_PGMCHANGE}   ChanPress   -> #{const SND_SEQ_EVENT_CHANPRESS}@@ -533,29 +554,34 @@   TimeSign    -> #{const SND_SEQ_EVENT_TIMESIGN}   KeySign     -> #{const SND_SEQ_EVENT_KEYSIGN} -instance Type QueueEv where - expEv e = case e of-  QueueStart      -> #{const SND_SEQ_EVENT_START}-  QueueContinue   -> #{const SND_SEQ_EVENT_CONTINUE}-  QueueStop       -> #{const SND_SEQ_EVENT_STOP}-  QueueSetPosTick -> #{const SND_SEQ_EVENT_SETPOS_TICK}-  QueueSetPosTime -> #{const SND_SEQ_EVENT_SETPOS_TIME}-  QueueTempo      -> #{const SND_SEQ_EVENT_TEMPO}-  QueueClock      -> #{const SND_SEQ_EVENT_CLOCK}-  QueueTick       -> #{const SND_SEQ_EVENT_TICK}-  QueueSkew       -> #{const SND_SEQ_EVENT_QUEUE_SKEW}-  QueueSyncPos    -> #{const SND_SEQ_EVENT_SYNC_POS}+instance Type QueueEv where+  expEv = fst . expQueueEv -instance Type EmptyEv where - expEv e = case e of+-- setPosTick should be an error+expQueueEv :: QueueEv -> (EType, C.CInt)+expQueueEv e = mapFst EType $ case e of+  QueueStart        -> (#{const SND_SEQ_EVENT_START}       , 0)+  QueueContinue     -> (#{const SND_SEQ_EVENT_CONTINUE}    , 0)+  QueueStop         -> (#{const SND_SEQ_EVENT_STOP}        , 0)+  QueueSetPosTick _ -> (#{const SND_SEQ_EVENT_SETPOS_TICK} , error "expQueueEv.QueueSetPosTick: cannot represent position as int")+  QueueSetPosTime _ -> (#{const SND_SEQ_EVENT_SETPOS_TIME} , error "expQueueEv.QueueSetPosTime: cannot represent position as int")+  QueueTempo      x -> (#{const SND_SEQ_EVENT_TEMPO}       , fromIntegral $ unTempo x)+  QueueClock        -> (#{const SND_SEQ_EVENT_CLOCK}       , 0)+  QueueTick         -> (#{const SND_SEQ_EVENT_TICK}        , 0)+  QueueSkew       _ -> (#{const SND_SEQ_EVENT_QUEUE_SKEW}  , error "expQueueEv.QueueSkew: cannot represent skew record as int")+  QueueSyncPos    x -> (#{const SND_SEQ_EVENT_SYNC_POS}    , fromIntegral $ Queue.unPosition x)+++instance Type EmptyEv where+ expEv e = EType $ case e of   TuneRequest -> #{const SND_SEQ_EVENT_TUNE_REQUEST}   Reset       -> #{const SND_SEQ_EVENT_RESET}   Sensing     -> #{const SND_SEQ_EVENT_SENSING}   None        -> #{const SND_SEQ_EVENT_NONE}   Unknown     -> #{const SND_SEQ_EVENT_NONE} -instance Type CustomEv where - expEv e = case e of+instance Type CustomEv where+ expEv e = EType $ case e of   Echo  -> #{const SND_SEQ_EVENT_ECHO}   OSS   -> #{const SND_SEQ_EVENT_OSS}   User0 -> #{const SND_SEQ_EVENT_USR0}@@ -569,8 +595,18 @@   User8 -> #{const SND_SEQ_EVENT_USR8}   User9 -> #{const SND_SEQ_EVENT_USR9} -instance Type AddrEv where -  expEv e = case e of+instance Type ExtEv where+ expEv e = EType $ case e of+  SysEx    -> #{const SND_SEQ_EVENT_SYSEX}+  Bounce   -> #{const SND_SEQ_EVENT_BOUNCE}+  UserVar0 -> #{const SND_SEQ_EVENT_USR_VAR0}+  UserVar1 -> #{const SND_SEQ_EVENT_USR_VAR1}+  UserVar2 -> #{const SND_SEQ_EVENT_USR_VAR2}+  UserVar3 -> #{const SND_SEQ_EVENT_USR_VAR3}+  UserVar4 -> #{const SND_SEQ_EVENT_USR_VAR4}++instance Type AddrEv where+  expEv e = EType $ case e of     ClientStart -> #{const SND_SEQ_EVENT_CLIENT_START}     ClientExit -> #{const SND_SEQ_EVENT_CLIENT_EXIT}     ClientChange -> #{const SND_SEQ_EVENT_CLIENT_CHANGE}@@ -578,8 +614,8 @@     PortExit -> #{const SND_SEQ_EVENT_PORT_EXIT}     PortChange -> #{const SND_SEQ_EVENT_PORT_CHANGE} -instance Type ConnEv where - expEv e = case e of+instance Type ConnEv where+ expEv e = EType $ case e of   PortSubscribed   -> #{const SND_SEQ_EVENT_PORT_SUBSCRIBED}   PortUnsubscribed -> #{const SND_SEQ_EVENT_PORT_UNSUBSCRIBED} @@ -600,6 +636,13 @@ peekCtrlEv :: CtrlEv -> Ptr Data -> IO Data peekCtrlEv e = peekBody (CtrlEv e) +peekQueueEv :: QueueEv -> Ptr Data -> IO Data+peekQueueEv e = peekBody (QueueEv e)++peekQueueExt :: (a -> QueueEv) -> (Ptr Data -> IO a) -> Ptr Data -> IO Data+peekQueueExt makeQ peekParam p =+  liftM2 (QueueEv . makeQ) (peekParam p) (peek (castPtr p))+ peekAddrEv :: AddrEv -> Ptr Data -> IO Data peekAddrEv e = peekBody (AddrEv e) @@ -612,12 +655,20 @@ peekCustomEv :: CustomEv -> Ptr Data -> IO Data peekCustomEv e = peekBody (CustomEv e) +peekExtEv :: ExtEv -> Ptr Data -> IO Data+peekExtEv e p = do+  len <- #{peek snd_seq_ev_ext_t, len} p+  ptr <- #{peek snd_seq_ev_ext_t, ptr} p+  fmap (ExtEv e) $ B.packCStringLen (ptr,len) + data Data   = NoteEv NoteEv Note   | CtrlEv CtrlEv Ctrl+  | QueueEv QueueEv Queue.T   | AddrEv AddrEv Addr.T-  | ConnEv ConnEv Connect+  | ConnEv ConnEv Connect.T   | EmptyEv EmptyEv   | CustomEv CustomEv Custom+  | ExtEv ExtEv B.ByteString     deriving Show

@@ -1,6 +1,6 @@ -------------------------------------------------------------------------------- -- |--- Module    : Sound.ALSA.Sequencer.Marshal+-- Module    : Sound.ALSA.Sequencer.Marshal.Port -- Copyright : (c) Henning Thielemann, 2011 --             (c) Iavor S. Diatchki, 2007 -- License   : BSD3@@ -13,38 +13,42 @@ -- Here we have the various types used by the library, -- and how they are imported\/exported to C. ----- NOTE: In the translations bellow we make the following assumptions--- about the sizes of C types.--- CChar  = 8 bits--- CShort = 16 bit--- CInt   = 32 bits+-- We use Hsc for expanding C types to Haskell types like Word32.+-- However if a C type is translated to Word32+-- you should not assume that it is translated to Word32 on every platform.+-- On a 64bit machine it may well be Word64.+-- Thus you should use our wrapper types whereever possible. --------------------------------------------------------------------------------  module Sound.ALSA.Sequencer.Marshal.Port where  #include <alsa/asoundlib.h>+#include <Sound/ALSA/Sequencer/Marshal/Template.h>+ import qualified Sound.ALSA.Sequencer.Utility as U-import Foreign.C.Types (CInt, CUInt, )+import qualified Foreign.C.Types as C+import qualified Data.Word as Word import Foreign.Storable (Storable, ) import Data.Ix (Ix, range, index, inRange, rangeSize, )-import Data.Word (Word8, ) import Data.Maybe (fromMaybe, ) import qualified Data.Ix.Enum as IxEnum import qualified Data.EnumSet as EnumSet   -- The type of client ports.-newtype T = Cons Word8 deriving (Eq, Ord, Storable)+newtype T =+   Cons #{intfieldtype snd_seq_addr_t, port}+      deriving (Eq, Ord, Storable)  instance Show T where    showsPrec prec (Cons x) =       U.showsRecord prec "Port" [U.showsField x]  -exp :: T -> CInt+exp :: T -> C.CInt exp (Cons p) = fromIntegral p -imp :: CInt -> T+imp :: C.CInt -> T imp p = Cons (fromIntegral p)  @@ -194,10 +198,10 @@   -- | Port capabilities.-type Cap = EnumSet.T CUInt CapabilityFlag+type Cap = EnumSet.T C.CUInt CapabilityFlag  -- | Port types.-type Type = EnumSet.T CUInt TypeFlag+type Type = EnumSet.T C.CUInt TypeFlag  #{enum T, Cons  , systemTimer    = SND_SEQ_PORT_SYSTEM_TIMER

@@ -0,0 +1,126 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Sound.ALSA.Sequencer.Marshal.PortInfo+-- Copyright : (c) Henning Thielemann, 2010-2012+--             (c) Iavor S. Diatchki, 2007+-- License   : BSD3+--+-- Maintainer: Henning Thielemann+-- Stability : provisional+--+-- This module contains functions for working with ports.+-- Reference:+-- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_port.html>+--------------------------------------------------------------------------------++module Sound.ALSA.Sequencer.Marshal.PortInfo where++#include <Sound/ALSA/Sequencer/Area.h>++import qualified Sound.ALSA.Sequencer.Marshal.Client as Client+import qualified Sound.ALSA.Sequencer.Marshal.Port as Port+import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue+import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr+import qualified Sound.ALSA.Sequencer.Area as Area+import qualified Sound.ALSA.Sequencer.Query as Query+import qualified Sound.ALSA.Sequencer.Utility as U+import qualified Sound.ALSA.Exception as Exc++import qualified Data.EnumSet as EnumSet++import qualified Foreign.C.Types as C+import Foreign.Ptr (Ptr, )+import Data.Word (Word, )+++#area "port_info"++{- |+Create a new information area filled with data+about a specific port on our client.+-}+#get_area "Port.T"+{- |+Set the information for the sequencer port+based on the data in the given information area.+-}+#set_area "Port.T"++-- read/write+#get_set_name++#get_set_bool "port_specified", "PortSpecified"+#get_set_bool "timestamping", "Timestamping"+#get_set_bool "timestamp_real", "TimestampReal"++#{get_set_int "port", "Port",+          "Port.T", "Port.imp", "Port.exp"}+#{get_set_int "client", "Client",+          "Client.T", "Client.imp", "Client.exp"}+#{get_set_int "capability", "Capability",+          "Port.Cap", "(EnumSet.Cons . fromIntegral)", "(fromIntegral . EnumSet.decons)"}++#{get_set_int "midi_channels", "MidiChannels",+          "Word", "fromIntegral", "fromIntegral"}+#{get_set_int "midi_voices", "MidiVoices",+          "Word", "fromIntegral", "fromIntegral"}+#{get_set_int "synth_voices", "SynthVoices",+          "Word", "fromIntegral", "fromIntegral"}++#{get_set_int "timestamp_queue", "TimestampQueue",+          "Queue.T", "Queue.imp", "Queue.exp"}+++-- | Get the address of the information area.+#{get_ptr "addr", "Addr", "Addr.T"}++-- | Set the port address.+#{set_ptr "addr", "Addr", "Addr.T"}+++-- read only+#{get_int "read_use", "ReadUse", "Word", "fromIntegral"}+#{get_int "write_use", "WriteUse", "Word", "fromIntegral"}++++-- | Create a new information area filled with data about an given+-- port on a given client.+getAny :: Seq.T mode -> Client.T -> Port.T -> IO T+getAny (Seq.Cons h) c p =+  do info <- malloc+     Exc.checkResult_ "getAny" =<<+       with info (getAny_ h (Client.exp c) (Port.exp p))+     return info++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_any_port_info"+  getAny_+    :: Ptr Seq.Core -> C.CInt -> C.CInt -> Ptr T_ -> IO C.CInt++queryInit :: T -> IO ()+queryInit x =+  {-+  we cannot use setPort here,+  since Port uses an unsigned type and thus cannot represent -1+  -}+  with x (flip setPort_ (-1))++-- | Get information about the first port on our client.+queryFirst :: Seq.T mode -> IO T+queryFirst = Query.first++-- | Get information about the port with the next biggest identifier.+-- If a matching port is found, then its information is stored in the+-- given area and 'True' is returned.+queryNext :: Seq.T mode -> T -> IO Bool+queryNext (Seq.Cons h) info =+  U.checkResultQuery "PortInfo.queryNext" =<< with info (queryNext_ h)++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_next_port"+  queryNext_ :: Ptr Seq.Core -> Ptr T_ -> IO C.CInt+++instance Query.C T where+  init = queryInit+  next = queryNext

@@ -1,21 +0,0 @@-module Sound.ALSA.Sequencer.Marshal.QuerySubscribe where--#include <alsa/asoundlib.h>-import Foreign.C.Types (CInt, )---data Type =-     Read-   | Write-   deriving (Show, Eq, Ord, Enum)--expType :: Type -> CInt-expType t  = case t of-  Read  -> #{const SND_SEQ_QUERY_SUBS_READ}-  Write	-> #{const SND_SEQ_QUERY_SUBS_WRITE}--impType :: CInt -> Type-impType t  = case t of-  #{const SND_SEQ_QUERY_SUBS_READ}  -> Read-  #{const SND_SEQ_QUERY_SUBS_WRITE} -> Write-  _ -> error ("QuerySubscribe.impType: unknown subscription type (" ++ show t ++ ")")

@@ -13,37 +13,66 @@ -- Here we have the various types used by the library, -- and how they are imported\/exported to C. ----- NOTE: In the translations bellow we make the following assumptions--- about the sizes of C types.--- CChar  = 8 bits--- CShort = 16 bit--- CInt   = 32 bits+-- We use Hsc for expanding C types to Haskell types like Word32.+-- However if a C type is translated to Word32+-- you should not assume that it is translated to Word32 on every platform.+-- On a 64bit machine it may well be Word64.+-- Thus you should use our wrapper types whereever possible. --------------------------------------------------------------------------------  module Sound.ALSA.Sequencer.Marshal.Queue where  #include <alsa/asoundlib.h>+#include <Sound/ALSA/Sequencer/Marshal/Template.h>+ import qualified Sound.ALSA.Sequencer.Utility as U-import Foreign.C.Types (CInt, )-import Foreign.Storable (Storable, )-import Data.Word (Word8, ) +import qualified Foreign.C.Types as C+import Foreign.Storable (Storable, sizeOf, alignment, peek, peekByteOff, poke, pokeByteOff, ) +import Data.Array (Ix, ) +import qualified Data.Word as Word +++ -- | The type of queue identifiers.-newtype T = Cons Word8 deriving (Eq, Ord, Storable)+newtype T =+   Cons #{intfieldtype snd_seq_event_t, queue}+      deriving (Eq, Ord, Storable)  instance Show T where    showsPrec prec (Cons x) =       U.showsRecord prec "Queue" [U.showsField x] -imp :: CInt -> T+imp :: C.CInt -> T imp x = Cons (fromIntegral x) -exp :: T -> CInt+exp :: T -> C.CInt exp (Cons x) = fromIntegral x  #{enum T, Cons  , direct = SND_SEQ_QUEUE_DIRECT  }+++data Skew =+   Skew {+      skewValue :: ! #{intfieldtype snd_seq_queue_skew_t, value},+      skewBase  :: ! #{intfieldtype snd_seq_queue_skew_t, base}+   } deriving (Show, Eq)++instance Storable Skew where+  sizeOf _    = #{size snd_seq_queue_skew_t}+  alignment _ = #{alignment snd_seq_queue_skew_t}+  peek p      = do v <- #{peek snd_seq_queue_skew_t, value} p+                   b <- #{peek snd_seq_queue_skew_t, base}  p+                   return Skew { skewValue = v+                               , skewBase  = b+                               }+  poke p v    = #{poke snd_seq_queue_skew_t, value} p (skewValue v)+             >> #{poke snd_seq_queue_skew_t, base}  p (skewBase  v)+++#{newintfieldtype "Position", snd_seq_ev_queue_control_t, param.position}

@@ -1,46 +0,0 @@------------------------------------------------------------------------------------ |--- Module    : Sound.ALSA.Sequencer.Marshal.QueueTimer--- Copyright : (c) Henning Thielemann, 2010---             (c) Iavor S. Diatchki, 2007--- License   : BSD3------ Maintainer: Henning Thielemann--- Stability : provisional------ PRIVATE MODULE.------ Here we have the various types used by the library,--- and how they are imported\/exported to C.------ NOTE: In the translations bellow we make the following assumptions--- about the sizes of C types.--- CChar  = 8 bits--- CShort = 16 bit--- CInt   = 32 bits-----------------------------------------------------------------------------------module Sound.ALSA.Sequencer.Marshal.QueueTimer where--#include <alsa/asoundlib.h>-import Foreign.C.Types (CInt, )---data Type =-     Alsa-   | MidiClock-   | MidiTick-   deriving (Show, Eq, Ord, Enum)--expType :: Type -> CInt-expType t  = case t of-  Alsa       -> #{const SND_SEQ_TIMER_ALSA}-  MidiClock  -> #{const SND_SEQ_TIMER_MIDI_CLOCK}-  MidiTick   -> #{const SND_SEQ_TIMER_MIDI_TICK}--impType :: CInt -> Type-impType t  = case t of-  #{const SND_SEQ_TIMER_ALSA}         -> Alsa-  #{const SND_SEQ_TIMER_MIDI_CLOCK}   -> MidiClock-  #{const SND_SEQ_TIMER_MIDI_TICK}    -> MidiTick-  _ -> error ("QueueTimer.impType: unknown timer type (" ++ show t ++ ")")

@@ -1,18 +1,20 @@ module Sound.ALSA.Sequencer.Marshal.RealTime where  #include <alsa/asoundlib.h>+#include <Sound/ALSA/Sequencer/Marshal/Template.h>  import qualified Sound.ALSA.Sequencer.Utility as U +import qualified Data.Word as Word import Foreign.Storable           (Storable, sizeOf, alignment, peek, poke, pokeByteOff, peekByteOff, )-import Data.Word (Word32, )   data T = Cons-   { secs :: !Word32-   , nano :: !Word32+   { secs :: ! #{intfieldtype snd_seq_real_time_t, tv_sec}+   , nano :: ! #{intfieldtype snd_seq_real_time_t, tv_nsec}    }+   deriving (Eq)  instance Show T where    showsPrec prec (Cons s n) =@@ -21,7 +23,7 @@  instance Storable T where   sizeOf _    = #{size snd_seq_real_time_t}-  alignment _ = 4 -- XXX+  alignment _ = #{alignment snd_seq_real_time_t}   peek p      = do s <- #{peek snd_seq_real_time_t, tv_sec} p                    n <- #{peek snd_seq_real_time_t, tv_nsec} p                    return Cons { secs = s, nano = n }

@@ -12,25 +12,19 @@ -- -- Here we have the various types used by the library, -- and how they are imported\/exported to C.------ NOTE: In the translations bellow we make the following assumptions--- about the sizes of C types.--- CChar  = 8 bits--- CShort = 16 bit--- CInt   = 32 bits --------------------------------------------------------------------------------  module Sound.ALSA.Sequencer.Marshal.Sequencer where  #include <alsa/asoundlib.h>-import Foreign.C.Types (CInt, )+import qualified Foreign.C.Types as C import Foreign.Ptr (Ptr, )   -- | Read\/Write permissions for the sequencer device. -- This way we prevent the ALSA exception 22 "Invalid argument" -- when calling @event_output@ on an input-only sequencer.-class OpenMode mode where expOpenMode :: mode -> CInt+class OpenMode mode where expOpenMode :: mode -> C.CInt  class OpenMode mode => AllowInput  mode where class OpenMode mode => AllowOutput mode where@@ -54,7 +48,7 @@                     | Nonblock  -- ^ Throw exceptions instead of blocking.                       deriving (Show,Eq) -expBlockMode      :: BlockMode -> CInt+expBlockMode      :: BlockMode -> C.CInt expBlockMode x     = case x of   Block     -> 0   Nonblock  -> #{const SND_SEQ_NONBLOCK}

@@ -0,0 +1,31 @@+#include <stdio.h>++#define hsc_alignment(t) \+    printf("(%ld)", (unsigned long)offsetof(struct {char x__; t (y__); }, y__));++#define hsc_inttype(t) \+    printf ("%s%lu",                                    \+            (t)(-1) < (t)0 ? "Int.Int" : "Word.Word",   \+            (unsigned long)sizeof (t) * 8);             \++#define hsc_intfieldtype(r,f) \+    { \+        r x, y;    \+        x.f = -1;  \+        y.f = 0;   \+        printf ("%s%lu",                               \+                x.f < y.f ? "Int.Int" : "Word.Word",   \+                (unsigned long)sizeof (x.f) * 8);      \+    }++#define hsc_newinttype(nm,t) \+    printf ("newtype "nm" = "nm" { un"nm" :: "); \+    hsc_inttype(t); \+    printf (" }\n"); \+    printf (" deriving (Show, Eq, Ord, Ix, Storable)\n");++#define hsc_newintfieldtype(nm,r,f) \+    printf ("newtype "nm" = "nm" { un"nm" :: "); \+    hsc_intfieldtype(r,f); \+    printf (" }\n"); \+    printf (" deriving (Show, Eq, Ord, Ix, Storable)\n");

@@ -0,0 +1,107 @@+module Sound.ALSA.Sequencer.Marshal.Time where++#include <alsa/asoundlib.h>+#include <Sound/ALSA/Sequencer/Marshal/Template.h>++import qualified Sound.ALSA.Sequencer.Marshal.RealTime as RealTime++import qualified Sound.ALSA.Sequencer.Utility as U+import qualified Foreign.Storable as St+-- import qualified Foreign.C.Types as C+import Foreign.Ptr (Ptr, castPtr, )+import qualified Data.FlagSet as FlagSet+import qualified Data.Word as Word+import Data.Monoid (mappend, )++import qualified Data.Accessor.Basic as Acc+++data T = Cons {mode :: Mode, stamp :: Stamp}++instance Show T where+   showsPrec prec (Cons m st) =+      U.showsRecord prec "Time"+         [U.showsField m, U.showsField st]+++consAbs :: Stamp -> T+consAbs = Cons Absolute++consRel :: Stamp -> T+consRel = Cons Relative+++modeAcc :: Acc.T T Mode+modeAcc =+   Acc.fromSetGet (\x ev -> ev{mode = x}) mode++stampAcc :: Acc.T T Stamp+stampAcc =+   Acc.fromSetGet (\x ev -> ev{stamp = x}) stamp+++type Tick = #{inttype snd_seq_tick_time_t}++data Mode = Absolute | Relative+   deriving (Eq, Show, Enum)++data Stamp =+     Tick !Tick+   | Real !RealTime.T+     deriving Show+++class Flag flag where++type FlagContainer = #{intfieldtype snd_seq_event_t, flags}++stampTick, stampReal :: Flag flag => FlagSet.MaskedValue FlagContainer flag+stampTick =+   FlagSet.MaskedValue+      #{const SND_SEQ_TIME_STAMP_MASK}+      #{const SND_SEQ_TIME_STAMP_TICK}+stampReal =+   FlagSet.MaskedValue+      #{const SND_SEQ_TIME_STAMP_MASK}+      #{const SND_SEQ_TIME_STAMP_REAL}+++modeAbs, modeRel :: Flag flag => FlagSet.MaskedValue FlagContainer flag+modeAbs =+   FlagSet.MaskedValue+      #{const SND_SEQ_TIME_MODE_MASK}+      #{const SND_SEQ_TIME_MODE_ABS}+modeRel =+   FlagSet.MaskedValue+      #{const SND_SEQ_TIME_MODE_MASK}+      #{const SND_SEQ_TIME_MODE_REL}+++peek :: Flag flag => FlagSet.T FlagContainer flag -> Ptr T -> IO T+peek flags p =+   fmap+      (Cons+         (if FlagSet.match flags modeAbs+            then Absolute+            else Relative)) $+   peekStamp flags $ castPtr p++poke :: Flag flag => Ptr T -> T -> IO (FlagSet.MaskedValue FlagContainer flag)+poke p (Cons m st) =+   fmap (mappend+      (case m of+         Absolute -> modeAbs+         Relative -> modeRel)) $+   pokeStamp (castPtr p) st+++peekStamp :: Flag flag => FlagSet.T FlagContainer flag -> Ptr Stamp -> IO Stamp+peekStamp flags p =+   if FlagSet.match flags stampTick+     then fmap Tick $ St.peek $ castPtr p+     else fmap Real $ St.peek $ castPtr p++pokeStamp :: Flag flag => Ptr Stamp -> Stamp -> IO (FlagSet.MaskedValue FlagContainer flag)+pokeStamp p ts = case ts of+   Tick t -> St.poke (castPtr p) t >> return stampTick+   Real t -> St.poke (castPtr p) t >> return stampReal

@@ -0,0 +1,29 @@+module Sound.ALSA.Sequencer.Poll+  ( descriptors+  ) where++import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified System.Posix.Poll as Poll++import qualified Foreign.C.Types as C+import Foreign.Marshal.Array (peekArray, allocaArray, )+import Foreign.Ptr (Ptr, )++-- expose EnumSet.Cons for foreign call+import qualified Data.EnumSet as EnumSet++_dummyEnumSet :: EnumSet.T Int Bool+_dummyEnumSet = undefined+++descriptors :: Seq.T mode -> Poll.Events -> IO [Poll.Fd]+descriptors (Seq.Cons h) e = do+  n <- snd_seq_poll_descriptors_count h e+  allocaArray (fromIntegral n) $ \p ->+    flip peekArray p . fromIntegral =<< snd_seq_poll_descriptors h p n e++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_poll_descriptors_count"+  snd_seq_poll_descriptors_count :: Ptr Seq.Core -> Poll.Events -> IO C.CInt++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_poll_descriptors"+  snd_seq_poll_descriptors :: Ptr Seq.Core -> Ptr Poll.Fd -> C.CInt -> Poll.Events -> IO C.CInt

@@ -14,7 +14,7 @@ --------------------------------------------------------------------------------  module Sound.ALSA.Sequencer.Port-  ( Port.T+  ( Port.T(Port.Cons)   , create   , createSimple   , delete@@ -60,14 +60,16 @@   ) where  import qualified Sound.ALSA.Sequencer.Marshal.Port as Port+import qualified Sound.ALSA.Sequencer.Marshal.PortInfo as PortInfo import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq import qualified Sound.ALSA.Exception as Exc-import Sound.ALSA.Sequencer.Area -import Foreign.C.Types (CInt, )+import qualified Foreign.C.Types as C import Foreign.C.String (CString, withCAString, ) import Foreign.Ptr (Ptr, ) +import qualified Data.EnumSet as EnumSet -- expose EnumSet.Cons for foreign call+ import Control.Exception (bracket, )  @@ -82,7 +84,7 @@  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_create_simple_port"   snd_seq_create_simple_port :: Ptr Seq.Core -> CString -> Port.Cap -> Port.Type-                                -> IO CInt+                                -> IO C.CInt   -- | Delete the port.@@ -91,7 +93,7 @@   Exc.checkResult_ "delete_simple_port" =<< snd_seq_delete_simple_port h (fromIntegral p)  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_delete_simple_port"-  snd_seq_delete_simple_port :: Ptr Seq.Core -> CInt -> IO CInt+  snd_seq_delete_simple_port :: Ptr Seq.Core -> C.CInt -> IO C.CInt   withSimple ::@@ -106,12 +108,12 @@ --------------------------------------------------------------------------------  -- | Create a new port, as described by the info structure.-create :: Seq.T mode -> PortInfo -> IO ()+create :: Seq.T mode -> PortInfo.T -> IO () create (Seq.Cons h) p =-  Exc.checkResult_ "create_port" =<< with_port_info p (snd_seq_create_port h)+  Exc.checkResult_ "create_port" =<< PortInfo.with p (snd_seq_create_port h)  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_create_port"-  snd_seq_create_port :: Ptr Seq.Core -> Ptr PortInfo_ -> IO CInt+  snd_seq_create_port :: Ptr Seq.Core -> Ptr PortInfo.T_ -> IO C.CInt  -- | Delete the port. delete :: Seq.T mode -> Port.T -> IO ()@@ -119,4 +121,9 @@   Exc.checkResult_ "delete_port" =<< snd_seq_delete_port h (fromIntegral p)  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_delete_port"-  snd_seq_delete_port :: Ptr Seq.Core -> CInt -> IO CInt+  snd_seq_delete_port :: Ptr Seq.Core -> C.CInt -> IO C.CInt++++_dummyEnumSet :: EnumSet.T Int Bool+_dummyEnumSet = undefined

@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- |--- Module    : Sound.ALSA.Sequencer.Port--- Copyright : (c) Henning Thielemann, 2010+-- Module    : Sound.ALSA.Sequencer.Port.Info+-- Copyright : (c) Henning Thielemann, 2010-2012 --             (c) Iavor S. Diatchki, 2007 -- License   : BSD3 --@@ -20,6 +20,8 @@   , getAny   , queryFirst   , queryNext+  , queryLoop_+  , queryLoop   , set    , copy@@ -55,152 +57,16 @@   , setTimestampQueue   ) where +import Sound.ALSA.Sequencer.Marshal.PortInfo+ import qualified Sound.ALSA.Sequencer.Marshal.Client as Client-import qualified Sound.ALSA.Sequencer.Marshal.Port as Port-import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq-import qualified Sound.ALSA.Sequencer.Area as Area-import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr-import qualified Sound.ALSA.Exception as Exc -import Foreign.C.Types (CInt, )-import Foreign.Ptr (Ptr, )-import Foreign.Marshal.Alloc (alloca, )-import Foreign.Storable (poke, peek, )-import Data.Word (Word, )---type T = Area.PortInfo-type T_ = Area.PortInfo_----- | Create a new information area filled with data about a specific--- port on our client.-get :: Seq.T mode -> Port.T -> IO T-get (Seq.Cons h) p =-  do info <- Area.port_info_malloc-     Exc.checkResult_ "get_port_info" =<< Area.with_port_info info (snd_seq_get_port_info h (Port.exp p))-     return info--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_port_info"-  snd_seq_get_port_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt----- | Create a new information area filled with data about an given--- port on a given client.-getAny :: Seq.T mode -> Client.T -> Port.T -> IO T-getAny (Seq.Cons h) c p =-  do info <- Area.port_info_malloc-     Exc.checkResult_ "get_any_port_info" =<< Area.with_port_info info-                       (snd_seq_get_any_port_info h (Client.exp c) (Port.exp p))-     return info--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_any_port_info"-  snd_seq_get_any_port_info-    :: Ptr Seq.Core -> CInt -> CInt -> Ptr T_ -> IO CInt---- | Get information about the first port on our client.-queryFirst  :: Seq.T mode -> IO T-queryFirst s =-  do x <- Area.port_info_malloc-     Area.with_port_info x (`Area.snd_seq_port_info_set_port` (-1))-     queryNext s x-     return x----- | Get information about the port with the next biggest identifier.--- If a matching port is found, then its information is stored in the--- given area, otherwise we throw an error.-queryNext :: Seq.T mode -> T -> IO ()-queryNext (Seq.Cons h) info =-   Exc.checkResult_ "query_next_port" =<< Area.with_port_info info (snd_seq_query_next_port h)--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_next_port"-  snd_seq_query_next_port :: Ptr Seq.Core -> Ptr T_ -> IO CInt---- | Set the information for the sequencer port based on the data--- in the given information area.-set :: Seq.T mode -> Port.T -> T -> IO ()-set (Seq.Cons h) p info =-  Exc.checkResult_ "set_port_info" =<< Area.with_port_info info (snd_seq_set_port_info h (Port.exp p))--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_port_info"-  snd_seq_set_port_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt------ | Get the address of the information area.-getAddr :: T -> IO Addr.T-getAddr i =-  peek =<< Area.with_port_info i snd_seq_port_info_get_addr--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_info_get_addr"-  snd_seq_port_info_get_addr :: Ptr T_ -> IO (Ptr Addr.T)----- | Set the port address.-setAddr :: T -> Addr.T -> IO ()-setAddr i c =-  alloca $ \p -> poke p c >> Area.with_port_info i (`snd_seq_port_info_set_addr` p)--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_info_set_addr"-  snd_seq_port_info_set_addr :: Ptr T_ -> Ptr Addr.T -> IO ()-+import qualified Sound.ALSA.Sequencer.Query as Query  -copy :: T -> T -> IO ()-clone :: T -> IO T-getPort :: T -> IO Port.T-getClient :: T -> IO Client.T-getName :: T -> IO String-getCapability :: T -> IO Port.Cap-getMidiChannels :: T -> IO Word-getMidiVoices :: T -> IO Word-getSynthVoices :: T -> IO Word-getPortSpecified :: T -> IO Bool-getTimestamping :: T -> IO Bool-getTimestampReal :: T -> IO Bool-getTimestampQueue :: T -> IO Queue.T-getReadUse :: T -> IO Word-getWriteUse :: T -> IO Word-setPort :: T -> Port.T -> IO ()-setClient :: T -> Client.T -> IO ()-setName :: T -> String -> IO ()-setCapability :: T -> Port.Cap -> IO ()-setMidiChannels :: T -> Word -> IO ()-setSynthVoices :: T -> Word -> IO ()-setMidiVoices :: T -> Word -> IO ()-setPortSpecified :: T -> Bool -> IO ()-setTimestamping :: T -> Bool -> IO ()-setTimestampReal :: T -> Bool -> IO ()-setTimestampQueue :: T -> Queue.T -> IO ()--copy              = Area.port_info_copy-clone             = Area.port_info_clone--getPort           = Area.port_info_get_port-getClient         = Area.port_info_get_client-getName           = Area.port_info_get_name-getCapability     = Area.port_info_get_capability-getMidiChannels   = Area.port_info_get_midi_channels-getMidiVoices     = Area.port_info_get_midi_voices-getSynthVoices    = Area.port_info_get_synth_voices-getPortSpecified  = Area.port_info_get_port_specified-getTimestamping   = Area.port_info_get_timestamping-getTimestampReal  = Area.port_info_get_timestamp_real-getTimestampQueue = Area.port_info_get_timestamp_queue--getReadUse        = Area.port_info_get_read_use-getWriteUse       = Area.port_info_get_write_use+queryLoop_ :: Seq.T mode -> Client.T -> (T -> IO ()) -> IO ()+queryLoop_ h c = Query.loop_ h (flip setClient c) -setPort           = Area.port_info_set_port-setClient         = Area.port_info_set_client-setName           = Area.port_info_set_name-setCapability     = Area.port_info_set_capability-setMidiChannels   = Area.port_info_set_midi_channels-setSynthVoices    = Area.port_info_set_synth_voices-setMidiVoices     = Area.port_info_set_midi_voices-setPortSpecified  = Area.port_info_set_port_specified-setTimestamping   = Area.port_info_set_timestamping-setTimestampReal  = Area.port_info_set_timestamp_real-setTimestampQueue = Area.port_info_set_timestamp_queue+queryLoop :: Seq.T mode -> Client.T -> (T -> IO a) -> IO [a]+queryLoop h c = Query.loop h (flip setClient c)

@@ -0,0 +1,147 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Sound.ALSA.Sequencer.Port.Info+-- Copyright : (c) Henning Thielemann, 2010-2012+--             (c) Iavor S. Diatchki, 2007+-- License   : BSD3+--+-- Maintainer: Henning Thielemann+-- Stability : provisional+--+-- This module contains functions for working with ports.+-- Reference:+-- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_port.html>+--------------------------------------------------------------------------------++module Sound.ALSA.Sequencer.Port.InfoMonad (+  T,++  run,+  get,+  modify,++  getPort,+  getClient,+  getAddr,+  getName,+  getCapability,+  getMidiChannels,+  getMidiVoices,+  getSynthVoices,+  getPortSpecified,+  getTimestamping,+  getTimestampReal,+  getTimestampQueue,++  getReadUse,+  getWriteUse,++  setPort,+  setClient,+  setAddr,+  setName,+  setCapability,+  setMidiChannels,+  setSynthVoices,+  setMidiVoices,+  setPortSpecified,+  setTimestamping,+  setTimestampReal,+  setTimestampQueue,+  ) where++import qualified Sound.ALSA.Sequencer.Marshal.PortInfo as PortInfo+import qualified Sound.ALSA.Sequencer.Marshal.Port as Port+import qualified Sound.ALSA.Sequencer.Marshal.Client as Client+import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue+import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr+import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq++import qualified Control.Monad.Trans.Reader as MR+import Control.Applicative (Applicative, )++import Data.Word (Word, )+++newtype T a = Cons (MR.ReaderT PortInfo.T IO a)+   deriving (Functor, Applicative, Monad)+++run :: T a -> PortInfo.T -> IO a+run (Cons m) = MR.runReaderT m++get :: Seq.T mode -> Port.T -> T a -> IO a+get h p m = run m =<< PortInfo.get h p++modify :: Seq.T mode -> Port.T -> T a -> IO a+modify h p m = do+  i <- PortInfo.get h p+  a <- run m i+  PortInfo.set h p i+  return a+++liftGet :: (PortInfo.T -> IO a) -> T a+liftGet f = Cons $ MR.ReaderT f++liftSet :: (PortInfo.T -> b -> IO a) -> b -> T a+liftSet f x = Cons $ MR.ReaderT $ flip f x+++getPort :: T Port.T+getClient :: T Client.T+getAddr :: T Addr.T+getName :: T String+getCapability :: T Port.Cap+getMidiChannels :: T Word+getMidiVoices :: T Word+getSynthVoices :: T Word+getPortSpecified :: T Bool+getTimestamping :: T Bool+getTimestampReal :: T Bool+getTimestampQueue :: T Queue.T+getReadUse :: T Word+getWriteUse :: T Word++getPort           = liftGet PortInfo.getPort+getClient         = liftGet PortInfo.getClient+getAddr           = liftGet PortInfo.getAddr+getName           = liftGet PortInfo.getName+getCapability     = liftGet PortInfo.getCapability+getMidiChannels   = liftGet PortInfo.getMidiChannels+getMidiVoices     = liftGet PortInfo.getMidiVoices+getSynthVoices    = liftGet PortInfo.getSynthVoices+getPortSpecified  = liftGet PortInfo.getPortSpecified+getTimestamping   = liftGet PortInfo.getTimestamping+getTimestampReal  = liftGet PortInfo.getTimestampReal+getTimestampQueue = liftGet PortInfo.getTimestampQueue++getReadUse        = liftGet PortInfo.getReadUse+getWriteUse       = liftGet PortInfo.getWriteUse+++setPort :: Port.T -> T ()+setClient :: Client.T -> T ()+setAddr :: Addr.T -> T ()+setName :: String -> T ()+setCapability :: Port.Cap -> T ()+setMidiChannels :: Word -> T ()+setSynthVoices :: Word -> T ()+setMidiVoices :: Word -> T ()+setPortSpecified :: Bool -> T ()+setTimestamping :: Bool -> T ()+setTimestampReal :: Bool -> T ()+setTimestampQueue :: Queue.T -> T ()++setPort           = liftSet PortInfo.setPort+setClient         = liftSet PortInfo.setClient+setAddr           = liftSet PortInfo.setAddr+setName           = liftSet PortInfo.setName+setCapability     = liftSet PortInfo.setCapability+setMidiChannels   = liftSet PortInfo.setMidiChannels+setSynthVoices    = liftSet PortInfo.setSynthVoices+setMidiVoices     = liftSet PortInfo.setMidiVoices+setPortSpecified  = liftSet PortInfo.setPortSpecified+setTimestamping   = liftSet PortInfo.setTimestamping+setTimestampReal  = liftSet PortInfo.setTimestampReal+setTimestampQueue = liftSet PortInfo.setTimestampQueue

@@ -0,0 +1,47 @@+module Sound.ALSA.Sequencer.Query (+  C,+  init,+  next,+  first,+  loop_,+  loop,+  ) where++import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified Sound.ALSA.Sequencer.Area as Area++import Control.Monad (liftM2, when, )++import Prelude hiding (init, )+++class Area.C info => C info where+  init :: info -> IO ()+  next :: Seq.T mode -> info -> IO Bool++first :: (C info) => Seq.T mode -> IO info+first h = do+  i <- Area.malloc+  init i+  _b <- next h i+  return i++loop_ :: (C info) => Seq.T mode -> (info -> IO ()) -> (info -> IO ()) -> IO ()+loop_ h start f = do+  i <- Area.malloc+  start i+  init i+  let go = do+         b <- next h i+         when b $ f i >> go+  go++loop :: (C info) => Seq.T mode -> (info -> IO ()) -> (info -> IO a) -> IO [a]+loop h start f = do+  i <- Area.malloc+  start i+  init i+  let go = do+         b <- next h i+         if b then liftM2 (:) (f i) go else return []+  go

@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module    : Sound.ALSA.Sequencer.Queue--- Copyright : (c) Henning Thielemann, 2010+-- Copyright : (c) Henning Thielemann, 2010-2012 --             (c) Iavor S. Diatchki, 2007 -- License   : BSD3 --@@ -27,23 +27,26 @@   ) where  import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr import qualified Sound.ALSA.Sequencer.Marshal.Event as Event import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue+import qualified Sound.ALSA.Sequencer.Marshal.Time as Time import qualified Sound.ALSA.Exception as Exc -import Foreign.Ptr (Ptr, )-import Foreign.C.Types (CInt, )+import qualified Foreign.C.Types as C import Foreign.C.String (CString, withCAString, )+import Foreign.Ptr (Ptr, )  import Control.Exception (bracket, )+import Control.Functor.HT (void, )   alloc :: Seq.T mode -> IO Queue.T -- ^ Queue.T identifier. alloc (Seq.Cons h) =-  Queue.imp `fmap` (Exc.checkResult "alloc_queue" =<< snd_seq_alloc_queue h)+  fmap Queue.imp $ Exc.checkResult "Queue.alloc" =<< alloc_ h  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_alloc_queue"-  snd_seq_alloc_queue :: Ptr Seq.Core -> IO CInt+  alloc_ :: Ptr Seq.Core -> IO C.CInt  with :: Seq.T mode -> (Queue.T -> IO a) -> IO a with s = bracket (alloc s) (free s)@@ -51,10 +54,10 @@  allocNamed :: Seq.T mode -> String -> IO Queue.T allocNamed (Seq.Cons h) x = withCAString x $ \s ->-  Queue.imp `fmap` (Exc.checkResult "alloc_named_queue" =<< snd_seq_alloc_named_queue h s)+  fmap Queue.imp $ Exc.checkResult "Queue.allocNamed" =<< allocNamed_ h s  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_alloc_named_queue"-  snd_seq_alloc_named_queue :: Ptr Seq.Core -> CString -> IO CInt+  allocNamed_ :: Ptr Seq.Core -> CString -> IO C.CInt  withNamed :: Seq.T mode -> String -> (Queue.T -> IO a) -> IO a withNamed s nm = bracket (allocNamed s nm) (free s)@@ -66,22 +69,72 @@   -> Queue.T    -- ^ Queue.T identifier.   -> IO () free (Seq.Cons h) q =-  Exc.checkResult_ "free_queue" =<< snd_seq_free_queue h (Queue.exp q)+  Exc.checkResult_ "Queue.free" =<< free_ h (Queue.exp q)  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_free_queue"-  snd_seq_free_queue :: Ptr Seq.Core -> CInt -> IO CInt+  free_ :: Ptr Seq.Core -> C.CInt -> IO C.CInt  --- | Queue.T controls - start/stop/continue+{- |+start/stop/continue a queue++In the prototype event you can provide additional information.+The prototype event does not need to be a queue control event,+this part is ignored anyway.+In the prototype event you may also specify a queue.+This is the queue that the timestamp of the prototype event refers to.+This way you can control the target queue using timing from another queue.+-} control-  :: Seq.T mode   -- ^ Sequencer handle.-  -> Queue.T         -- ^ Queue.T identifier.+  :: Seq.T mode    -- ^ Sequencer handle.+  -> Queue.T       -- ^ target Queue.T.   -> Event.QueueEv-  -> Int-  -> Maybe Event.T+  -> Maybe Event.T -- ^ prototype event that may provide timestamp, source queue   -> IO ()-control (Seq.Cons h) q a b me =-  Event.allocaMaybeEv me $ \p -> Exc.checkResult_ "control_queue" =<< snd_seq_control_queue h (Queue.exp q) (fromIntegral $ Event.expEv a) (fromIntegral b) p+control h q cmd me =+  case cmd of+    Event.QueueSetPosTick _ -> controlCustom h q cmd me+    Event.QueueSetPosTime _ -> controlCustom h q cmd me+    Event.QueueSkew _       -> controlCustom h q cmd me+    _ -> controlPlain h q cmd me +controlCustom, controlPlain ::+  Seq.T mode -> Queue.T -> Event.QueueEv -> Maybe Event.T -> IO ()+controlCustom h q cmd me =+  eventOutput h $+    case me of+      Nothing ->+        -- cf. Event.simple+        Event.Cons {+          Event.highPriority = False,+          Event.tag = Event.Tag 0,+          Event.queue = Queue.direct,+          Event.time = Time.consAbs $ Time.Tick 0,+          Event.source = Addr.unknown,+          Event.dest = Addr.systemTimer,+          Event.body = Event.QueueEv cmd q+        }+      Just ev ->+        ev {+          Event.dest = Addr.systemTimer,+          Event.body = Event.QueueEv cmd q+        }++eventOutput :: Seq.T mode -> Event.T -> IO ()+eventOutput h e =+  void $+  Event.with e $ \p ->+     Exc.checkResult "Queue.control.eventOutput" =<< eventOutput_ h p++foreign import ccall safe "alsa/asoundlib.h snd_seq_event_output"+  eventOutput_ :: Seq.T mode -> Ptr Event.T -> IO C.CInt++controlPlain h q cmd me =+  Event.withMaybe me $ \p ->+    let (c,v) = Event.expQueueEv cmd+    in  Exc.checkResult_ "Queue.control"+          =<< control_ h (Queue.exp q)+                 (fromIntegral $ Event.unEType c) v p+ foreign import ccall unsafe "alsa/asoundlib.h snd_seq_control_queue"-  snd_seq_control_queue :: Ptr Seq.Core -> CInt -> CInt -> CInt -> Ptr Event.T -> IO CInt+  control_ :: Seq.T mode -> C.CInt -> C.CInt -> C.CInt -> Ptr Event.T -> IO C.CInt

@@ -1,95 +0,0 @@------------------------------------------------------------------------------------ |--- Module    : Sound.ALSA.Sequencer.Queue.Info--- Copyright : (c) Henning Thielemann, 2010---             (c) Iavor S. Diatchki, 2007--- License   : BSD3------ Maintainer: Henning Thielemann--- Stability : provisional------ This module contains functions for working with sequencer queue.--- Reference:--- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_queue.html>-----------------------------------------------------------------------------------module Sound.ALSA.Sequencer.Queue.Info-  ( T-  , get-  , set-  , copy-  , clone--  , getQueue-  , getName-  , getLocked-  , getOwner-  , getFlags--  , setName-  , setLocked-  , setOwner-  , setFlags-  ) where--import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq-import qualified Sound.ALSA.Sequencer.Marshal.Client as Client-import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue-import qualified Sound.ALSA.Sequencer.Area as Area-import qualified Sound.ALSA.Exception as Exc--import Foreign.Ptr (Ptr, )-import Foreign.C.Types (CInt, )-import Data.Word (Word, )---type T = Area.QueueInfo-type T_ = Area.QueueInfo_----- XXX: Lots of duplication.--get :: Seq.T mode -> Queue.T -> IO T-get (Seq.Cons h) q =-  do info <- Area.queue_info_malloc-     Exc.checkResult_ "get_queue_info" =<< Area.with_queue_info info-                                     (snd_seq_get_queue_info h (Queue.exp q))-     return info--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_queue_info"-  snd_seq_get_queue_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt---set :: Seq.T mode -> Queue.T -> T -> IO ()-set (Seq.Cons h) p info =-  Exc.checkResult_ "set_queue_info" =<< Area.with_queue_info info (snd_seq_set_queue_info h (Queue.exp p))--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_queue_info"-  snd_seq_set_queue_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt---copy :: T -> T -> IO ()-clone :: T -> IO T-getQueue :: T -> IO Queue.T-getName :: T -> IO String-getLocked :: T -> IO Bool-getOwner :: T -> IO Client.T-getFlags :: T -> IO Word-setName :: T -> String -> IO ()-setLocked :: T -> Bool -> IO ()-setOwner :: T -> Client.T -> IO ()-setFlags :: T -> Word -> IO ()--copy       = Area.queue_info_copy-clone      = Area.queue_info_clone--getQueue   = Area.queue_info_get_queue-getName    = Area.queue_info_get_name-getLocked  = Area.queue_info_get_locked-getOwner   = Area.queue_info_get_owner-getFlags   = Area.queue_info_get_flags--setName    = Area.queue_info_set_name-setLocked  = Area.queue_info_set_locked-setOwner   = Area.queue_info_set_owner-setFlags   = Area.queue_info_set_flags

@@ -0,0 +1,61 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Sound.ALSA.Sequencer.Queue.Info+-- Copyright : (c) Henning Thielemann, 2010-2012+--             (c) Iavor S. Diatchki, 2007+-- License   : BSD3+--+-- Maintainer: Henning Thielemann+-- Stability : provisional+--+-- This module contains functions for working with sequencer queue.+-- Reference:+-- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_queue.html>+--------------------------------------------------------------------------------++module Sound.ALSA.Sequencer.Queue.Info+  ( T+  , get+  , set+  , copy+  , clone++  , getQueue+  , getName+  , getLocked+  , getOwner+  , getFlags++  , setName+  , setLocked+  , setOwner+  , setFlags+  ) where++#include <Sound/ALSA/Sequencer/Area.h>++import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified Sound.ALSA.Sequencer.Marshal.Client as Client+import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue+import qualified Sound.ALSA.Sequencer.Area as Area+import qualified Sound.ALSA.Exception as Exc++import qualified Foreign.C.Types as C+import Data.Word (Word, )+++#area "queue_info"++#{get_area "Queue.T"}+#{set_area "Queue.T"}+++#{get_set_name}+#{get_set_bool "locked", "Locked"}++#{get_set_int "owner", "Owner", "Client.T", "Client.imp", "Client.exp"}+#{get_set_int "flags", "Flags", "Word", "fromIntegral", "fromIntegral"}+++-- RO+#{get_int "queue", "Queue", "Queue.T", "Queue.imp"}

@@ -1,106 +0,0 @@------------------------------------------------------------------------------------ |--- Module    : Sound.ALSA.Sequencer.Queue.Status--- Copyright : (c) Henning Thielemann, 2010---             (c) Iavor S. Diatchki, 2007--- License   : BSD3------ Maintainer: Henning Thielemann--- Stability : provisional------ This module contains functions for working with sequencer queue.--- Reference:--- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_queue.html>-----------------------------------------------------------------------------------module Sound.ALSA.Sequencer.Queue.Status-  ( T-  , get-  , copy-  , clone--  , getQueue-  , getEvents-  , getTickTime-  , getRealTime-  ) where--import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq-import qualified Sound.ALSA.Sequencer.Marshal.RealTime as RealTime-import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue-import qualified Sound.ALSA.Sequencer.Area as Area-import qualified Sound.ALSA.Exception as Exc--import Foreign.Ptr (Ptr, )-import Foreign.C.Types (CInt, CUInt, )-import Foreign.Storable (peek, )-import Data.Word (Word32, )---type T = Area.QueueStatus-type T_ = Area.QueueStatus_---get :: Seq.T mode -> Queue.T -> IO T-get (Seq.Cons h) q =-  do status <- Area.queue_status_malloc-     Exc.checkResult_ "get_queue_status" =<< Area.with_queue_status status-                                     (snd_seq_get_queue_status h (Queue.exp q))-     return status--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_queue_status"-  snd_seq_get_queue_status :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt----copy :: T -> T -> IO ()-clone :: T -> IO T--copy  = Area.queue_status_copy-clone = Area.queue_status_clone---foreign import ccall unsafe "alsa/asoundlib.h"-   snd_seq_queue_status_get_queue-      :: Ptr T_ -> IO CInt-foreign import ccall unsafe "alsa/asoundlib.h"-   snd_seq_queue_status_get_events-      :: Ptr T_ -> IO CInt-foreign import ccall unsafe "alsa/asoundlib.h"-   snd_seq_queue_status_get_tick_time-      :: Ptr T_ -> IO Word32-foreign import ccall unsafe "alsa/asoundlib.h"-   snd_seq_queue_status_get_real_time-      :: Ptr T_ -> IO (Ptr RealTime.T)-foreign import ccall unsafe "alsa/asoundlib.h"-   snd_seq_queue_status_get_status-      :: Ptr T_ -> IO CUInt---getQueue :: T -> IO Queue.T-getQueue status =-   fmap Queue.imp $-   Area.with_queue_status status snd_seq_queue_status_get_queue--getEvents :: T -> IO Int-getEvents status =-   fmap fromIntegral $-   Area.with_queue_status status snd_seq_queue_status_get_events--getTickTime :: T -> IO Word32-getTickTime status =-   Area.with_queue_status status snd_seq_queue_status_get_tick_time--getRealTime :: T -> IO RealTime.T-getRealTime status =-   peek =<<-   Area.with_queue_status status snd_seq_queue_status_get_real_time--{--This function shall return status bits of the queue,-but the ALSA headers do not define any bits.-I would prefer a data type that handles this bitfield.--}-_getStatus :: T -> IO CUInt-_getStatus status =-   Area.with_queue_status status snd_seq_queue_status_get_status

@@ -0,0 +1,56 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Sound.ALSA.Sequencer.Queue.Status+-- Copyright : (c) Henning Thielemann, 2010-2012+--             (c) Iavor S. Diatchki, 2007+-- License   : BSD3+--+-- Maintainer: Henning Thielemann+-- Stability : provisional+--+-- This module contains functions for working with sequencer queue.+-- Reference:+-- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_queue.html>+--------------------------------------------------------------------------------++module Sound.ALSA.Sequencer.Queue.Status+  ( T+  , get+  , copy+  , clone++  , getQueue+  , getEvents+  , getTickTime+  , getRealTime+  ) where++#include <Sound/ALSA/Sequencer/Area.h>++import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified Sound.ALSA.Sequencer.Marshal.RealTime as RealTime+import qualified Sound.ALSA.Sequencer.Marshal.Time as Time+import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue+import qualified Sound.ALSA.Sequencer.Area as Area+import qualified Sound.ALSA.Exception as Exc++import qualified Foreign.C.Types as C+++#area "queue_status"+++#{get_area "Queue.T"}++#{get_int "tick_time", "TickTime", "Time.Tick", "fromIntegral"}+#{get_ptr "real_time", "RealTime", "RealTime.T"}+#{get_int "queue", "Queue", "Queue.T", "Queue.imp"}+#{get_int "events", "Events", "Int", "fromIntegral"}++{-+This function shall return status bits of the queue,+but the ALSA headers do not define any bits.+I would prefer a data type that handles this bitfield.++#{get_int "status", "Status", "C.CUInt", "fromIntegral"}+-}

@@ -1,91 +0,0 @@------------------------------------------------------------------------------------ |--- Module    : Sound.ALSA.Sequencer.Queue.Tempo--- Copyright : (c) Henning Thielemann, 2010---             (c) Iavor S. Diatchki, 2007--- License   : BSD3------ Maintainer: Henning Thielemann--- Stability : provisional------ This module contains functions for working with sequencer queue.--- Reference:--- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_queue.html>-----------------------------------------------------------------------------------module Sound.ALSA.Sequencer.Queue.Tempo-  ( T-  , get-  , set-  , copy-  , clone--  , getQueue-  , getTempo-  , getPPQ-  , getSkew-  , getSkewBase--  , setTempo-  , setPPQ-  , setSkew-  , setSkewBase-  ) where--import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue-import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq-import qualified Sound.ALSA.Sequencer.Area as Area-import qualified Sound.ALSA.Exception as Exc--import Foreign.Ptr (Ptr, )-import Foreign.C.Types (CInt, )-import Data.Word (Word, )---type T = Area.QueueTempo-type T_ = Area.QueueTempo_--get :: Seq.T mode -> Queue.T -> IO T-get (Seq.Cons h) q =-  do tempo <- Area.queue_tempo_malloc-     Exc.checkResult_ "get_queue_tempo" =<< Area.with_queue_tempo tempo-                                     (snd_seq_get_queue_tempo h (Queue.exp q))-     return tempo--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_queue_tempo"-  snd_seq_get_queue_tempo :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt---set :: Seq.T mode -> Queue.T -> T -> IO ()-set (Seq.Cons h) p tempo =-  Exc.checkResult_ "set_queue_tempo" =<< Area.with_queue_tempo tempo (snd_seq_set_queue_tempo h (Queue.exp p))--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_queue_tempo"-  snd_seq_set_queue_tempo :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt---copy :: T -> T -> IO ()-clone :: T -> IO T-getQueue :: T -> IO Queue.T-getTempo :: T -> IO Word-getPPQ :: T -> IO Int-getSkew :: T -> IO Word-getSkewBase :: T -> IO Word-setTempo :: T -> Word -> IO ()-setPPQ :: T -> Int -> IO ()-setSkew :: T -> Word -> IO ()-setSkewBase :: T -> Word -> IO ()--copy        = Area.queue_tempo_copy-clone       = Area.queue_tempo_clone--getQueue    = Area.queue_tempo_get_queue-getTempo    = Area.queue_tempo_get_tempo-getPPQ      = Area.queue_tempo_get_ppq-getSkew     = Area.queue_tempo_get_skew-getSkewBase = Area.queue_tempo_get_skew_base--setTempo    = Area.queue_tempo_set_tempo-setPPQ      = Area.queue_tempo_set_ppq-setSkew     = Area.queue_tempo_set_skew-setSkewBase = Area.queue_tempo_set_skew_base

@@ -0,0 +1,59 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Sound.ALSA.Sequencer.Queue.Tempo+-- Copyright : (c) Henning Thielemann, 2010-2012+--             (c) Iavor S. Diatchki, 2007+-- License   : BSD3+--+-- Maintainer: Henning Thielemann+-- Stability : provisional+--+-- This module contains functions for working with sequencer queue.+-- Reference:+-- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_queue.html>+--------------------------------------------------------------------------------++module Sound.ALSA.Sequencer.Queue.Tempo+  ( T+  , get+  , set+  , copy+  , clone++  , getQueue+  , getTempo+  , getPPQ+  , getSkew+  , getSkewBase++  , setTempo+  , setPPQ+  , setSkew+  , setSkewBase+  ) where++#include <Sound/ALSA/Sequencer/Area.h>++import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue+import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified Sound.ALSA.Sequencer.Area as Area+import qualified Sound.ALSA.Exception as Exc++import qualified Foreign.C.Types as C+import Data.Word (Word, )+++#area "queue_tempo"++#{get_area "Queue.T"}+#{set_area "Queue.T"}+++-- RO+#{get_int "queue", "Queue", "Queue.T", "Queue.imp"}++-- RW+#{get_set_int "tempo", "Tempo", "Word", "fromIntegral", "fromIntegral"}+#{get_set_int "ppq", "PPQ", "Int", "fromIntegral", "fromIntegral"}+#{get_set_int "skew", "Skew", "Word", "fromIntegral", "fromIntegral"}+#{get_set_int "skew_base", "SkewBase", "Word", "fromIntegral", "fromIntegral"}

@@ -1,80 +0,0 @@------------------------------------------------------------------------------------ |--- Module    : Sound.ALSA.Sequencer.Queue.Timer--- Copyright : (c) Henning Thielemann, 2010---             (c) Iavor S. Diatchki, 2007--- License   : BSD3------ Maintainer: Henning Thielemann--- Stability : provisional------ This module contains functions for working with sequencer queue.--- Reference:--- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_queue.html>-----------------------------------------------------------------------------------module Sound.ALSA.Sequencer.Queue.Timer-  ( T-  , get-  , set-  , copy-  , clone--  , getQueue-  , getType-  , getResolution--  , setType-  , setResolution--  , QueueTimer.Type(..)-  ) where--import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue-import qualified Sound.ALSA.Sequencer.Marshal.QueueTimer as QueueTimer-import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq-import qualified Sound.ALSA.Sequencer.Area as Area-import qualified Sound.ALSA.Exception as Exc--import Foreign.Ptr (Ptr, )-import Foreign.C.Types (CInt, )-import Data.Word (Word, )---type T = Area.QueueTimer-type T_ = Area.QueueTimer_--get :: Seq.T mode -> Queue.T -> IO T-get (Seq.Cons h) q =-  do timer <- Area.queue_timer_malloc-     Exc.checkResult_ "get_queue_timer" =<< Area.with_queue_timer timer-                                     (snd_seq_get_queue_timer h (Queue.exp q))-     return timer--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_queue_timer"-  snd_seq_get_queue_timer :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt---set :: Seq.T mode -> Queue.T -> T -> IO ()-set (Seq.Cons h) p timer =-  Exc.checkResult_ "set_queue_timer" =<< Area.with_queue_timer timer (snd_seq_set_queue_timer h (Queue.exp p))--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_queue_timer"-  snd_seq_set_queue_timer :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt---copy :: T -> T -> IO ()-clone :: T -> IO T-getQueue :: T -> IO Queue.T-getType :: T -> IO QueueTimer.Type-getResolution :: T -> IO Word-setType :: T -> QueueTimer.Type -> IO ()-setResolution :: T -> Word -> IO ()--copy          = Area.queue_timer_copy-clone         = Area.queue_timer_clone-getQueue      = Area.queue_timer_get_queue-getType       = Area.queue_timer_get_type-getResolution = Area.queue_timer_get_resolution-setType       = Area.queue_timer_set_type-setResolution = Area.queue_timer_set_resolution

@@ -0,0 +1,80 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Sound.ALSA.Sequencer.Queue.Timer+-- Copyright : (c) Henning Thielemann, 2010-2012+--             (c) Iavor S. Diatchki, 2007+-- License   : BSD3+--+-- Maintainer: Henning Thielemann+-- Stability : provisional+--+-- This module contains functions for working with sequencer queue.+-- Reference:+-- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_queue.html>+--------------------------------------------------------------------------------++module Sound.ALSA.Sequencer.Queue.Timer+  ( T+  , get+  , set+  , copy+  , clone++  , getQueue+  , getType+  , getResolution++  , setType+  , setResolution++  , Type(..)+  ) where++#include <alsa/asoundlib.h>+#include <Sound/ALSA/Sequencer/Area.h>++import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue+import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified Sound.ALSA.Sequencer.Area as Area+import qualified Sound.ALSA.Exception as Exc++import qualified Foreign.C.Types as C+import Data.Word (Word, )+++#area "queue_timer"++#{get_area "Queue.T"}+#{set_area "Queue.T"}+++-- RO+#{get_int "queue", "Queue", "Queue.T", "Queue.imp"}++-- RW++#{get_set_int "type", "Type",+            "Type", "impType", "expType"}++#{get_set_int "resolution", "Resolution",+            "Word", "fromIntegral", "fromIntegral"}+++data Type =+     Alsa+   | MidiClock+   | MidiTick+   deriving (Show, Eq, Ord, Enum)++expType :: Type -> C.CInt+expType t  = case t of+  Alsa       -> #{const SND_SEQ_TIMER_ALSA}+  MidiClock  -> #{const SND_SEQ_TIMER_MIDI_CLOCK}+  MidiTick   -> #{const SND_SEQ_TIMER_MIDI_TICK}++impType :: C.CInt -> Type+impType t  = case t of+  #{const SND_SEQ_TIMER_ALSA}         -> Alsa+  #{const SND_SEQ_TIMER_MIDI_CLOCK}   -> MidiClock+  #{const SND_SEQ_TIMER_MIDI_TICK}    -> MidiTick+  _ -> error ("QueueTimer.impType: unknown timer type (" ++ show t ++ ")")

@@ -1,7 +1,7 @@ module Sound.ALSA.Sequencer.RealTime   ( RealTime.T(..)-  , fromDouble, fromInteger-  , toDouble, toInteger+  , fromDouble, fromFractional, fromInteger+  , toDouble, toFractional, toInteger   ) where  import qualified Sound.ALSA.Sequencer.Marshal.RealTime as RealTime@@ -18,9 +18,15 @@    let (s,n) = divMod t nanoPerSecond    in  RealTime.Cons (fromIntegral s) (fromIntegral n) --- | Convert fractional number of seconds to 'RealTime.T'+{- |+Convert fractional number of seconds to 'RealTime.T'+Time must be non-negative.+-} fromDouble :: Double -> RealTime.T-fromDouble t =+fromDouble = fromFractional++fromFractional :: (RealFrac a) => a -> RealTime.T+fromFractional t =    let (s,n) = properFraction t    in  RealTime.Cons s (floor $ n * nanoPerSecond) @@ -31,5 +37,8 @@  -- | Convert fractional number of seconds to 'RealTime.T' toDouble :: RealTime.T -> Double-toDouble (RealTime.Cons s n) =+toDouble = toFractional++toFractional :: (RealFrac a) => RealTime.T -> a+toFractional (RealTime.Cons s n) =    fromIntegral s + fromIntegral n / nanoPerSecond

@@ -5,12 +5,11 @@  module Sound.ALSA.Sequencer.Sequencer where -import qualified Sound.ALSA.Sequencer.Marshal.Port as Port import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq-import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr import qualified Sound.ALSA.Exception as Exc -import Foreign.C.Types (CInt, CSize, )+import qualified Foreign.C.Types as C+import Foreign.C.Types (CSize, ) import Foreign.C.String (CString, withCAString, peekCString, ) import Foreign.Ptr (Ptr, ) import Foreign.Marshal.Alloc (alloca, )@@ -30,20 +29,32 @@  open   :: Seq.OpenMode mode-                -- Read\/Write permissions-  => String     -- ^ The sequencer's \"name\". This is not a name that you-                -- make up for your own purposes; it has special significance-                -- to the ALSA library. Usually you need to pass 'default_name'-                -- here.-  -> Seq.BlockMode  -- Blocking behavior-  -> IO (Seq.T mode)  -- Handle to the sequencer.+        -- Read\/Write permissions+  => String+        {- ^+        The sequencer's \"name\".+        This is not a name that you make up for your own purposes;+        it has special significance to the ALSA library.+        Usually you need to pass 'defaultName' here+        or simply use 'openDefault'.+        -}+  -> Seq.BlockMode    -- ^ Blocking behavior+  -> IO (Seq.T mode)  -- ^ Handle to the sequencer.  open t bm = withOpenMode $ \om -> alloca $ \p -> withCAString t $ \s ->   do Exc.checkResult_ "open" =<< snd_seq_open p s (Seq.expOpenMode om) (Seq.expBlockMode bm)      fmap Seq.Cons $ peek p +openDefault+  :: Seq.OpenMode mode+        -- Read\/Write permissions+  => Seq.BlockMode    -- ^ Blocking behavior+  -> IO (Seq.T mode)  -- ^ Handle to the sequencer.+openDefault = open defaultName++ foreign import ccall unsafe "alsa/asoundlib.h snd_seq_open"-  snd_seq_open :: Ptr (Ptr Seq.Core) -> CString -> CInt -> CInt -> IO CInt+  snd_seq_open :: Ptr (Ptr Seq.Core) -> CString -> C.CInt -> C.CInt -> IO C.CInt  withOpenMode :: (mode -> IO (Seq.T mode)) -> IO (Seq.T mode) withOpenMode f = f undefined@@ -61,30 +72,46 @@ close (Seq.Cons h) = Exc.checkResult_ "close" =<< snd_seq_close h  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_close"-  snd_seq_close :: Ptr Seq.Core -> IO CInt+  snd_seq_close :: Ptr Seq.Core -> IO C.CInt   with   :: Seq.OpenMode mode-                -- Read\/Write permissions-  => String     -- ^ The sequencer's \"name\". This is not a name that you-                -- make up for your own purposes; it has special significance-                -- to the ALSA library. Usually you need to pass 'default_name'-                -- here.+        -- Read\/Write permissions+  => String+        {- ^+        The sequencer's \"name\".+        This is not a name that you make up for your own purposes;+        it has special significance to the ALSA library.+        Usually you need to pass 'defaultName' here+        or simply use 'withDefault'.+        -}   -> Seq.BlockMode-                -- Blocking behavior+        -- ^ Blocking behavior   -> (Seq.T mode -> IO a)-                -- Action on the sequencer, the result must be computed strictly.+        -- ^ Action on the sequencer, the result must be computed strictly.   -> IO a with t bm =    bracket (open t bm) close +withDefault+  :: Seq.OpenMode mode+  => Seq.BlockMode+  -> (Seq.T mode -> IO a)+  -> IO a+withDefault = with defaultName ++-- | This is the name that should be passed to 'open' in most cases.+defaultName :: String+defaultName = "default"++ -- | Get identifier of a sequencer handle. -- It is the same identifier specified in the call to 'open'. getName-  :: Seq.T mode     -- ^ sequencer handle-  -> IO String  -- ^ ALSA identifier for the handel+  :: Seq.T mode  -- ^ sequencer handle+  -> IO String   -- ^ ALSA identifier for the handle getName (Seq.Cons h) = peekCString =<< snd_seq_name h  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_name"@@ -104,7 +131,7 @@ setBlocking (Seq.Cons h) m = Exc.checkResult_ "set_blocking" =<< snd_seq_nonblock h(Seq.expBlockMode m)  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_nonblock"-  snd_seq_nonblock :: Ptr Seq.Core -> CInt -> IO CInt+  snd_seq_nonblock :: Ptr Seq.Core -> C.CInt -> IO C.CInt   @@ -133,7 +160,7 @@   Exc.checkResult_ "set_output_buffer_size" =<< snd_seq_set_output_buffer_size h (fromIntegral x)  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_output_buffer_size"-  snd_seq_set_output_buffer_size :: Ptr Seq.Core -> CSize -> IO CInt+  snd_seq_set_output_buffer_size :: Ptr Seq.Core -> CSize -> IO C.CInt   -- | Return the byte size of input buffer.@@ -159,7 +186,7 @@   Exc.checkResult_ "set_input_buffer_size" =<< snd_seq_set_input_buffer_size h (fromIntegral x)  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_input_buffer_size"-  snd_seq_set_input_buffer_size :: Ptr Seq.Core -> CSize -> IO CInt+  snd_seq_set_input_buffer_size :: Ptr Seq.Core -> CSize -> IO C.CInt   @@ -175,7 +202,7 @@   Exc.checkResult_ "set_pool_output" =<< snd_seq_set_client_pool_output h (fromIntegral x)  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_client_pool_output"-  snd_seq_set_client_pool_output :: Ptr Seq.Core -> CSize -> IO CInt+  snd_seq_set_client_pool_output :: Ptr Seq.Core -> CSize -> IO C.CInt   -- | Specify how much space should become free before waking clients@@ -189,7 +216,7 @@   Exc.checkResult_ "set_pool_output_room" =<< snd_seq_set_client_pool_output_room h (fromIntegral x)  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_client_pool_output_room"-  snd_seq_set_client_pool_output_room :: Ptr Seq.Core -> CSize -> IO CInt+  snd_seq_set_client_pool_output_room :: Ptr Seq.Core -> CSize -> IO C.CInt   -- | Reset the output pool.@@ -201,7 +228,7 @@   Exc.checkResult_ "reset_pool_output" =<< snd_seq_reset_pool_output h  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_reset_pool_output"-  snd_seq_reset_pool_output :: Ptr Seq.Core -> IO CInt+  snd_seq_reset_pool_output :: Ptr Seq.Core -> IO C.CInt   @@ -215,7 +242,7 @@   Exc.checkResult_ "set_pool_input" =<< snd_seq_set_client_pool_input h (fromIntegral x)  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_client_pool_input"-  snd_seq_set_client_pool_input :: Ptr Seq.Core -> CSize -> IO CInt+  snd_seq_set_client_pool_input :: Ptr Seq.Core -> CSize -> IO C.CInt   -- | Reset the input pool.@@ -227,71 +254,4 @@   Exc.checkResult_ "reset_pool_input" =<< snd_seq_reset_pool_input h  foreign import ccall unsafe "alsa/asoundlib.h snd_seq_reset_pool_input"-  snd_seq_reset_pool_input :: Ptr Seq.Core -> IO CInt------------Middle Level Interface ------------------------------------------------------------ | Simple subscription (w\/o exclusive & time conversion).-connectFrom :: Seq.AllowInput mode => Seq.T mode -> Port.T -> Addr.T -> IO ()-connectFrom (Seq.Cons h) me a =-  Exc.checkResult_ "connect_from" =<< snd_seq_connect_from h (Port.exp me) c p-  where (c,p) = Addr.exp a--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_connect_from"-  snd_seq_connect_from :: Ptr Seq.Core -> CInt -> CInt -> CInt -> IO CInt----- | Simple subscription (w\/o exclusive & time conversion).-connectTo :: Seq.AllowOutput mode => Seq.T mode -> Port.T -> Addr.T -> IO ()-connectTo (Seq.Cons h) me a =-  Exc.checkResult_ "connect_to" =<< snd_seq_connect_to h (Port.exp me) c p-  where (c,p) = Addr.exp a--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_connect_to"-  snd_seq_connect_to :: Ptr Seq.Core -> CInt -> CInt -> CInt -> IO CInt----- | Simple disconnection.-disconnectFrom :: Seq.AllowInput mode => Seq.T mode -> Port.T -> Addr.T -> IO ()-disconnectFrom (Seq.Cons h) me a =-  Exc.checkResult_ "disconnect_from" =<< snd_seq_disconnect_from h (Port.exp me) c p-  where (c,p) = Addr.exp a--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_disconnect_from"-  snd_seq_disconnect_from :: Ptr Seq.Core -> CInt -> CInt -> CInt -> IO CInt---- | Simple disconnection.-disconnectTo :: Seq.AllowOutput mode => Seq.T mode -> Port.T -> Addr.T -> IO ()-disconnectTo (Seq.Cons h) me a =-  Exc.checkResult_ "disconnect_to" =<< snd_seq_disconnect_to h (Port.exp me) c p-  where (c,p) = Addr.exp a--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_disconnect_to"-  snd_seq_disconnect_to :: Ptr Seq.Core -> CInt -> CInt -> CInt -> IO CInt----- | Parse the given string into sequencer address.--- The client and port are separated by either colon or period, e.g. 128:1.--- The function also accepts client names.-parseAddress-  :: Seq.T mode   -- ^ Sequencer handle.-  -> String       -- ^ String to be parsed.-  -> IO Addr.T    -- ^ The parsed address.--parseAddress (Seq.Cons h) s =-  alloca $ \pa ->-  withCAString s $ \ps ->-    do Exc.checkResult_ "parse_address" =<< snd_seq_parse_address h pa ps-       peek pa--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_parse_address"-  snd_seq_parse_address :: Ptr Seq.Core -> Ptr Addr.T -> CString -> IO CInt+  snd_seq_reset_pool_input :: Ptr Seq.Core -> IO C.CInt

@@ -1,147 +0,0 @@------------------------------------------------------------------------------------ |--- Module    : Sound.ALSA.Sequencer.Subscribe--- Copyright : (c) Dylan Simon, 2011--- License   : BSD3------ Stability : provisional------ This module contains functions for working with subscriptions.--- Reference:--- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_subscribe.html>-----------------------------------------------------------------------------------module Sound.ALSA.Sequencer.Subscribe-  ( {- T--  , alloc-  , copy-  , clone--  , getSender-  , getDest-  , getQueue-  , getExclusive-  , getTimeUpdate-  , getTimeReal-  -  , setSender-  , setDest-  , setQueue-  , setExclusive-  , setTimeUpdate-  , setTimeReal--  , subscribePort-  , unsubscribePort--  , create-  , -} subscribe-  , unsubscribe-  ) where--import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq-import qualified Sound.ALSA.Sequencer.Area as Area-import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr-import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue-import qualified Sound.ALSA.Exception as Exc--import Foreign.C.Types (CInt, )-import Foreign.Ptr (Ptr, )-import Foreign.Marshal.Alloc (alloca, )-import Foreign.Storable (peek, poke, )--type T = Area.PortSubscribe-type T_ = Area.PortSubscribe_--alloc	      :: IO T-_copy	      :: T -> T -> IO ()-_clone	      :: T -> IO T-_getQueue     :: T -> IO Queue.T-_getExclusive :: T -> IO Bool-_getTimeUpdate:: T -> IO Bool-_getTimeReal  :: T -> IO Bool-setQueue     :: T -> Queue.T -> IO ()-setExclusive  :: T -> Bool -> IO ()-setTimeUpdate :: T -> Bool -> IO ()-setTimeReal   :: T -> Bool -> IO ()--alloc	      = Area.port_subscribe_malloc-_copy	      = Area.port_subscribe_copy-_clone	      = Area.port_subscribe_clone-_getQueue     = Area.port_subscribe_get_queue-_getExclusive = Area.port_subscribe_get_exclusive-_getTimeUpdate= Area.port_subscribe_get_time_update-_getTimeReal  = Area.port_subscribe_get_time_real-setQueue      = Area.port_subscribe_set_queue-setExclusive  = Area.port_subscribe_set_exclusive-setTimeUpdate = Area.port_subscribe_set_time_update-setTimeReal   = Area.port_subscribe_set_time_real---- | Get sender address of a port subscription-_getSender :: T -> IO Addr.T-_getSender s = -  peek =<< Area.with_port_subscribe s snd_seq_port_subscribe_get_sender--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_get_sender"-  snd_seq_port_subscribe_get_sender :: Ptr T_ -> IO (Ptr Addr.T)---- | Get destination address of a port subscription-_getDest :: T -> IO Addr.T-_getDest s = -  peek =<< Area.with_port_subscribe s snd_seq_port_subscribe_get_dest--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_get_dest"-  snd_seq_port_subscribe_get_dest :: Ptr T_ -> IO (Ptr Addr.T)---- | Set sender address of a port subscription-setSender :: T -> Addr.T -> IO ()-setSender s c =-  alloca $ \p -> poke p c >> Area.with_port_subscribe s (`snd_seq_port_subscribe_set_sender` p)--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_set_sender"-  snd_seq_port_subscribe_set_sender :: Ptr T_ -> Ptr Addr.T -> IO ()---- | Set destination address of a port subscription-setDest :: T -> Addr.T -> IO ()-setDest s c =-  alloca $ \p -> poke p c >> Area.with_port_subscribe s (`snd_seq_port_subscribe_set_dest` p)--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_set_dest"-  snd_seq_port_subscribe_set_dest :: Ptr T_ -> Ptr Addr.T -> IO ()---- | Subscribe a port connection-subscribePort :: Seq.T mode -> T -> IO ()-subscribePort (Seq.Cons h) s =-  Exc.checkResult_ "subscribe_port" =<< Area.with_port_subscribe s (snd_seq_subscribe_port h)--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_subscribe_port"-  snd_seq_subscribe_port :: Ptr Seq.Core -> Ptr T_ -> IO CInt---- | Unsubscribe a connection between ports-unsubscribePort :: Seq.T mode -> T -> IO ()-unsubscribePort (Seq.Cons h) s =-  Exc.checkResult_ "unsubscribe_port" =<< Area.with_port_subscribe s (snd_seq_unsubscribe_port h)--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_unsubscribe_port"-  snd_seq_unsubscribe_port :: Ptr Seq.Core -> Ptr T_ -> IO CInt--create :: Addr.T -> Addr.T -> Bool -> Maybe (Queue.T, Bool) -> IO T-create sender dest excl time = do-  s <- alloc-  setSender s sender-  setDest s dest-  setExclusive s excl-  maybe (return ()) (\(queue, realtime) -> do-    setTimeUpdate s True-    setQueue s queue-    setTimeReal s realtime) time-  return s---- | Subscribe a port connection: @'subscribeSimple' sender dest exclusive (Just (updatequeue, realtime))@-subscribe :: Seq.T mode -> Addr.T -> Addr.T -> Bool -> Maybe (Queue.T, Bool) -> IO ()-subscribe ss sender dest excl time = subscribePort ss =<< create sender dest excl time---- | Unsubscribe a port connection: @'unsubscribeSimple' sender dest@-unsubscribe :: Seq.T mode -> Addr.T -> Addr.T -> IO ()-unsubscribe ss sender dest = unsubscribePort ss =<< create sender dest False Nothing

@@ -0,0 +1,115 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Sound.ALSA.Sequencer.Subscribe+-- Copyright : (c) Henning Thielemann, 2012+--             (c) Dylan Simon, 2011+-- License   : BSD3+--+-- Stability : provisional+--+-- This module contains functions for working with subscriptions.+-- Reference:+-- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_subscribe.html>+--------------------------------------------------------------------------------++module Sound.ALSA.Sequencer.Subscribe+  ( T++  , malloc+  , copy+  , clone++  , getSender+  , getDest+  , getQueue+  , getExclusive+  , getTimeUpdate+  , getTimeReal++  , setSender+  , setDest+  , setQueue+  , setExclusive+  , setTimeUpdate+  , setTimeReal++  , subscribePort+  , unsubscribePort++  , create+  , subscribe+  , unsubscribe+  ) where++#include <Sound/ALSA/Sequencer/Area.h>++import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr+import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue+import qualified Sound.ALSA.Sequencer.Area as Area+import qualified Sound.ALSA.Exception as Exc++import Data.Foldable (forM_, )++import qualified Foreign.C.Types as C+import Foreign.Ptr (Ptr, )+++#area "port_subscribe"++#{get_set_int "queue", "Queue",+           "Queue.T", "Queue.imp", "Queue.exp"}+#get_set_bool "exclusive", "Exclusive"+#get_set_bool "time_update", "TimeUpdate"+#get_set_bool "time_real", "TimeReal"+++-- | Get sender address of a port subscription+#{get_ptr "sender", "Sender", "Addr.T"}++-- | Get destination address of a port subscription+#{get_ptr "dest", "Dest", "Addr.T"}++-- | Set sender address of a port subscription+#{set_ptr "sender", "Sender", "Addr.T"}++-- | Set destination address of a port subscription+#{set_ptr "dest", "Dest", "Addr.T"}++-- | Subscribe a port connection+subscribePort :: Seq.T mode -> T -> IO ()+subscribePort (Seq.Cons h) s =+  Exc.checkResult_ "subscribePort" =<< with s (subscribePort_ h)++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_subscribe_port"+  subscribePort_ :: Ptr Seq.Core -> Ptr T_ -> IO C.CInt++-- | Unsubscribe a connection between ports+unsubscribePort :: Seq.T mode -> T -> IO ()+unsubscribePort (Seq.Cons h) s =+  Exc.checkResult_ "unsubscribePort" =<< with s (unsubscribePort_ h)++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_unsubscribe_port"+  unsubscribePort_ :: Ptr Seq.Core -> Ptr T_ -> IO C.CInt++create :: Addr.T -> Addr.T -> Bool -> Maybe (Queue.T, Bool) -> IO T+create sender dest excl time = do+  s <- malloc+  setSender s sender+  setDest s dest+  setExclusive s excl+  forM_ time $ \(queue, realtime) -> do+    setTimeUpdate s True+    setQueue s queue+    setTimeReal s realtime+  return s++-- | Subscribe a port connection: @'subscribeSimple' sender dest exclusive (Just (updatequeue, realtime))@+subscribe :: Seq.T mode -> Addr.T -> Addr.T -> Bool -> Maybe (Queue.T, Bool) -> IO ()+subscribe ss sender dest excl time =+  subscribePort ss =<< create sender dest excl time++-- | Unsubscribe a port connection: @'unsubscribeSimple' sender dest@+unsubscribe :: Seq.T mode -> Addr.T -> Addr.T -> IO ()+unsubscribe ss sender dest =+  unsubscribePort ss =<< create sender dest False Nothing

@@ -1,150 +0,0 @@------------------------------------------------------------------------------------ |--- Module    : Sound.ALSA.Sequencer.Subscribe.Query--- Copyright : (c) Dylan Simon, 2011--- License   : BSD3------ Stability : provisional------ This module contains functions for working with subscriptions.--- Reference:--- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_subscribe.html>-----------------------------------------------------------------------------------module Sound.ALSA.Sequencer.Subscribe.Query-  ( T-  , Query.Type(..)--  {--  , alloc-  , copy-  , clone-  -}--  , getClient-  , getPort-  , getRoot-  , getType-  , getIndex-  , getNumSubs-  , getAddr-  , getQueue-  , getExclusive-  , getTimeUpdate-  , getTimeReal--  {--  , setClient-  , setPort-  , setType-  , setIndex-  -}--  , query-  , queryAll-  ) where--import qualified Sound.ALSA.Sequencer.Marshal.QuerySubscribe as Query-import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq-import qualified Sound.ALSA.Sequencer.Area as Area-import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr-import qualified Sound.ALSA.Sequencer.Marshal.Client as Client-import qualified Sound.ALSA.Sequencer.Marshal.Port as Port-import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue-import qualified Sound.ALSA.Exception as Exc--import Foreign.C.Error (Errno(Errno), eNOENT, )-import Foreign.C.Types (CInt, )-import Foreign.Ptr (Ptr, )-import Foreign.Marshal.Alloc (alloca, )-import Foreign.Storable (peek, poke, )-import Data.Word (Word, )--type T = Area.QuerySubscribe-type T_ = Area.QuerySubscribe_--alloc	      :: IO T-_copy	      :: T -> T -> IO ()-_clone	      :: T -> IO T-getClient     :: T -> IO Client.T-getPort	      :: T -> IO Port.T-getType	      :: T -> IO Query.Type-getIndex      :: T -> IO Word-getNumSubs    :: T -> IO Word-getQueue      :: T -> IO Queue.T-getExclusive  :: T -> IO Bool-getTimeUpdate :: T -> IO Bool-getTimeReal   :: T -> IO Bool-_setClient    :: T -> Client.T -> IO ()-_setPort      :: T -> Port.T -> IO ()-setType	      :: T -> Query.Type -> IO ()-setIndex      :: T -> Word -> IO ()--alloc	      = Area.query_subscribe_malloc-_copy	      = Area.query_subscribe_copy-_clone	      = Area.query_subscribe_clone-getClient     = Area.query_subscribe_get_client-getPort	      = Area.query_subscribe_get_port-getType	      = Area.query_subscribe_get_type-getIndex      = Area.query_subscribe_get_index-getNumSubs    = Area.query_subscribe_get_num_subs-getQueue      = Area.query_subscribe_get_queue-getExclusive  = Area.query_subscribe_get_exclusive-getTimeUpdate = Area.query_subscribe_get_time_update-getTimeReal   = Area.query_subscribe_get_time_real-_setClient    = Area.query_subscribe_set_client-_setPort      = Area.query_subscribe_set_port-setType       = Area.query_subscribe_set_type-setIndex      = Area.query_subscribe_set_index---- | Get the client/port address of a query-getRoot :: T -> IO Addr.T-getRoot q = -  peek =<< Area.with_query_subscribe q snd_seq_query_subscribe_get_root--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_get_root"-  snd_seq_query_subscribe_get_root :: Ptr T_ -> IO (Ptr Addr.T)---- | Get the address of subscriber of query-getAddr :: T -> IO Addr.T-getAddr q = -  peek =<< Area.with_query_subscribe q snd_seq_query_subscribe_get_addr--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_get_addr"-  snd_seq_query_subscribe_get_addr :: Ptr T_ -> IO (Ptr Addr.T)----- | Set the client/port address of a query-setRoot :: T -> Addr.T -> IO ()-setRoot q c = -  alloca $ \p -> poke p c >> Area.with_query_subscribe q (`snd_seq_query_subscribe_set_root` p)--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_set_root"-  snd_seq_query_subscribe_set_root :: Ptr T_ -> Ptr Addr.T -> IO ()----- | Query port subscriber list-queryPort :: Seq.T mode -> T -> IO Bool-queryPort (Seq.Cons h) q =-  Exc.checkResultMaybe "query_port_subscribers" (const True) (\e -> if Errno (negate e) == eNOENT then Just False else Nothing) =<<-    Area.with_query_subscribe q (snd_seq_query_port_subscribers h)--foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_port_subscribers"-  snd_seq_query_port_subscribers :: Ptr Seq.Core -> Ptr T_ -> IO CInt---- | Queries a subscriber connected to (Write) or from (Read) a given address: @'query' seq addr typ index@-query :: Seq.T mode -> Addr.T -> Query.Type -> Word -> IO (Maybe T)-query ss root t i = do-  q <- alloc-  setRoot q root-  setType q t-  setIndex q i-  r <- queryPort ss q-  return $ if r then Just q else Nothing---- | Queries the list of subscribers accessing a port-queryAll :: Seq.T mode -> Addr.T -> Query.Type -> IO [T]-queryAll ss root t = queryRest 0 where-  queryRest i = query ss root t i >>=-    maybe (return []) (\q -> (q:) `fmap` queryRest (succ i))-

@@ -0,0 +1,128 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Sound.ALSA.Sequencer.Subscribe.Query+-- Copyright : (c) Henning Thielemann, 2012+--             (c) Dylan Simon, 2011+-- License   : BSD3+--+-- Stability : provisional+--+-- This module contains functions for working with subscriptions.+-- Reference:+-- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_subscribe.html>+--------------------------------------------------------------------------------++module Sound.ALSA.Sequencer.Subscribe.Query+  ( T+  , Type(..)++  , malloc+  , copy+  , clone++  , getClient+  , getPort+  , getRoot+  , getType+  , getIndex+  , getNumSubs+  , getAddr+  , getQueue+  , getExclusive+  , getTimeUpdate+  , getTimeReal++  , setClient+  , setPort+  , setType+  , setIndex++  , query+  , queryAll+  ) where++#include <alsa/asoundlib.h>+#include <Sound/ALSA/Sequencer/Area.h>++import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr+import qualified Sound.ALSA.Sequencer.Marshal.Client as Client+import qualified Sound.ALSA.Sequencer.Marshal.Port as Port+import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue+import qualified Sound.ALSA.Sequencer.Area as Area+import qualified Sound.ALSA.Sequencer.Utility as U+import qualified Sound.ALSA.Exception as Exc++import qualified Foreign.C.Types as C+import Foreign.Ptr (Ptr, )+import Data.Word (Word, )+import Data.Maybe.HT (toMaybe, )+++#area "query_subscribe"++#{get_set_int "client", "Client",+          "Client.T", "Client.imp", "Client.exp"}+#{get_set_int "port", "Port",+          "Port.T", "Port.imp", "Port.exp"}+#{get_set_int "type", "Type",+          "Type", "impType", "expType"}+#{get_set_int "index", "Index",+          "Word", "fromIntegral", "fromIntegral"}++-- RO+#{get_int "num_subs", "NumSubs", "Word", "fromIntegral"}+#{get_int "queue", "Queue", "Queue.T", "Queue.imp"}+#get_bool "exclusive", "Exclusive"+#get_bool "time_update", "TimeUpdate"+#get_bool "time_real", "TimeReal"+++-- | Get the client/port address of a query+#{get_ptr "root", "Root", "Addr.T"}+-- | Set the client/port address of a query+#{set_ptr "root", "Root", "Addr.T"}+-- | Get the address of subscriber of query+#{get_ptr "addr", "Addr", "Addr.T"}+++-- | Query port subscriber list+queryPort :: Seq.T mode -> T -> IO Bool+queryPort (Seq.Cons h) q =+  U.checkResultQuery "Subscribe.queryPort" =<< with q (queryPort_ h)++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_port_subscribers"+  queryPort_ :: Ptr Seq.Core -> Ptr T_ -> IO C.CInt++-- | Queries a subscriber connected to (Write) or from (Read) a given address: @'query' seq addr typ index@+query :: Seq.T mode -> Addr.T -> Type -> Word -> IO (Maybe T)+query ss root t i = do+  q <- malloc+  setRoot q root+  setType q t+  setIndex q i+  r <- queryPort ss q+  return $ toMaybe r q++-- | Queries the list of subscribers accessing a port+queryAll :: Seq.T mode -> Addr.T -> Type -> IO [T]+queryAll ss root t = queryRest 0 where+  queryRest i = query ss root t i >>=+    maybe (return []) (\q -> (q:) `fmap` queryRest (succ i))+++data Type =+     Read+   | Write+   deriving (Show, Eq, Ord, Enum)++expType :: Type -> C.CInt+expType t  = case t of+  Read  -> #{const SND_SEQ_QUERY_SUBS_READ}+  Write	-> #{const SND_SEQ_QUERY_SUBS_WRITE}++impType :: C.CInt -> Type+impType t  = case t of+  #{const SND_SEQ_QUERY_SUBS_READ}  -> Read+  #{const SND_SEQ_QUERY_SUBS_WRITE} -> Write+  _ -> error ("QuerySubscribe.impType: unknown subscription type (" ++ show t ++ ")")

@@ -0,0 +1,7 @@+module Sound.ALSA.Sequencer.Time (+   T(Cons, mode, stamp), consAbs, consRel,+   Mode(Absolute, Relative), Stamp (Tick, Real),+   ) where++import Sound.ALSA.Sequencer.Marshal.Time as Time+

@@ -1,5 +1,13 @@ module Sound.ALSA.Sequencer.Utility where +import qualified Sound.ALSA.Exception as Exc++import qualified Foreign.C.Types as C+import Foreign.C.Error (Errno(Errno), eNOENT, )++import Data.Maybe.HT (toMaybe, )++ showsField :: Show a => a -> ShowS showsField = showsPrec 11 @@ -8,3 +16,10 @@    showParen (prec >= 10) $    showString name . showString ".Cons" .    foldr (.) id (map (\f -> showChar ' ' . f) fields)++-- might be moved to Sound.ALSA.Exception+checkResultQuery :: String -> C.CInt -> IO Bool+checkResultQuery name =+   Exc.checkResultMaybe name+      (const True)+      (\e -> toMaybe (Errno (negate e) == eNOENT) False)