diff --git a/reactive-balsa.cabal b/reactive-balsa.cabal --- a/reactive-balsa.cabal +++ b/reactive-balsa.cabal @@ -1,5 +1,5 @@ Name: reactive-balsa -Version: 0.3 +Version: 0.4 License: BSD3 License-File: LICENSE Author: Henning Thielemann @@ -45,15 +45,15 @@ Source-Repository this type: darcs location: http://hub.darcs.net/thielema/reactive-balsa/ - tag: 0.3 + tag: 0.4 Flag splitBase description: Choose the new smaller, split-up base package. Library Build-Depends: - reactive-midyim >=0.3 && <0.4, - reactive-banana >=1.1 && <1.2, + reactive-midyim >=0.4 && <0.5, + reactive-banana-bunch >=1.0 && <1.1, midi-alsa >=0.2 && <0.3, midi >=0.2 && <0.3, alsa-seq >=0.6 && <0.7, @@ -62,6 +62,7 @@ non-negative >=0.1 && <0.2, data-accessor-transformers >=0.2.1 && <0.3, data-accessor >=0.2.1 && <0.3, + non-empty >=0.2.1 && <0.4, utility-ht >=0.0.8 && <0.1, containers >=0.2 && <0.6, transformers >=0.2 && <0.6, diff --git a/src/Reactive/Banana/ALSA/Common.hs b/src/Reactive/Banana/ALSA/Common.hs --- a/src/Reactive/Banana/ALSA/Common.hs +++ b/src/Reactive/Banana/ALSA/Common.hs @@ -34,14 +34,15 @@ import Data.Accessor.Basic ((^.), (^=), ) -import Control.Functor.HT (void, ) -import Data.Maybe (maybeToList, ) -import Data.List (intercalate, ) - import qualified Control.Monad.Trans.Reader as Reader import Control.Monad.Trans.Reader (ReaderT, ) +import Control.Functor.HT (void, ) +import qualified Data.NonEmpty as NonEmpty import qualified Data.Monoid as Mn +import Data.Foldable (Foldable, foldMap, ) +import Data.Maybe (maybeToList, ) +import Data.List (intercalate, ) import Prelude hiding (init, filter, reverse, ) @@ -232,6 +233,9 @@ instance Events ev => Events [ev] where flattenEvents = concatMap flattenEvents + +instance (Foldable f, Events ev) => Events (NonEmpty.T f ev) where + flattenEvents = foldMap flattenEvents instance (Events ev0, Events ev1) => Events (ev0,ev1) where flattenEvents (ev0,ev1) = flattenEvents ev0 ++ flattenEvents ev1 diff --git a/src/Reactive/Banana/ALSA/Example.hs b/src/Reactive/Banana/ALSA/Example.hs --- a/src/Reactive/Banana/ALSA/Example.hs +++ b/src/Reactive/Banana/ALSA/Example.hs @@ -19,8 +19,8 @@ import qualified Reactive.Banana.MIDI.Utility as RBU -import qualified Reactive.Banana.Combinators as RB -import Reactive.Banana.Combinators ((<@>), ) +import qualified Reactive.Banana.Bunch.Combinators as RB +import Reactive.Banana.Bunch.Combinators ((<@>), ) import qualified Sound.MIDI.ALSA.Check as Check import qualified Sound.MIDI.ALSA.Query as Query () @@ -31,7 +31,7 @@ import qualified System.Random as Random import Control.Monad.Trans.Reader (ReaderT, ) -import Control.Monad (guard, liftM2, liftM3, join, foldM, (<=<), ) +import Control.Monad (guard, liftM2, liftM3, join, ) import Control.Applicative (pure, (<*>), (<$>), ) import Data.Tuple.HT (mapFst, ) import Data.Maybe (mapMaybe, ) @@ -93,14 +93,12 @@ latch = Seq.runM (Seq.bypassM Note.maybeBndExt (fmap fst . Process.pressed KeySet.latch)) groupLatch = Seq.runM (Seq.bypassM Note.maybeBndExt (fmap fst . Process.pressed KeySet.groupLatch)) delay = Seq.runM $ \evs -> do dt <- ticks 0.2; return $ Process.delay dt evs -delayAdd = Seq.runM $ \evs -> do dt <- ticks 0.2; Process.delayAdd dt evs +delayAdd = Seq.runM $ \evs -> do dt <- ticks 0.2; return $ Process.delayAdd dt evs delayTranspose = Seq.runM $ \evs -> do let proc p dt = do tk <- ticks dt - return $ - Process.delay tk $ - RBU.mapMaybe (stranspose p) evs - foldM Process.unionM (fmap now evs) <=< sequence $ + return $ Process.delay tk $ RBU.mapMaybe (stranspose p) evs + fmap (foldl RB.union (fmap now evs)) $ sequence $ proc 4 0.2 : proc 7 0.4 : proc 12 0.6 : @@ -191,7 +189,7 @@ -} split = Seq.run $ - uncurry (RBU.union "split") + uncurry RB.union . mapFst (RBU.mapMaybe (stranspose 12) @@ -233,7 +231,7 @@ -- Seq.cyclePrograms (map program [13..17]) times evs defer <- Time.ticksFromSeconds $ time 0.1 pgms <- Process.cycleProgramsDefer defer (map program [13..17]) times evs - Process.unionM (RB.filterJust pgms) evs + return $ RB.union (RB.filterJust pgms) evs sweep = Seq.runM $ \evs -> @@ -245,7 +243,7 @@ depth <- Process.controllerRaw c depthCC 64 evs center <- Process.controllerRaw c centerCC 64 evs speed <- Process.controllerExponential c speedCC 0.3 (0.1, 1) evs - RBU.union "sweep" + RB.union (RB.filterE (not . Common.checkController (flip elem [centerCC, depthCC, speedCC])) evs) . @@ -277,5 +275,5 @@ g -> ReaderT Seq.Handle IO () trainer g = Seq.runTimesM $ \ times evs -> - Process.unionM (fmap singletonBundle evs) =<< + RB.union (fmap singletonBundle evs) <$> Process.trainer (channel 0) (time 0.5) (time 0.3) (Training.all g) times evs diff --git a/src/Reactive/Banana/ALSA/Private.hs b/src/Reactive/Banana/ALSA/Private.hs --- a/src/Reactive/Banana/ALSA/Private.hs +++ b/src/Reactive/Banana/ALSA/Private.hs @@ -4,8 +4,8 @@ import qualified Reactive.Banana.MIDI.Process as Process import qualified Reactive.Banana.MIDI.Time as Time -import qualified Reactive.Banana.Combinators as RB -import qualified Reactive.Banana.Frameworks as RBF +import qualified Reactive.Banana.Bunch.Combinators as RB +import qualified Reactive.Banana.Bunch.Frameworks as RBF import qualified Sound.ALSA.Sequencer as SndSeq import qualified Sound.ALSA.Sequencer.Client as Client diff --git a/src/Reactive/Banana/ALSA/Sequencer.hs b/src/Reactive/Banana/ALSA/Sequencer.hs --- a/src/Reactive/Banana/ALSA/Sequencer.hs +++ b/src/Reactive/Banana/ALSA/Sequencer.hs @@ -15,9 +15,9 @@ import qualified Reactive.Banana.MIDI.Utility as RBU import Reactive.Banana.MIDI.Common (Future(Future), ) -import qualified Reactive.Banana.Combinators as RB -import qualified Reactive.Banana.Frameworks as RBF -import Reactive.Banana.Combinators ((<@>), ) +import qualified Reactive.Banana.Bunch.Combinators as RB +import qualified Reactive.Banana.Bunch.Frameworks as RBF +import Reactive.Banana.Bunch.Combinators ((<@>), ) import qualified Sound.ALSA.Sequencer.Event.RemoveMonad as Remove import qualified Sound.ALSA.Sequencer.Event as Event @@ -28,7 +28,7 @@ import qualified Control.Monad.Trans.Reader as MR import Control.Monad.Trans.Reader (ReaderT(ReaderT), ) import Control.Monad (liftM, forever, ) -import Control.Applicative (pure, (<*>), ) +import Control.Applicative ((<$>), ) import Control.Functor.HT (void, ) import Data.Monoid (mempty, ) @@ -82,7 +82,7 @@ . fmap Event.body =<< RBF.fromAddHandler addEventHandler RBF.reactimate $ - pure (outputEvents h) <*> time <@> evs) + outputEvents h <$> time <@> RB.collect evs) forever $ do ev <- Event.input (sequ h) runTimeHandler $ AlsaTime.fromEvent ev