diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -65,7 +65,7 @@ # exclude installed versions of Haskore, because we want to use the local one HUGS_PACKAGE_PATH = \ - {Hugs}/libraries:{Hugs}/libraries:{Hugs}/packages/*:$(subst $(space),$(colon),$(patsubst %,/usr/local/lib/hugs/packages/%,event-list midi markov-chain non-negative special-functors data-accessor)) + {Hugs}/libraries:{Hugs}/packages/*:$(subst $(space),$(colon),$(patsubst %,/usr/local/lib/hugs/packages/%,event-list midi markov-chain non-negative special-functors data-accessor transformers explicit-exception binary)) # $(subst $(space),$(colon),$(patsubst %,{Hugs}/packages/%,event-list midi markov-chain non-negative record-access)) @@ -228,14 +228,29 @@ fluid: fluidsynth --verbose /usr/share/sounds/sf2/Vintage_Dreams_Waves_v2.sf2 +jack: + jackd -d alsa -r 44100 -n 3 -d hw:0 & + # better start jack separately and then run 'make fluidjack' # because otherwise fluidsynth starts jack itself but with inappropriate settings + +# There is a difference to fluidsynth of Suse 9.2: +# If you simply start fluidsynth, it will report incoming MIDI messages, +# but you do not hear anything. +# It seems that you must connect fluidsynth to JACK manually. +# You can list the available JACK ports with +# jack_lsp +# Cf. http://ubuntuforums.org/archive/index.php/t-480233.html fluidjack: + (usleep 3000000; make fluidconnect) & fluidsynth -a jack --verbose /usr/share/sounds/sf2/Vintage_Dreams_Waves_v2.sf2 +fluidconnect: + jack_connect fluidsynth:left alsa_pcm:playback_1 + jack_connect fluidsynth:tight alsa_pcm:playback_2 + timidity: timidity -iA -B1,8 - debug: echo $(GHC_DEPENDS) diff --git a/haskore.cabal b/haskore.cabal --- a/haskore.cabal +++ b/haskore.cabal @@ -1,19 +1,18 @@ Name: haskore -Version: 0.0.5.1 +Version: 0.0.6 License: GPL License-File: LICENSE Author: Paul Hudak , Henning Thielemann Maintainer: Henning Thielemann Homepage: http://www.haskell.org/haskellwiki/Haskore -Package-URL: http://darcs.haskell.org/haskore/ Category: Sound, Music Synopsis: The Haskore Computer Music System Stability: Experimental Description: Compose music using programming features. Output in MIDI, CSound, SuperCollider or as an audio signal. -Tested-With: GHC==6.4.1, GHC==6.8.2, Hugs==2005.3.8 -Cabal-Version: >=1.2 +Tested-With: GHC==6.4.1, GHC==6.8.2, Hugs==2006.9 +Cabal-Version: >=1.6 Build-Type: Simple Extra-Source-Files: @@ -25,6 +24,15 @@ src/Doc/Introduction.tex src/Doc/Tutorial.tex +Source-Repository head + type: darcs + location: http://darcs.haskell.org/haskore/ + +Source-Repository this + type: darcs + location: http://darcs.haskell.org/haskore/ + tag: 0.0.6 + Flag splitBase description: Choose the new smaller, split-up base package. @@ -34,12 +42,12 @@ Library Build-Depends: - event-list >=0.0.5 && <0.1, + event-list >=0.0.8 && <0.1, midi >=0.1.1 && <0.2, markov-chain >=0.0.1 && <0.1, non-negative >=0.0.1 && <0.1, data-accessor >=0.1 && <0.2, - mtl >=1.1 && <1.2, + transformers >=0.0.1 && <0.2, haskell-src >=1.0 && <1.1, parsec >=2.1 && <2.2, -- for testing @@ -49,10 +57,10 @@ If flag(splitBase) Build-Depends: base >=3, - array >=0.1 && <0.2, - random >=1.0 && <1.1, + array >=0.1 && <1.0, + random >=1.0 && <2.0, process >=1.0 && <1.1, - containers >=0.1 && <0.2 + containers >=0.1 && <1.0 Else Build-Depends: base >= 1.0 && < 2, @@ -81,6 +89,7 @@ Haskore.Example.Flip, Haskore.Example.Fractal, Haskore.Example.Guitar, + Haskore.Example.HeilandHimmel, Haskore.Example.Kantate147, Haskore.Example.Miscellaneous, Haskore.Example.NewResolutions, diff --git a/src/Haskore/Example/Detail.hs b/src/Haskore/Example/Detail.hs --- a/src/Haskore/Example/Detail.hs +++ b/src/Haskore/Example/Detail.hs @@ -12,7 +12,7 @@ import qualified System.Random as Random import System.Random (RandomGen, randomR, mkStdGen, ) -import Control.Monad.State (State(State), evalState, ) +import Control.Monad.Trans.State (State, state, evalState, ) import Haskore.General.Utility (toMaybe, ) import qualified Data.List as List @@ -41,7 +41,7 @@ 'System.Random.randomR' wrapped in a State monad. -} randomRState :: (RandomGen g) => (Int,Int) -> State g Int -randomRState bnds = State (randomR bnds) +randomRState bnds = state (randomR bnds) merge :: [a] -> [a] -> [a] diff --git a/src/Haskore/Example/Flip.hs b/src/Haskore/Example/Flip.hs --- a/src/Haskore/Example/Flip.hs +++ b/src/Haskore/Example/Flip.hs @@ -14,17 +14,17 @@ flipSeq :: Int -> [Int] flipSeq n = let incList m = map (\x -> mod (x+m) n) - recurse y = let z = concatMap (flip incList y) [1..(n-1)] - in z ++ recurse (y++z) - in [0] ++ recurse [0] + recourse y = let z = concatMap (flip incList y) [1..(n-1)] + in z ++ recourse (y++z) + in [0] ++ recourse [0] {- based on Helmut Podhaisky's implementation it must be flipSeq2 == flipSeq 2 -} flipSeq2 :: [Int] flipSeq2 = - let recurse y = let z = map (1-) y - in z ++ recurse (y++z) - in [0] ++ recurse [0] + let recourse y = let z = map (1-) y + in z ++ recourse (y++z) + in [0] ++ recourse [0] noteArray :: [() -> Melody.T ()] -> Array Int (Melody.T ()) diff --git a/src/Haskore/Example/HeilandHimmel.hs b/src/Haskore/Example/HeilandHimmel.hs new file mode 100644 --- /dev/null +++ b/src/Haskore/Example/HeilandHimmel.hs @@ -0,0 +1,87 @@ +{- | +Christman song "O Heiland, reiß die Himmel auf" +from "Du wurdest meine Sonne - Heft I: +Advents- und Weihnachtslieder in einfachen Sätzen" +Evangelische Verlagsanstalt Berlin + +fileFromGeneralMIDIMusic "heiland.mid" song +-} +module Haskore.Example.HeilandHimmel where + +import Haskore.Melody.Standard as Melody +import Haskore.Music.GeneralMIDI as MidiMusic +import qualified Haskore.Music as Music + + +noAttr :: [Melody.NoteAttributes -> Melody.T] -> Melody.T +noAttr = line . map ($ na) + +melody0, melody1, melody2, melody3, + bass0, bass1, bass2, bass3 :: Melody.T +melody0 = + d 0 qn na +:+ + (d 0 hn na =:= f 0 hn na) +:+ + (e 0 qn na =:= g 0 qn na) +:+ + ((f 0 qn na +:+ e 0 qn na) =:= a 0 hn na) +:+ + d 0 qn na +:+ + (d 0 hn na +:+ cs 0 qn na =:= f 0 qn na +:+ e 0 hn na) +:+ + d 0 dhn na + +bass0 = noAttr $ + [d 1 qn, d 1 qn, c 1 qn, bf 0 qn, + a 0 hn, bf 0 qn, bf 0 qn, g 0 qn, a 0 qn, + d 0 qn, a 0 qn, d 1 qn] + +melody1 = + (f 0 qn na =:= a 0 qn na) +:+ + (e 0 qn na =:= a 0 qn na) +:+ + (d 0 qn na =:= b 0 qn na) +:+ + ((c 0 qn na +:+ d 0 qn na) =:= c 1 hn na) +:+ + f 0 qn na +:+ + (f 0 hn na +:+ e 0 qn na =:= a 0 qn na +:+ g 0 hn na) +:+ + f 0 dhn na + +bass1 = noAttr $ + [d 1 qn, c 1 qn, b 0 qn, + a 0 hn, d 1 qn, d 1 qn, bf 0 qn, c 1 qn, + f 0 qn, c 1 qn, f 1 qn] + +melody2 = + (g 0 hn na =:= c 1 qn na +:+ c 1 qn na) +:+ + (f 0 qn na =:= c 1 qn na) +:+ + (e 0 qn na +:+ g 0 qn na =:= c 1 hn na) +:+ + a 0 qn na +:+ + (a 0 qn na +:+ g 0 qn na =:= d 1 hn na) +:+ + (f 0 qn na =:= d 1 qn na) +:+ + (f 0 qn na +:+ d 0 qn na +:+ e 0 qn na =:= c 1 qn na) + +bass2 = noAttr $ + [f 1 qn, e 1 qn, d 1 qn, c 1 qn, e 1 qn, f 1 qn, + bf 0 dhn, c 1 qn, g 0 qn, c 0 qn] + +melody3 = + (f 0 qn na =:= a 0 qn na) +:+ + (e 0 qn na =:= a 0 qn na) +:+ + (d 0 qn na =:= g 0 qn na) +:+ + (d 0 qn na +:+ cs 0 qn na =:= a 0 hn na) +:+ + (d 0 qn na =:= f 0 qn na) +:+ + (d 0 hn na +:+ cs 0 qn na =:= g 0 qn na +:+ e 0 hn na) +:+ + d 0 qn na + +bass3 = noAttr $ + [d 0 hn, e 0 qn, a 0 hn, bf 0 qn, + bf 0 qn, g 0 qn, a 0 qn, d 0 hn] + + +melody :: Melody.T +melody = melody0 +:+ melody1 +:+ melody2 +:+ melody3 + +bass :: Melody.T +bass = bass0 +:+ bass1 +:+ bass2 +:+ bass3 + +song :: MidiMusic.T +song = + changeTempo 1.5 $ + MidiMusic.fromStdMelody MidiMusic.PercussiveOrgan (transpose ( 12) melody) + =:= + MidiMusic.fromStdMelody MidiMusic.StringEnsemble1 (transpose (-12) bass) diff --git a/src/Haskore/Example/Kantate147.hs b/src/Haskore/Example/Kantate147.hs --- a/src/Haskore/Example/Kantate147.hs +++ b/src/Haskore/Example/Kantate147.hs @@ -28,8 +28,8 @@ import qualified Data.List as List -import Control.Monad.State -import System.Random (mkStdGen, split) +import Control.Monad.Trans.State (state, evalState, ) +import System.Random (mkStdGen, split, ) initOctaves :: [Pitch.Octave] @@ -139,7 +139,7 @@ markovChain :: Melody.T () markovChain = let tracks = map concat musicTracks - gs = evalState (sequence (repeat (State split))) (mkStdGen 147) + gs = evalState (sequence (repeat (state split))) (mkStdGen 147) chains = zipWith (\track g -> line (MarkovChain.run 3 track 0 g)) tracks gs in chains !! 2 =:= chains !! 3 diff --git a/src/Haskore/General/GraphRecursiveGen.lhs b/src/Haskore/General/GraphRecursiveGen.lhs --- a/src/Haskore/General/GraphRecursiveGen.lhs +++ b/src/Haskore/General/GraphRecursiveGen.lhs @@ -5,7 +5,8 @@ > import Data.Traversable(Traversable) > import qualified Data.Traversable as Traversable -> import Control.Monad.RWS (RWS, evalRWS, liftM, put, get, tell) +> import Control.Monad.Trans.RWS (RWS, evalRWS, put, get, tell, ) +> import Control.Monad (liftM, ) This is a generalization of \module{Haskore.General.LoopTreeTaggedGen}. It adds a constructor for sharing interim results. @@ -20,8 +21,8 @@ > type Fix a = a -> a > type Tag = Int -> recurse :: Fix (T coll) -> T coll -> recurse = Recurse +> recourse :: Fix (T coll) -> T coll +> recourse = Recurse > share :: (T coll) -> (T coll -> T coll) -> T coll > share = Share @@ -34,11 +35,11 @@ with recursion, but without sharing: - h (recurse (f . g)) (recurse (g . f)) + h (recourse (f . g)) (recourse (g . f)) with recursion of tuples: - uncurry h $ recurse (\(x,y) -> (f y, g x)) + uncurry h $ recourse (\(x,y) -> (f y, g x)) with recursion and sharing: diff --git a/src/Haskore/General/IdGenerator.lhs b/src/Haskore/General/IdGenerator.lhs --- a/src/Haskore/General/IdGenerator.lhs +++ b/src/Haskore/General/IdGenerator.lhs @@ -9,7 +9,8 @@ > import Data.Set (Set) > import qualified Data.Set as Set -> import Control.Monad.State(State(State),evalState,modify,get,when) +> import Control.Monad.Trans.State(State, state, evalState, modify, get, ) +> import Control.Monad (when, ) > import Haskore.General.Utility(mapFst) \end{haskelllisting} @@ -38,7 +39,7 @@ > alloc :: (Ord i, Enum i) => T i i > alloc = -> State $ \(set, next) -> +> state $ \(set, next) -> > if Set.null set > then (next, (set, succ next)) > else let (newId, newSet) = Set.deleteFindMin set diff --git a/src/Haskore/General/LoopTreeRecursive.lhs b/src/Haskore/General/LoopTreeRecursive.lhs --- a/src/Haskore/General/LoopTreeRecursive.lhs +++ b/src/Haskore/General/LoopTreeRecursive.lhs @@ -3,7 +3,8 @@ > import qualified Haskore.General.LoopTreeTagged as LTT > import qualified Haskore.General.TagDictionary as Dict -> import Control.Monad.State(MonadState, evalState, mapM, liftM, put, get) +> import Control.Monad.Trans.State(StateT, evalState, put, get, ) +> import Control.Monad (liftM, mapM, ) Loop now needs an ID because there may be more than one of them. @@ -68,7 +69,7 @@ > toTaggedUnique :: Tag -> T a -> LTT.T Tag a > toTaggedUnique n branch = evalState (toTaggedState branch) n -> toTaggedState :: (Enum tag, MonadState tag m) => T a -> m (LTT.T tag a) +> toTaggedState :: (Enum tag, Monad m) => T a -> StateT tag m (LTT.T tag a) > toTaggedState branch = > case branch of > Branch x s -> liftM (LTT.Branch x) (mapM toTaggedState s) diff --git a/src/Haskore/General/LoopTreeRecursiveGen.lhs b/src/Haskore/General/LoopTreeRecursiveGen.lhs --- a/src/Haskore/General/LoopTreeRecursiveGen.lhs +++ b/src/Haskore/General/LoopTreeRecursiveGen.lhs @@ -6,7 +6,8 @@ > import Data.Traversable(Traversable) > import qualified Data.Traversable as Traversable -> import Control.Monad.State(MonadState, evalState, liftM, put, get) +> import Control.Monad.Trans.State(StateT, evalState, put, get) +> import Control.Monad (liftM, ) The Loop constructor should not be used by users. It is only necessary for interim results of 'toTagged'. @@ -24,8 +25,8 @@ > type Fix a = a -> a > type Tag = Int -> recurse :: Fix (T coll) -> T coll -> recurse = Recurse +> recourse :: Fix (T coll) -> T coll +> recourse = Recurse > toTagged :: (Functor coll) => Tag -> T coll -> LTTG.T Tag coll > toTagged n branch = @@ -37,8 +38,8 @@ > toTaggedUnique :: (Traversable coll) => Tag -> T coll -> LTTG.T Tag coll > toTaggedUnique n branch = evalState (toTaggedState branch) n -> toTaggedState :: (Traversable coll, Enum tag, MonadState tag m) => -> T coll -> m (LTTG.T tag coll) +> toTaggedState :: (Traversable coll, Enum tag, Monad m) => +> T coll -> StateT tag m (LTTG.T tag coll) > toTaggedState branch = > case branch of > Branch x -> liftM LTTG.Branch (Traversable.mapM toTaggedState x) diff --git a/src/Haskore/General/Utility.lhs b/src/Haskore/General/Utility.lhs --- a/src/Haskore/General/Utility.lhs +++ b/src/Haskore/General/Utility.lhs @@ -18,7 +18,7 @@ > toMaybe, partitionMaybe > ) where > -> import Control.Monad.State (State(State), runState) +> import Control.Monad.Trans.State (State, state, runState) > import System.Random(RandomGen, randomR, randomRs, mkStdGen) > import Data.List (group, find, foldl', maximumBy, minimumBy) > import Data.Ratio((%), denominator, numerator, Ratio) @@ -54,18 +54,18 @@ > mergeBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] > mergeBy p = -> let recurse xl@(x:xs) yl@(y:ys) = -> if p x y then x : recurse xs yl -> else y : recurse xl ys -> recurse [] yl = yl -> recurse xl [] = xl -> in recurse +> let recourse xl@(x:xs) yl@(y:ys) = +> if p x y then x : recourse xs yl +> else y : recourse xl ys +> recourse [] yl = yl +> recourse xl [] = xl +> in recourse \end{haskelllisting} \code{List.partition} of GHC 6.2.1 fails on infinite lists. But this one does not. -The strict evaluation of the argument \code{(y,z)} is necessary +The lazy pattern match on \code{(y,z)} is necessary since otherwise it fails on infinite lists. \begin{haskelllisting} @@ -128,7 +128,7 @@ Randomly permutate a list. For this purpose we generate a random \type{Bool} value for each item of the list -which specifies in what sun-list it is inserted. +which specifies in what sublist it is inserted. Both sublists are then concatenated hereafter. By repeating this procedure several times the list should be somehow randomly ordered. @@ -140,7 +140,7 @@ > shuffle :: RandomGen g => [a] -> g -> ([a],g) > shuffle x g0 = -> let (choices,g1) = runState (mapM (const (State (randomR (False,True)))) x) g0 +> let (choices,g1) = runState (mapM (const (state (randomR (False,True)))) x) g0 > xc = zip x choices > in (map fst (uncurry (++) (partition snd xc)), g1) @@ -174,7 +174,7 @@ > in (n, x - fromIntegral n) > roundDiff :: (RealFrac t, Integral i) => t -> State t i -> roundDiff = State . roundDiff' +> roundDiff = state . roundDiff' \end{haskelllisting} diff --git a/src/Haskore/Interface/CSound/Orchestra.lhs b/src/Haskore/Interface/CSound/Orchestra.lhs --- a/src/Haskore/Interface/CSound/Orchestra.lhs +++ b/src/Haskore/Interface/CSound/Orchestra.lhs @@ -49,7 +49,7 @@ > > import Haskore.General.Utility (flattenTuples2, partition, mapSnd, toMaybe) -> import Control.Monad.State (State(..), modify, execState, ) +> import Control.Monad.Trans.State (State, state, modify, execState, ) > import Control.Applicative (liftA, liftA2, liftA3, pure) > import Data.Foldable (Foldable(foldMap)) > import Data.Traversable (Traversable(sequenceA)) @@ -929,7 +929,7 @@ \begin{haskelllisting} > rec :: (SigExp -> SigExp) -> SigExp -> rec = TreeRec.recurse +> rec = TreeRec.recourse \end{haskelllisting} @@ -1602,7 +1602,7 @@ > mkSignal :: Output a => EvalRate -> (SigExp -> SigExp -> SigExp) > -> Orc a GlobalSig -> mkSignal rate func = State (mkSignalPlain rate func) +> mkSignal rate func = state (mkSignalPlain rate func) > addInstrPlain :: Output a => InstrBlock a -> OrcState a -> OrcState a > addInstrPlain ib (OrcState ibs gCount) = diff --git a/src/Haskore/Interface/MED/Text.hs b/src/Haskore/Interface/MED/Text.hs --- a/src/Haskore/Interface/MED/Text.hs +++ b/src/Haskore/Interface/MED/Text.hs @@ -23,7 +23,7 @@ import Data.Char (ord) import Data.Maybe (isJust) import qualified Data.List as List -import Control.Monad.State +import Control.Monad (liftM2, ) {- | should be moved to Utility -} diff --git a/src/Haskore/Interface/MIDI/Read.lhs b/src/Haskore/Interface/MIDI/Read.lhs --- a/src/Haskore/Interface/MIDI/Read.lhs +++ b/src/Haskore/Interface/MIDI/Read.lhs @@ -314,14 +314,13 @@ > updateCPM _ = error "TimeList.collectCoincident is buggy" > -} > updateCPM = -> maybe +> TimeList.switchL > (error "TimeList.collectCoincident is buggy") -> (\ ((_, Event ev), _) -> +> (\ (_, Event ev) _ -> > maybe > (error "after segmentation, each part should start with ProgramChange event") > (uncurry progChange) > (getPC ev)) -> . TimeList.viewL > cpms = > scanl (flip id) cpm (map updateCPM pcParts) > setProg localCPM (Note d n) = @@ -361,7 +360,7 @@ > mergeNotes :: Tempo -> Track -> RichTrack > mergeNotes stv = > TimeList.mapTimeTail -> ((\(e, rest) -> +> (TimeList.switchBodyL $ \ e rest -> > uncurry TimeList.consBody $ > let deflt = (Event e, mergeNotes stv rest) > in case e of @@ -377,7 +376,6 @@ > then error "NoteOff before NoteOn" > else deflt > _ -> deflt) -> . TimeList.viewBodyL) \end{haskelllisting} @@ -405,11 +403,11 @@ > -- ^ the needed event and the remainder of the track > > searchNoteOff int ost str chm0 = -> maybe +> TimeList.switchL > (error "ReadMidi.searchNoteOff: no corresponding NoteOff") -> (\((t1, mev1), es) -> +> (\(t1, mev1) es -> > maybe -> -- if MIDI events don't match, then recurse +> -- if MIDI events don't match, then recourse > (mapSnd (TimeList.cons t1 mev1) $ > searchNoteOff (addInterval str t1 int) ost > (case mev1 of @@ -425,7 +423,6 @@ > -- check whether NoteOn and NoteOff matches > (do chm1 <- MidiFileEvent.maybeMIDIEvent mev1 > MidiNote.fromMIDIEvents (chm0, chm1))) -> . TimeList.viewL > addInterval :: Double -> ElapsedTime -> Double -> Double > addInterval str t int = int + fromIntegral t * str diff --git a/src/Haskore/Interface/MIDI/Write.lhs b/src/Haskore/Interface/MIDI/Write.lhs --- a/src/Haskore/Interface/MIDI/Write.lhs +++ b/src/Haskore/Interface/MIDI/Write.lhs @@ -85,7 +85,8 @@ > import Haskore.General.Utility(limit) > import qualified Haskore.General.Map as Map > import Data.Maybe(mapMaybe) -> import Control.Monad.State(State(State), evalState, liftM) +> import Control.Monad.Trans.State (state, evalState, ) +> import Control.Monad (liftM, ) \end{haskelllisting} @@ -359,7 +360,7 @@ > TimeList.mapBodyM > (\(PerformanceBE.Event dur note) -> > liftM (\mn -> PerformanceBE.Event dur (note, mn)) -> (State (updateChannelMap (getChanProg note)))) +> (state (updateChannelMap (getChanProg note)))) > > rate :: (Num a) => a > rate = 2 * fromIntegral division diff --git a/src/Haskore/Interface/MML.lhs b/src/Haskore/Interface/MML.lhs --- a/src/Haskore/Interface/MML.lhs +++ b/src/Haskore/Interface/MML.lhs @@ -10,7 +10,7 @@ > import Haskore.Basic.Duration((%+)) > import qualified Data.List as List -> import Control.Monad.State +> import Control.Monad.Trans.State (State, state, evalState, ) \end{haskelllisting} @@ -74,7 +74,7 @@ > _ -> error ("unexpected character '"++[c]++"' in Haskore.Interface.MML description") > toMusicState :: String -> State Accum [Melody.T ()] -> toMusicState s = State (barToMusic s) +> toMusicState s = state (barToMusic s) > toMusic :: Pitch.Octave -> String -> Melody.T () > toMusic oct s = Music.line (evalState (toMusicState s) (0, oct)) diff --git a/src/Haskore/Performance.lhs b/src/Haskore/Performance.lhs --- a/src/Haskore/Performance.lhs +++ b/src/Haskore/Performance.lhs @@ -18,7 +18,7 @@ > import qualified Numeric.NonNegative.Class as NonNeg > import Haskore.General.Utility (mapPair, maximum0, compareRecord, compareField) -> import Control.Monad.Reader(Reader(runReader), ask, asks, local) +> import Control.Monad.Trans.Reader (Reader, runReader, ask, asks, local, ) > import Control.Applicative(WrappedMonad(WrapMonad), unwrapMonad, ) > import Data.Traversable(sequenceA) > import Data.List (foldl') diff --git a/src/Haskore/Performance/BackEnd.lhs b/src/Haskore/Performance/BackEnd.lhs --- a/src/Haskore/Performance/BackEnd.lhs +++ b/src/Haskore/Performance/BackEnd.lhs @@ -109,23 +109,22 @@ > toMusic :: T Music.Dur note -> Music.T note > toMusic = -> maybe +> TimeList.switchL > (Music.rest 0) -> (\ ((t0, Event d mn), es0) -> +> (\ (t0, Event d mn) es0 -> > let n = if d>=0 > then Music.atom d (Just mn) > else error "Performance.toMusic: note of negative duration" > rmd = -> maybe n -> (\((t1, re1), es1) -> +> TimeList.switchL n +> (\(t1, re1) es1 -> > if t1 >= d > then n +:+ toMusic (TimeList.cons (t1-d) re1 es1) > else n =:= toMusic es0) -> (TimeList.viewL es0) +> es0 > in case compare t0 0 of > EQ -> rmd > GT -> Music.rest t0 +:+ rmd > LT -> error "Performance.toMusic: events in wrong order") -> . TimeList.viewL \end{haskelllisting} diff --git a/src/Haskore/Performance/Fancy.lhs b/src/Haskore/Performance/Fancy.lhs --- a/src/Haskore/Performance/Fancy.lhs +++ b/src/Haskore/Performance/Fancy.lhs @@ -19,8 +19,8 @@ > import qualified Data.EventList.Relative.MixedTime as TimeListPad > import qualified Data.EventList.Relative.BodyTime as BodyTimeList -> import Control.Monad.State(State(State), evalState) -> import Control.Monad.Reader(local, ) +> import Control.Monad.Trans.State (state, evalState, ) +> import Control.Monad.Trans.Reader (local, ) > > import qualified Numeric.NonNegative.Class as NonNeg > import qualified Numeric.NonNegative.Wrapper as NonNegW @@ -62,8 +62,8 @@ > procPf = > flip evalState 0 . > BodyTimeList.mapM -> (\dt -> State $ \t -> (fTime t dt, t+dt)) -> (\ev -> State $ \t -> (fmap (fEvent t) ev, t)) +> (\dt -> state $ \t -> (fTime t dt, t+dt)) +> (\ev -> state $ \t -> (fmap (fEvent t) ev, t)) > in (TimeListPad.mapTimeTail procPf pf, newDur) > > fancyInterpretDynamic :: diff --git a/src/Haskore/Performance/Player.lhs b/src/Haskore/Performance/Player.lhs --- a/src/Haskore/Performance/Player.lhs +++ b/src/Haskore/Performance/Player.lhs @@ -16,7 +16,8 @@ > import Haskore.Performance (eventDur, eventDynamics, ) > import Haskore.General.Utility(mapFst) -> import Control.Monad.Reader(Reader, asks, liftM) +> import Control.Monad.Trans.Reader(Reader, asks, ) +> import Control.Monad (liftM, ) > > type T time dyn note = Pf.Player time dyn note > -- constructors can't be renamed, we might use a function instead diff --git a/src/Haskore/Process/Optimization.lhs b/src/Haskore/Process/Optimization.lhs --- a/src/Haskore/Process/Optimization.lhs +++ b/src/Haskore/Process/Optimization.lhs @@ -136,15 +136,15 @@ > (\d n -> ([], Music.atom d n)) > (\c m -> let cm = collectControl m > in (c : fst cm, snd cm)) -> ((,) [] . Music.line . map recurse) -> ((,) [] . Music.chord . map recurse) -> recurse m = +> ((,) [] . Music.line . map recourse) +> ((,) [] . Music.chord . map recourse) +> recourse m = > let cm = collectControl m > (xs, cs') = partitionMaybe extract (fst cm) > x = foldl1 merge xs > collectedCtrl = if null xs then id else control x > in collectedCtrl (foldr id (snd cm) (map Music.control cs')) -> in recurse +> in recourse > -- more intuitive implementation > mergeControl extract control merge = diff --git a/src/Medium.hs b/src/Medium.hs --- a/src/Medium.hs +++ b/src/Medium.hs @@ -18,7 +18,7 @@ serial1, parallel1 :: [medium a] -> medium a class Construct medium => C medium where - {- Do actions on each (virtual) constructor, don't recurse. -} + {- Do actions on each (virtual) constructor, don't recourse. -} switchBinary :: (a -> b) -> (medium a -> medium a -> b) -> (medium a -> medium a -> b) -> (b -> medium a -> b) @@ -41,15 +41,15 @@ {- This is even more general than mapList -} foldList :: Medium.C medium => (a->b) -> ([b]->b) -> ([b]->b) -> medium a -> b foldList f g h = - let recurse = map (foldList f g h) - in switchList f (g . recurse) (h . recurse) + let recourse = map (foldList f g h) + in switchList f (g . recourse) (h . recourse) foldBin :: Medium.C medium => (a->b) -> (b->b->b) -> (b->b->b) -> b -> medium a -> b foldBin f g h z = -- foldList f (foldr1 g) (foldr1 h) -- this implementation preserves the structure of the binary tree - let recurse op x y = foldBin f g h z x `op` foldBin f g h z y - in switchBinary f (recurse g) (recurse h) z + let recourse op x y = foldBin f g h z x `op` foldBin f g h z y + in switchBinary f (recourse g) (recourse h) z listMediumFromAny :: (Construct dst, C src, Temporal.C a) => src a -> dst a diff --git a/src/Medium/Controlled.hs b/src/Medium/Controlled.hs --- a/src/Medium/Controlled.hs +++ b/src/Medium/Controlled.hs @@ -7,7 +7,7 @@ class C medium where control :: (control -> medium control a -> medium control a) - {- Do actions on each (virtual) constructor, don't recurse. -} + {- Do actions on each (virtual) constructor, don't recourse. -} switchBinary :: (a -> b) -> (medium control a -> medium control a -> b) -> @@ -40,13 +40,13 @@ foldList :: C medium => (a->b) -> ([b]->b) -> ([b]->b) -> (c->b->b) -> medium c a -> b foldList f g h k = - let recurse = foldList f g h k - recurseAll = map recurse - in switchList f (g . recurseAll) (h . recurseAll) (\c -> k c . recurse) + let recourse = foldList f g h k + recurseAll = map recourse + in switchList f (g . recurseAll) (h . recurseAll) (\c -> k c . recourse) foldBin :: C medium => (a->b) -> (b->b->b) -> (b->b->b) -> (c->b->b) -> b -> medium c a -> b foldBin f g h k z = - let recurse = foldBin f g h k z - recurseAll op x y = recurse x `op` recurse y - in switchBinary f (recurseAll g) (recurseAll h) (\c -> k c . recurse) z + let recourse = foldBin f g h k z + recurseAll op x y = recourse x `op` recourse y + in switchBinary f (recurseAll g) (recurseAll h) (\c -> k c . recourse) z diff --git a/src/Medium/Controlled/ContextFreeGrammar.lhs b/src/Medium/Controlled/ContextFreeGrammar.lhs --- a/src/Medium/Controlled/ContextFreeGrammar.lhs +++ b/src/Medium/Controlled/ContextFreeGrammar.lhs @@ -31,7 +31,7 @@ > import Data.Maybe (fromJust) > import qualified Haskore.General.Map as Map -> import Control.Monad.State (State(State), execState) +> import Control.Monad.Trans.State (state, execState) \end{haskelllisting} @@ -51,8 +51,8 @@ > fromMedium :: (Ord key, Ord control, Ord prim) => > [key] -> Int -> CtrlMediumList.T control prim -> T key control prim > fromMedium (key:keys) thres m = -> let action = whileM (>= thres) (map (State . condense) keys) -> -- action = sequence (take 1 (map (State . condense) keys)) +> let action = whileM (>= thres) (map (state . condense) keys) +> -- action = sequence (take 1 (map (state . condense) keys)) > in reverse $ execState action [(key, fmap Prim m)] > fromMedium _ _ _ = > error ("No key given."++ @@ -65,7 +65,7 @@ if it is possible to resolve the dependencies. We manage the grammar in the dictionary \code{dict}. Now a naive way for expanding the macros -is to recurse into each macro call manually +is to recourse into each macro call manually using lookups to \code{dict}. This would imply that we need new memory for each expansion of the same macro. We have chosen a different approach: diff --git a/src/Medium/LabeledControlled/List.hs b/src/Medium/LabeledControlled/List.hs --- a/src/Medium/LabeledControlled/List.hs +++ b/src/Medium/LabeledControlled/List.hs @@ -85,9 +85,9 @@ (control -> c -> b) -> (T label control a -> c) foldList lab f g h k = - let recurse = foldList lab f g h k + let recourse = foldList lab f g h k in switchList lab f - (g . map recurse) (h . map recurse) (\c -> k c . recurse) + (g . map recourse) (h . map recourse) (\c -> k c . recourse) fromControlledMediumList :: Label label => diff --git a/src/Medium/Plain/ContextFreeGrammar.lhs b/src/Medium/Plain/ContextFreeGrammar.lhs --- a/src/Medium/Plain/ContextFreeGrammar.lhs +++ b/src/Medium/Plain/ContextFreeGrammar.lhs @@ -25,7 +25,7 @@ > import qualified Haskore.General.Map as Map > import Haskore.General.Utility (maximumKey, zapWith) -> import Control.Monad.State (MonadState, put, get, State(State), execState) +> import Control.Monad.Trans.State (StateT, put, get, state, execState) > import Medium (prim, serial1, parallel1) > import qualified Medium @@ -55,7 +55,7 @@ > fromMedium :: (Ord key, Ord prim) => > [key] -> Int -> ListMedium.T prim -> T key prim > fromMedium (key:keys) thres m = -> let action = whileM (>= thres) (map (State . condense) keys) +> let action = whileM (>= thres) (map (state . condense) keys) > -- action = sequence (take 1 (map (State . condense) keys)) > in reverse $ execState action [(key, fmap Prim m)] > fromMedium _ _ _ = @@ -69,7 +69,7 @@ if it is possible to resolve the dependencies. We manage the grammar in the dictionary \code{dict}. Now a naive way for expanding the macros -is to recurse into each macro call manually +is to recourse into each macro call manually using lookups to \code{dict}. This would imply that we need new memory for each expansion of the same macro. We have chosen a different approach: @@ -115,7 +115,7 @@ \begin{haskelllisting} -> whileM :: (MonadState s m) => (a -> Bool) -> [m a] -> m [a] +> whileM :: (Monad m) => (a -> Bool) -> [StateT s m a] -> StateT s m [a] > whileM _ [] = return [] > whileM p (m:ms) = > do s <- get @@ -168,16 +168,16 @@ > -> [b] > -> [Tag a b] > replaceInfix key infx sequ = -> let recurse [] = [] -> recurse xa@(x:xs) = +> let recourse [] = [] +> recourse xa@(x:xs) = > let pref = commonPrefix (cycle infx) xa > (num, r) = divMod (length pref) (length infx) > len = length pref - r > in if num == 0 -> then Prim x : recurse xs +> then Prim x : recourse xs > else ((if num == 1 then Call key else CallMulti num key) -> : recurse (drop len xa)) -> in recurse sequ +> : recourse (drop len xa)) +> in recourse sequ \end{haskelllisting} diff --git a/src/Test/Equivalence.lhs b/src/Test/Equivalence.lhs --- a/src/Test/Equivalence.lhs +++ b/src/Test/Equivalence.lhs @@ -178,7 +178,7 @@ > import qualified Numeric.NonNegative.Wrapper as NonNeg > import Haskore.General.Utility (mapFst) -> import Control.Monad.Reader (runReader) +> import Control.Monad.Trans.Reader (runReader) > import Test.QuickCheck diff --git a/src/Test/Suite.lhs b/src/Test/Suite.lhs --- a/src/Test/Suite.lhs +++ b/src/Test/Suite.lhs @@ -32,8 +32,8 @@ > import Data.Ratio(Ratio,(%)) > import Data.Maybe(isJust) > import System.Random(StdGen, mkStdGen, randomR) -> import Control.Monad.State (liftM, liftM2, replicateM, when) -> import Haskore.General.Monad (untilM) +> import Control.Monad (liftM, liftM2, replicateM, when) +> import Haskore.General.Monad (untilM, ) > import Haskore.General.Utility (shuffle, toMaybe, maximum0) > import Haskore.Music hiding (repeat, reverse)