haskore 0.0.7 → 0.1

raw patch · 30 files changed

+175/−641 lines, 30 filesdep +bytestringdep +utility-htPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, utility-ht

API changes (from Hackage documentation)

Files

• Makefile +2/−4
• haskore.cabal +21/−21
• src/Haskore/Composition/Chord.lhs +6/−4
• src/Haskore/Composition/ChordType.lhs +3/−3
• src/Haskore/Composition/Rhythm.lhs +4/−3
• src/Haskore/Example/Detail.hs +1/−1
• src/Haskore/Example/Miscellaneous.lhs +1/−1
• src/Haskore/General/IO.hs +0/−42
• src/Haskore/General/IdGenerator.lhs +0/−88
• src/Haskore/General/Monad.lhs +0/−105
• src/Haskore/General/Utility.lhs +17/−273
• src/Haskore/Interface/AutoTrack/ChordSymbol.lhs +1/−1
• src/Haskore/Interface/AutoTrack/Main.lhs +7/−4
• src/Haskore/Interface/AutoTrack/Style.lhs +10/−7
• src/Haskore/Interface/CSound/Orchestra.lhs +6/−5
• src/Haskore/Interface/CSound/OrchestraFunction.lhs +4/−3
• src/Haskore/Interface/CSound/SoundMap.hs +4/−4
• src/Haskore/Interface/MIDI/InstrumentMap.lhs +4/−4
• src/Haskore/Interface/MIDI/Note.lhs +2/−1
• src/Haskore/Interface/MIDI/Read.lhs +3/−3
• src/Haskore/Interface/MIDI/Write.lhs +2/−2
• src/Haskore/Melody.lhs +1/−1
• src/Haskore/Music.lhs +4/−2
• src/Haskore/Music/Rhythmic.lhs +5/−4
• src/Haskore/Performance.lhs +9/−6
• src/Haskore/Performance/Player.lhs +1/−1
• src/Haskore/Process/Optimization.lhs +4/−3
• src/Medium/Plain/ContextFreeGrammar.lhs +9/−8
• src/Test/Equivalence.lhs +2/−2
• src/Test/Suite.lhs +42/−35

@@ -16,9 +16,7 @@ 	   Performance/Player.lhs Performance/BackEnd.lhs \ 	   Performance/Default.lhs Performance/Fancy.lhs \ 	   Performance.lhs Performance/Context.hs \-	   General/Utility.lhs General/IO.hs \-	   General/Monad.lhs General/Map.hs \-	   General/IdGenerator.lhs \+	   General/Utility.lhs General/Map.hs \ 	   General/LoopTreeTagged.lhs General/LoopTreeRecursive.lhs \ 	   General/LoopTreeTaggedGen.lhs General/LoopTreeRecursiveGen.lhs \ 	   Process/Optimization.lhs Process/Format.lhs \@@ -65,7 +63,7 @@  # exclude installed versions of Haskore, because we want to use the local one HUGS_PACKAGE_PATH = \-   {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))+   {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 utility-ht)) #   $(subst $(space),$(colon),$(patsubst %,{Hugs}/packages/%,event-list midi markov-chain non-negative record-access))  

@@ -1,5 +1,5 @@ Name:           haskore-Version:        0.0.7+Version:        0.1 License:        GPL License-File:   LICENSE Author:         Paul Hudak <paul.hudak@yale.edu>, Henning Thielemann@@ -31,7 +31,7 @@ Source-Repository this   type:     darcs   location: http://darcs.haskell.org/haskore/-  tag:      0.0.7+  tag:      0.1  Flag splitBase   description: Choose the new smaller, split-up base package.@@ -42,25 +42,24 @@  Library   Build-Depends:-    event-list >=0.0.8 && <0.1,     midi >=0.1.1 && <0.2,+    event-list >=0.0.8 && <0.1,     markov-chain >=0.0.1 && <0.1,     non-negative >=0.0.1 && <0.1,     data-accessor >=0.2 && <0.3,+    utility-ht >=0.0.3 && <0.1,     transformers >=0.0.1 && <0.2,+    bytestring >=0.9 && <0.10,     haskell-src >=1.0 && <1.1,-    parsec >=2.1 && <2.2,-    -- for testing-    QuickCheck >=1 && <2,-    HUnit >=1.2 && <1.3+    parsec >=2.1 && <2.2    If flag(splitBase)     Build-Depends:       base >=3,       array >=0.1 && <1.0,+      containers >=0.1 && <1.0,       random >=1.0 && <2.0,-      process >=1.0 && <1.1,-      containers >=0.1 && <1.0+      process >=1.0 && <1.1   Else     Build-Depends:       base >= 1.0 && < 2,@@ -97,18 +96,6 @@     Haskore.Example.SelfSim,     Haskore.Example.Ssf,     Haskore.Example.WhiteChristmas,-    Haskore.General.IO,-    Haskore.General.IdGenerator,-    Haskore.General.LoopTreeRecursive,-    Haskore.General.LoopTreeRecursiveGen,-    Haskore.General.LoopTreeTagged,-    Haskore.General.LoopTreeTaggedGen,-    Haskore.General.GraphRecursiveGen,-    Haskore.General.GraphTaggedGen,-    Haskore.General.Map,-    Haskore.General.Monad,-    Haskore.General.TagDictionary,-    Haskore.General.Utility,     Haskore.Interface.AutoTrack.ChartBar,     Haskore.Interface.AutoTrack.ChordChart,     Haskore.Interface.AutoTrack.ChordSymbol,@@ -159,11 +146,24 @@     Medium.Controlled.List,     Medium.Controlled.ContextFreeGrammar,     Medium.LabeledControlled.List+  Other-modules:+    Haskore.General.LoopTreeRecursive,+    Haskore.General.LoopTreeRecursiveGen,+    Haskore.General.LoopTreeTagged,+    Haskore.General.LoopTreeTaggedGen,+    Haskore.General.GraphRecursiveGen,+    Haskore.General.GraphTaggedGen,+    Haskore.General.Map,+    Haskore.General.TagDictionary,+    Haskore.General.Utility  Executable test   If !flag(buildTests)     Buildable: False --  Installable: False+  Build-Depends:+    QuickCheck >=1 && <2,+    HUnit >=1.2 && <1.3   Hs-Source-Dirs: src, src/Test   Main-Is: Suite.lhs   Other-Modules:

@@ -48,8 +48,10 @@ > import qualified Haskore.Melody as Melody > import qualified Haskore.Basic.Pitch    as Pitch > import qualified Haskore.Basic.Interval as I-> import           Haskore.General.Utility (minimumKey, foldrf, splitInit)-> import           Data.List(genericLength)+> import           Haskore.General.Utility (foldrf, )+> import           Data.Ord.HT (comparing, )+> import           Data.List.HT (viewR, )+> import           Data.List (genericLength, minimumBy, ) > > type T = [Pitch.Relative] @@ -71,7 +73,7 @@ > intervalToPitch :: T -> T > intervalToPitch [] = error "intervalToPitch: Chord must be non-empty." > intervalToPitch ch =->    let (chInit, chLast) = splitInit (scanl (+) 0 ch)+>    let Just (chInit, chLast) = viewR (scanl (+) 0 ch) >    in  if chLast==0 >          then chInit >          else error "intervalToPitch: intervals do not sum-up to zero."@@ -309,7 +311,7 @@ >    let distToWay src (d,dst:_) = d + dist src dst >        distToWay _   (_,[])    = >           error "processZone: list is never empty if called from shortestWays"->    in  map (\src -> minimumKey fst+>    in  map (\src -> minimumBy (comparing fst) >               (map (\way -> (distToWay src way, src : snd way)) ways)) srcs  > propShortestWays :: Int -> Int -> Bool

@@ -9,9 +9,9 @@ > import qualified Text.ParserCombinators.ReadP as ReadP > import           Text.ParserCombinators.ReadP (ReadP) > import qualified Data.Array as Array-> import           Data.Array(Array,Ix,(!))-> import           Haskore.General.Utility(mapSnd)-> import           Control.Monad(liftM2,liftM3)+> import           Data.Array(Array, Ix, (!), )+> import           Data.Tuple.HT (mapSnd, )+> import           Control.Monad (liftM2, liftM3, )  \end{haskelllisting} 

@@ -12,8 +12,9 @@ > import qualified Haskore.Music.GeneralMIDI as MidiMusic > import qualified Haskore.Music.Rhythmic    as RhyMusic > import Haskore.Basic.Duration (qn, en, sn, (%+), )-> import Haskore.General.Utility(zapWith, select)-> import Data.Char(isSpace)+> import Data.List.HT (mapAdjacent, )+> import Data.Bool.HT (select, )+> import Data.Char (isSpace, )  \end{haskelllisting} @@ -74,7 +75,7 @@ >           if d>0 >             then d >             else error ("fromPositions: list of time events must increase strictly monotonously")->    in  concatMap hitAfter (zapWith ((checkPos .) . subtract) ((-1):l))+>    in  concatMap hitAfter (mapAdjacent ((checkPos .) . subtract) ((-1):l))  \end{haskelllisting} 

@@ -14,7 +14,7 @@ import System.Random (RandomGen, randomR, mkStdGen, ) import Control.Monad.Trans.State (State, state, evalState, ) -import Haskore.General.Utility (toMaybe, )+import Data.Maybe.HT (toMaybe, ) import qualified Data.List as List  

@@ -35,7 +35,7 @@ > import qualified Numeric.NonNegative.Wrapper as NonNeg  > import System.IO(IO)-> import Haskore.General.Utility (fst3, snd3, thd3)+> import Data.Tuple.HT (fst3, snd3, thd3, )   > t0, t1, t2, t3, t4, t5,

@@ -1,42 +0,0 @@--------------------------------------------------------------------------------- Implements only the functions necessary for Haskore!------ Suitable for use with Hugs 98--------------------------------------------------------------------------------module Haskore.General.IO-          (openBinaryFile, readBinaryFile, writeBinaryFile,-           ByteString, stringCharFromByte, stringByteFromChar, )-   where--import System.IO-   (IOMode(ReadMode, WriteMode),-    openBinaryFile, hClose, hGetContents, hPutStr, )-import Control.Exception(bracket)-import Control.Monad(liftM)-import Data.Char (ord, chr)-import Data.Word (Word8)--type ByteString = [Word8]--{- |-Hugs makes trouble here because it performs UTF-8 conversions.-E.g. @[255]@ is output as @[195,191]@-It would be easy to replace these routines by FastPackedString(fps).ByteString.Lazy,-however this introduces a new package dependency.--}-writeBinaryFile :: FilePath -> ByteString -> IO ()-writeBinaryFile path str =-   bracket (openBinaryFile path WriteMode) hClose-           (flip hPutStr (stringCharFromByte str))--stringCharFromByte :: ByteString -> String-stringCharFromByte = map (chr . fromIntegral)--readBinaryFile :: FilePath -> IO ByteString-readBinaryFile path =-   liftM stringByteFromChar .-      hGetContents =<< openBinaryFile path ReadMode--stringByteFromChar :: String -> ByteString-stringByteFromChar = map (fromIntegral . ord)

@@ -1,88 +0,0 @@--\subsection{Identifier generator}--Generates unique elements but elements can be declared as unused, again.--\begin{haskelllisting}--> module Haskore.General.IdGenerator where--> import Data.Set (Set)-> import qualified Data.Set as Set-> import Control.Monad.Trans.State(State, state, evalState, modify, get, )-> import Control.Monad (when, )-> import Haskore.General.Utility(mapFst)--\end{haskelllisting}--The generator is a state monad-where the state consists of the set of the explicitly unused elements-and a lower bound for another set of ids that are still unused.-Essentially, the Set stores all recycled ids,-and the lower bound stores the ids not used so far.-All elements in the explicit set must be below the bound.--\begin{haskelllisting}--> type T i a = State (St i) a--> type St i = (Set i, i)--> run :: i -> T i a -> a-> run start gen = evalState gen (Set.empty, start)--\end{haskelllisting}--Reserve a new id.--\begin{haskelllisting}--> alloc :: (Ord i, Enum i) => T i i-> alloc =->    state $ \(set, next) ->->       if Set.null set->         then (next, (set, succ next))->         else let (newId, newSet) = Set.deleteFindMin set->              in  (newId, (newSet, next))--\end{haskelllisting}--Return an id.--We call reduce in order to prevent the set from growing too much.-We call it only once in order to prevent a heavy CPU lead-when the last id of a sequence is returned.-So the reduction is spread over several calls to 'free'.--\begin{haskelllisting}--> free :: (Ord i, Enum i) => i -> T i ()-> free oldId =->    do s <- get->       when (isFree s oldId)->            (error "IdGenerator.free: id freed twice")->       modify (mapFst (Set.insert oldId))->       modify reduce--\end{haskelllisting}--If the largest free id and the lower bound of free ids are successive elements-then we can decrease the lower bound.-This procedure can be iterated.-This way we can save storage in the set.--\begin{haskelllisting}--> reduce :: (Ord i, Enum i) => St i -> St i-> reduce (set, next) =->    if not (Set.null set) && Set.findMax set == pred next->      then (Set.deleteMax set, pred next)->      else (set, next)--> isFree :: (Ord i) => St i -> i -> Bool-> isFree (set,next) i = Set.member i set || i >= next--> isValid :: (Ord i) => St i -> Bool-> isValid (set,next) = Set.findMax set < next--\end{haskelllisting}

@@ -1,105 +0,0 @@--These functions were formerly located in a module called "HugsUtils" ---but it was too messy to make it a "standard Hugs library"-so we moved it over here.--> module Haskore.General.Monad where--> import Control.Monad (MonadPlus, mplus, liftM2)--ToDo: decide on appropriate fixities for these functions--\begin{haskelllisting}--> infixr 2 `andOnError`, `butOnError`-> -> assert :: Bool -> String -> IO ()-> assert True _    = return ()-> assert False msg = ioError (userError msg)--\end{haskelllisting}--Resource (de)allocation can interact badly with error handling code.-For example, even if the programmer has taken care that every-resource allocation is paired with an appropriate deallocation,-they might forget to release resources when an exception is-invoked.  For example, this program would fail to close-\code{outFile} if an error occured while operating on one of the \code{inFile}s.--\begin{haskelllisting}--  cat :: String -> [String] -> IO ()-  cat outfile files = do-    outFile <- open outfile WriteMode-    mapM_ (\file -> do-         inFile <- open file ReadMode-         copy inFile outFile-         close inFile-       ) -      files-    close outFile--\end{haskelllisting}--The following functions provide ways of ensuring that a piece of-"cleanup code" is executed even if an exception is raised.--\begin{itemize}-\item-  \lstinline!m `andOnError` k!  is like \lstinline!m >> k! except that \code{k} gets executed-    even if an exception is raised in \code{m}.-\item-  \lstinline!m `butOnError` k! is like \code{m} except that \code{k} gets executed if-    an exception is raised in \code{m}.-\end{itemize}--For example, the following version of \code{cat} guarantees to close all-files even if an error occurs.--\begin{haskelllisting}--  cleancat :: String -> [String] -> IO ()-  cleancat outfile files = do-    outFile <- open outfile WriteMode-    mapM_ (\file -> do-         open file ReadMode   >>= \ inFile ->-         copy inFile outFile  `andOnError`-         close inFile-       ) -      files-     `andOnError`-      close outFile--\end{haskelllisting}--\begin{haskelllisting}--> andOnError :: IO a -> IO b -> IO b-> m `andOnError` k = (m `catch` \e -> k >> ioError e) >> k--\end{haskelllisting}--Use this to add some cleanup code k that only gets executed-if an error occurs during execution of m.--\begin{haskelllisting}--> butOnError :: IO a -> IO () -> IO a-> m `butOnError` k = (m `catch` \e -> k >> ioError e)--> zeroOrMore, oneOrMore :: MonadPlus m => m a -> m [a]-> zeroOrMore m      = return [] `mplus` oneOrMore m-> oneOrMore  m      = liftM2 (:) m (zeroOrMore m)--\end{haskelllisting}--Repeat the action \code{m} until the result fulfills \code{p}.--\begin{haskelllisting}--> untilM :: Monad m => (a -> Bool) -> m a -> m a-> untilM p m =->    do x <- m->       if p x then return x else untilM p m--\end{haskelllisting}

@@ -2,81 +2,21 @@  \begin{haskelllisting} -> module Haskore.General.Utility(->         fst3, snd3, thd3, mapPair, mapFst, mapSnd, flipPair,->         flattenTuples2, flattenTuples3, flattenTuples4,->         mergeBy, partition, splitBy, segmentBefore,->         shuffle, removeDups, foldrf,->         roundDiff, roundDiff',->         mapInit, splitInit, headWithDefault,->         zapWith, zipWithMatch, zipWithMatch3,->         maximum0, maximumKey, minimumKey,->         limit, translate, randList, select,->         equalField, equalRecord,->         compareField, compareRecord, composeDouble,->         divisible, divide, modulus, divideModulus, gcdDur,->         toMaybe, partitionMaybe-> 	) where-> -> 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)-> import Data.Maybe (fromMaybe, listToMaybe)+> module Haskore.General.Utility where+>+> import Control.Monad.Trans.State (state, runState, )+> import System.Random (RandomGen, randomR, randomRs, mkStdGen, )+> import Data.List.HT (segmentBefore, partition, )+> import Data.List (foldl', )+> import Data.Ratio ((%), denominator, numerator, Ratio, )+> import Data.Maybe (fromMaybe, listToMaybe, )+> import Data.Char (ord, chr, )+> import Data.Word (Word8, ) > import qualified Haskore.General.Map as Map - \end{haskelllisting} -Support for triples. -\begin{haskelllisting}--> fst3 :: (a,b,c) -> a-> fst3 (x,_,_) = x--> snd3 :: (a,b,c) -> b-> snd3 (_,x,_) = x--> thd3 :: (a,b,c) -> c-> thd3 (_,_,x) = x--\end{haskelllisting}--Given two lists that are ordered-(i.e. \lstinline!p x y! holds for subsequent \code{x} and \code{y})-mergeBy them into a list that is ordered, again.--This could be used for parallel compositions of \code{Performance.T}-if the events had absolute times.--\begin{haskelllisting}--> mergeBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]-> mergeBy p =->    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 lazy pattern match on \code{(y,z)} is necessary-since otherwise it fails on infinite lists.--\begin{haskelllisting}--> partition :: (a -> Bool) -> [a] -> ([a], [a])-> partition p =->    foldr (\x ~(y,z) -> if p x then (x : y, z)->                               else (y, x : z)) ([],[])--\end{haskelllisting}- \function{splitBy} takes a boolean test and a list; it divides up the list and turns it into a {\em list of sub-lists}; each sub-list consists of@@ -93,10 +33,6 @@ > splitBy :: (a -> Bool) -> [a] -> [[a]] > splitBy p = dropWhile null . segmentBefore p -> segmentBefore :: (a -> Bool) -> [a] -> [[a]]-> segmentBefore p =->    foldr (\ x ~(y:ys) -> (if p x then ([]:) else id) ((x:y):ys)) [[]]- \end{haskelllisting}  \function{segmentBefore} will have at most one empty list at the beginning,@@ -140,76 +76,14 @@  > 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)  \end{haskelllisting} -Remove consecutive duplicates from a list.-The implementation could avoid \function{head},-if the \function{group} would indicate by its return type,-that all sub-lists are non-empty.-\begin{haskelllisting} -> removeDups :: Eq a => [a] -> [a]-> removeDups = map head . group--\end{haskelllisting}---Given the time fraction that remains from the preceding event-and the current time difference,-evaluate an integer time difference and-the remaining fractional part.-If we would simply map Time to integer values-with respect to the sampling rate,-then rounding errors would accumulate.-\begin{haskelllisting}--> roundDiff' :: (RealFrac t, Integral i) => t -> t -> (i, t)-> roundDiff' time frac =->    let x = time+frac->        n = round x->    in  (n, x - fromIntegral n)--> roundDiff :: (RealFrac t, Integral i) => t -> State t i-> roundDiff = state . roundDiff'--\end{haskelllisting}--Apply two functions on corresponding values.--Instead of pattern matching with say \code{(x,y)}-we use \function{fst} and \function{snd}.-Pattern matching with \code{(x,y)} is too lazy (or too strict?)-so it can be that the pair parameter is the result-of an infinite recursion.-It can not be matched until the recursion is finished,-because the program don't know whether it is bottom.-The functions \function{fst} and \function{snd}-seems to work-around this problem.--\begin{haskelllisting}--> -- Control.Arrow.***-> mapPair :: (a -> c, b -> d) -> (a,b) -> (c,d)-> mapPair ~(f,g) ~(x,y) = (f x, g y)-> -- mapPair f x = (fst f (fst x), snd f (snd x))--> -- Control.Arrow.first-> mapFst :: (a -> c) -> (a,b) -> (c,b)-> mapFst f ~(x,y) = (f x, y)--> -- Control.Arrow.second-> mapSnd :: (b -> d) -> (a,b) -> (a,d)-> mapSnd g ~(x,y) = (x, g y)--> flipPair :: (a,b) -> (b,a)-> flipPair (x,y) = (y,x)--\end{haskelllisting}- \function{flattenTuples2} flattens a list of pairs into a list. Similarly, \function{flattenTuples3} flattens a list of 3-tuples into a list, and so on.@@ -226,51 +100,6 @@ \end{haskelllisting}  --Map all elements by f except the last one, which is kept unchanged.--\begin{haskelllisting}--> mapInit :: (a -> a) -> [a] -> [a]-> mapInit f =->    foldr (\x ys -> (if null ys then x else f x) : ys) []--  mapInit' :: (a -> a) -> [a] -> [a]-  mapInit' f xs =-     let repf = map (const f) xs  -- replicate f lazily to (length xs)-     in  zipWith ($) (tail (repf ++ [id])) xs--  quickCheck-       (\x -> mapInit succ x == mapInit' succ (x::[Integer]))---  mapInit'' :: (a -> a) -> [a] -> [a]-  mapInit'' f = foldrf (\x ys -> f x : ys) (:[])--  quickCheck-       (\x -> not (null (x::[Integer])) ==>-            mapInit succ x == mapInit' succ x)--\end{haskelllisting}--This is a combination of \function{init} and \function{last}-which avoids memoizing the list-if the last element is accessed after the initial ones.--\begin{haskelllisting}--> splitInit :: [a] -> ([a], a)-> splitInit [] = error "splitInit: empty list"-> splitInit [x] = ([], x)-> splitInit (x:xs) =->    mapPair ((x:),id) (splitInit xs)--  propSplitInit :: Eq a => [a] -> Bool-  propSplitInit xs =-     splitInit xs  ==  (init xs, last xs)--\end{haskelllisting}- Choose the first element from a list, and return the default value, if the list is empty. \begin{haskelllisting}@@ -305,16 +134,6 @@ \end{haskelllisting}  -This function combines every pair of neighbour elements-in a list with a certain function.--\begin{haskelllisting}--> zapWith :: (a -> a -> b) -> [a] -> [b]-> zapWith f x = zipWith f x (tail x)--\end{haskelllisting}- Variants of \function{zip} and \function{zip3} which check that all argument lists have the same length. @@ -344,69 +163,7 @@  \end{haskelllisting} -\begin{haskelllisting} -> maximumKey, minimumKey :: (Ord b) => (a -> b) -> [a] -> a-> maximumKey f = maximumBy (compareField f)-> minimumKey f = minimumBy (compareField f)--\end{haskelllisting}--A combination of \function{min} and \function{max}-for clipping a value to a certain range.--\begin{haskelllisting}--> limit :: (Ord a) => (a,a) -> a -> a-> limit (l,u) = max l . min u--\end{haskelllisting}--From a list of expressions choose the one,-whose condition is true.--\begin{haskelllisting}--> select :: a -> [(Bool, a)] -> a-> select def = maybe def snd . find fst--\end{haskelllisting}---Compare the same field of two records.--\begin{haskelllisting}--> composeDouble :: (b -> b -> c) -> (a -> b) -> (a -> a -> c)-> composeDouble g f x y = g (f x) (f y)--> compareField :: Ord b => (a -> b) -> a -> a -> Ordering-> compareField = composeDouble compare--\end{haskelllisting}--Lexicographically compare a list of attributes of two records.--\begin{haskelllisting}--> compareRecord :: [a -> a -> Ordering] -> a -> a -> Ordering-> compareRecord cs x y =->    head (dropWhile (EQ==) (map (\c -> c x y) cs) ++ [EQ])--\end{haskelllisting}---\begin{haskelllisting}--> equalField :: Eq b => (a -> b) -> a -> a -> Bool-> equalField = composeDouble (==)--> equalRecord :: [a -> a -> Bool] -> a -> a -> Bool-> equalRecord cs x y = all (\c -> c x y) cs--\end{haskelllisting}-- Convert a mapping (i.e. list of pairs) to a function, and use this for a translation function, which translates every character in a by replacing it by looking it up in l2 and replacing it with the according character in l2.@@ -478,27 +235,14 @@  \end{haskelllisting} -Returns 'Just' if the precondition is fulfilled.- \begin{haskelllisting} -> toMaybe :: Bool -> a -> Maybe a-> toMaybe False _ = Nothing-> toMaybe True  x = Just x--\end{haskelllisting}--Every element which evaluates to Just is put into the first list.-The second list contains the remaining elements.-It holds \expression{mapMaybe f == fst . partitionMaybe f}-and \expression{partition p == partitionMaybe (\ x -> toMaybe (p x) x)}.+> type ByteList = [Word8] -\begin{haskelllisting}+> stringCharFromByte :: ByteList -> String+> stringCharFromByte = map (chr . fromIntegral) -> partitionMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])-> partitionMaybe f =->    foldr (\x ~(y,z) -> case f x of->              Just x' -> (x' : y, z)->              Nothing -> (y, x : z)) ([],[])+> stringByteFromChar :: String -> ByteList+> stringByteFromChar = map (fromIntegral . ord)  \end{haskelllisting}

@@ -14,7 +14,7 @@ > import qualified Haskore.Composition.ChordType as ChordType > import qualified Text.ParserCombinators.ReadP as ReadP > import           Text.ParserCombinators.ReadP (ReadP)-> import           Haskore.General.Utility(mapSnd)+> import           Data.Tuple.HT (mapSnd, )  \end{haskelllisting} 

@@ -110,12 +110,15 @@ > module Main where > import qualified Option > import qualified Haskore.Interface.AutoTrack.Style as Style-> import Haskore.General.IO (stringCharFromByte)+> import Haskore.General.Utility (stringCharFromByte, )+> import qualified Data.ByteString.Lazy as B  > main :: IO ()-> main = do (t, s, r, c) <- Option.getAll->           interact (fmap stringCharFromByte $->                       Style.playToStream r s t c . read)+> main =+>    do (t, s, r, c) <- Option.getAll+>       interact+>          (stringCharFromByte . B.unpack .+>           Style.playToStream r s t c . read)  \end{haskelllisting} 

@@ -8,8 +8,8 @@ >           (T, playToStream, jazz, bossa, takeFive, rock, >            thomasCarib, harmonic) where -> import Haskore.General.Utility (select, splitInit)-> import Haskore.General.IO (ByteString)+> import Data.Bool.HT (select, )+> import Data.List.HT (viewR, ) > import Haskore.Basic.Duration (en, qn, (%+), ) > import Haskore.Music ((+:+), (=:=), ) @@ -30,6 +30,8 @@ > import qualified Haskore.Interface.AutoTrack.EventChart  as EventChart > import qualified Haskore.Interface.AutoTrack.Instrument  as Instrument +> import qualified Data.ByteString.Lazy as B+ \end{haskelllisting}  A style takes a chord chart and creates some music out of it.@@ -100,12 +102,12 @@  \begin{haskelllisting} -> playToStream :: Int -> T -> Integer -> Int -> ChordChart.T -> ByteString+> playToStream :: Int -> T -> Integer -> Int -> ChordChart.T -> B.ByteString > playToStream trans style tempo chornum chart = >     let countin = Rhythm.countIn (ChartBar.dur (head (ChordChart.bars chart))) >         choruses = Music.replicate chornum (style (Transposeable.transpose trans chart)) >         music = Music.changeTempo (tempo%+60) (countin +:+ choruses)->     in MidiSave.toByteList (MidiRender.generalMidiDeflt music)+>     in MidiSave.toByteString (MidiRender.generalMidiDeflt music)  \end{haskelllisting} @@ -126,9 +128,10 @@ >      else error "jazzFill: d must be at least 2%+4"  > endFill :: [ ChartBar.T ] -> MidiMusic.T-> endFill l = let (initLd,lastLd) = splitInit $ map ChartBar.dur l->             in  Music.line (map Music.rest initLd) +:+->                 jazzFill lastLd+> endFill l =+>    let Just (initLd,lastLd) = viewR $ map ChartBar.dur l+>    in  Music.line (map Music.rest initLd) +:++>        jazzFill lastLd  \end{haskelllisting} 

@@ -46,8 +46,6 @@ > > import qualified Haskore.General.LoopTreeRecursiveGen as TreeRec > import qualified Haskore.General.LoopTreeTaggedGen    as TreeTag->-> import Haskore.General.Utility (flattenTuples2, partition, mapSnd, toMaybe)  > import Control.Monad.Trans.State (State, state, modify, execState, ) > import Control.Applicative (liftA, liftA2, liftA3, pure)@@ -55,9 +53,12 @@ > import Data.Traversable (Traversable(sequenceA)) > import qualified Data.Traversable as Traversable -> import System.IO-> import Data.Maybe (mapMaybe)-> import Data.List (nub, intersperse, (\\))+> import Haskore.General.Utility (flattenTuples2, )+> import Data.List.HT (partition, )+> import Data.Tuple.HT (mapSnd, )+> import Data.Maybe.HT (toMaybe, )+> import Data.Maybe (mapMaybe, )+> import Data.List (nub, intersperse, (\\), )  \end{haskelllisting} 

@@ -1,13 +1,14 @@ > module Haskore.Interface.CSound.OrchestraFunction where-> import Haskore.General.Utility (headWithDefault)-> import Data.List (lookup)+> import Data.List (lookup, )  > {- a fast variant of 'elem' >    precondition: list must be sorted >    This could be replaced by Data.Map when it is widely available. -} > elemSorted :: (Ord a) => a -> [a] -> Bool > elemSorted x ys =->    EQ == headWithDefault LT (dropWhile (GT==) (map (compare x) ys))+>    case dropWhile (GT==) (map (compare x) ys) of+>       EQ:_ -> True+>       _ -> False  > allowedArgs :: [(String, [Int])] -> String -> Int -> Bool > allowedArgs table name count =

@@ -5,11 +5,11 @@ import qualified Haskore.Interface.CSound.Orchestra as Orchestra  import Haskore.Interface.CSound.Orchestra-          (SigExp, noteDur, noteVel, notePit, pField)-import Haskore.Interface.CSound (PField, Instrument)+          (SigExp, noteDur, noteVel, notePit, pField, )+import Haskore.Interface.CSound (PField, Instrument, ) -import Haskore.General.Utility (toMaybe)-import Data.Maybe (mapMaybe)+import Data.Maybe.HT (toMaybe, )+import Data.Maybe (mapMaybe, )   type SoundId = Instrument

@@ -9,11 +9,11 @@ > import qualified Sound.MIDI.Message.Channel as ChannelMsg > import qualified Sound.MIDI.General         as GeneralMidi -> import Haskore.General.Utility(flipPair) > import qualified Haskore.General.Map as Map-> import Data.Char(toLower)-> import Data.Maybe(fromMaybe) > import qualified Data.List as List+> import Data.Tuple.HT (swap, )+> import Data.Char (toLower, )+> import Data.Maybe (fromMaybe, )  \end{haskelllisting} @@ -132,7 +132,7 @@  > reverseLookupMaybe :: Eq a => [(instr, a)] -> a -> Maybe instr > reverseLookupMaybe ys x =->    List.lookup x (map flipPair ys)+>    List.lookup x (map swap ys)  > reverseLookup :: Eq a => [(instr, a)] -> a -> instr > reverseLookup ys x =

@@ -15,7 +15,8 @@ > import qualified Haskore.Music.GeneralMIDI            as MidiMusic > import qualified Haskore.Music.Rhythmic               as RhyMusic > import qualified Haskore.Basic.Pitch                  as Pitch-> import           Haskore.General.Utility (limit, toMaybe)+> import           Data.Ord.HT (limit, )+> import           Data.Maybe.HT (toMaybe, ) > import qualified Data.List as List  > data T =

@@ -38,8 +38,8 @@  > import Haskore.Music >              (line, chord, changeTempo, Dur, DurRatio)-> import Haskore.General.Utility (mapPair, mapSnd, )-> import qualified Haskore.General.Utility as Utility+> import Data.Tuple.HT (mapPair, mapSnd, )+> import qualified Data.List.HT as ListHT > > import Haskore.General.Map (Map) > import qualified Haskore.General.Map as Map@@ -213,7 +213,7 @@ >    (body -> Bool) -> TimeList.T time body -> [TimeList.T time body] > segmentBefore p = >    map TimeList.fromPairList .->    Utility.segmentBefore (p . snd) .+>    ListHT.segmentBefore (p . snd) . >    TimeList.toPairList  \end{haskelllisting}

@@ -82,9 +82,9 @@  > import qualified Numeric.NonNegative.Class as NonNeg -> import Haskore.General.Utility(limit) > import qualified Haskore.General.Map as Map-> import Data.Maybe(mapMaybe)+> import Data.Ord.HT (limit, )+> import Data.Maybe (mapMaybe, ) > import Control.Monad.Trans.State (state, evalState, ) > import Control.Monad (liftM, ) 

@@ -7,7 +7,7 @@ > import qualified Haskore.Basic.Pitch    as Pitch > import qualified Haskore.Basic.Duration as Duration > import qualified Haskore.Music as Music-> import Haskore.General.Utility (mapSnd)+> import Data.Tuple.HT (mapSnd, )  > import qualified Medium 

@@ -14,8 +14,10 @@ > import qualified Medium > import Medium (prim, serial, parallel) -> import Haskore.General.Utility (mapPair, mapSnd, maximum0, toMaybe)-> import Data.Maybe (isJust)+> import Haskore.General.Utility (maximum0, )+> import Data.Tuple.HT (mapPair, mapSnd, )+> import Data.Maybe.HT (toMaybe, )+> import Data.Maybe (isJust, ) > import qualified Data.List as List  \end{haskelllisting}

@@ -36,7 +36,8 @@  > import qualified Data.Accessor.Basic as Accessor -> import Haskore.General.Utility (compareRecord, compareField, )+> import qualified Data.Record.HT as Record+> import Data.Ord.HT (comparing, )  > data Note drum instr = >      Note {velocity   :: Rational,@@ -62,9 +63,9 @@ > -- this order is just for the old test cases which rely on it > instance (Ord instr, Ord drum) => Ord (Note drum instr) where >    compare =->       compareRecord->          [compareField body,->           compareField velocity]+>       Record.compare+>          [comparing body,+>           comparing velocity]  > type T drum instr = Music.T (Note drum instr) 

@@ -17,7 +17,10 @@ > import qualified Data.EventList.Relative.TimeMixed   as TimeListPad > import qualified Numeric.NonNegative.Class as NonNeg -> import Haskore.General.Utility (mapPair, maximum0, compareRecord, compareField)+> import Haskore.General.Utility (maximum0, )+> import Data.Tuple.HT (mapPair, )+> import qualified Data.Record.HT as Record+> import Data.Ord.HT (comparing, ) > import Control.Monad.Trans.Reader (Reader, runReader, ask, asks, local, ) > import Control.Applicative(WrappedMonad(WrapMonad), unwrapMonad, ) > import Data.Traversable(sequenceA)@@ -58,11 +61,11 @@ > instance (Ord time, Ord dyn, Ord note) => >              Ord (Event time dyn note) where >    compare =->       compareRecord->          [compareField eventNote,->           compareField eventDynamics,->           compareField eventTranspose,->           compareField eventDur]+>       Record.compare+>          [comparing eventNote,+>           comparing eventDynamics,+>           comparing eventTranspose,+>           comparing eventDur]  \end{haskelllisting} An event is the lowest of our music representations not yet committed

@@ -14,7 +14,7 @@ > import qualified Haskore.Basic.Duration as Dur > import qualified Numeric.NonNegative.Class as NonNeg > import Haskore.Performance (eventDur, eventDynamics, )-> import Haskore.General.Utility(mapFst)+> import Data.Tuple.HT (mapFst, )  > import Control.Monad.Trans.Reader(Reader, asks, ) > import Control.Monad (liftM, )

@@ -13,9 +13,10 @@ > import qualified Medium.Controlled.List as CtrlMediumList > import qualified Medium.Controlled      as CtrlMedium > import qualified Haskore.Music as Music-> import Medium.Controlled.List (serial, parallel)-> import Haskore.General.Utility (toMaybe, partitionMaybe)-> import Data.Maybe (catMaybes, fromMaybe)+> import Medium.Controlled.List (serial, parallel, )+> import Data.List.HT (partitionMaybe, )+> import Data.Maybe.HT (toMaybe, )+> import Data.Maybe (catMaybes, fromMaybe, )  \end{haskelllisting} 

@@ -20,12 +20,13 @@  > module Medium.Plain.ContextFreeGrammar where -> import Data.List (sort, tails, isPrefixOf, findIndex)-> import Data.Maybe (fromJust)+> import Data.List.HT (tails, mapAdjacent, )+> import Data.List (sort, isPrefixOf, findIndex, )+> import Data.Maybe (fromJust, ) > import qualified Haskore.General.Map as Map-> import Haskore.General.Utility (maximumKey, zapWith)+> import qualified Data.List.Key as Key -> import Control.Monad.Trans.State (StateT, put, get, state, execState)+> import Control.Monad.Trans.State (StateT, put, get, state, execState, )  > import Medium (prim, serial1, parallel1) > import qualified Medium@@ -212,8 +213,8 @@  > maximumCommonInfix :: (Ord a, Ord b) => ([a] -> b) -> [a] -> [a] > maximumCommonInfix mag =->    maximumKey mag .->    zapWith commonPrefix .+>    Key.maximum mag .+>    mapAdjacent commonPrefix . >    sort . tails  \end{haskelllisting}@@ -225,8 +226,8 @@  > maximumCommonInfixMulti :: (Ord a, Ord b) => ([a] -> b) -> [[a]] -> [a] > maximumCommonInfixMulti mag =->    maximumKey mag .->    zapWith commonPrefix .+>    Key.maximum mag .+>    mapAdjacent commonPrefix . >    sort . concatMap tails  \end{haskelllisting}

@@ -176,9 +176,9 @@ > import qualified Haskore.Basic.Duration as Dur > import qualified Data.EventList.Relative.TimeTime as TimeListPad > import qualified Numeric.NonNegative.Wrapper as NonNeg-> import Haskore.General.Utility (mapFst)+> import Data.Tuple.HT (mapFst, ) -> import Control.Monad.Trans.Reader (runReader)+> import Control.Monad.Trans.Reader (runReader, )  > import Test.QuickCheck 

@@ -11,32 +11,23 @@  > module Main where -> import System.Cmd (system)-> import qualified Haskore.General.IO as BinIO--> import Test.QuickCheck hiding (test, label)-> import qualified Test.QuickCheck       as QC-> import qualified Test.QuickCheck.Batch as QCB-> import qualified Test.HUnit      as HUnit-> import qualified Test.HUnit.Text as HUnitText-> import System.Random(Random)--> import Equivalence((=?=),(==?==))+> import Equivalence((=?=), (==?==), ) > import qualified Equivalence > import qualified Medium.Controlled      as CtrlMedium > import qualified Medium.Controlled.List as CtrlMediumList > import qualified Medium.Temporal as Temporal > import qualified Medium +> import qualified Control.Monad.HT as M > import qualified Data.List as List-> import           Data.Ratio(Ratio,(%))-> import           Data.Maybe(isJust)-> import System.Random(StdGen, mkStdGen, randomR)-> import Control.Monad (liftM, liftM2, replicateM, when)-> import Haskore.General.Monad (untilM, )-> import Haskore.General.Utility (shuffle, toMaybe, maximum0)+> import           Data.Ratio (Ratio, (%), )+> import           Data.Maybe (isJust, )+> import           Data.Maybe.HT (toMaybe, )+> import System.Random(StdGen, mkStdGen, randomR, )+> import Control.Monad (liftM, liftM2, replicateM, when, )+> import Haskore.General.Utility (shuffle, maximum0, ) -> import Haskore.Music        hiding (repeat, reverse)+> import Haskore.Music        hiding (repeat, reverse, ) > import Haskore.Melody          as Melody > import Haskore.Basic.Duration (wn, qn, en, (%+), ) @@ -71,6 +62,7 @@ > import qualified Sound.MIDI.File.Save    as SaveMidi > import qualified Sound.MIDI.File.Load    as LoadMidi > import qualified Sound.MIDI.General      as GeneralMidi+> import qualified Sound.MIDI.Parser.Report as MidiReport  > import qualified Haskore.Interface.CSound.Orchestra as CSOrchestra > import qualified Haskore.Interface.CSound.Score     as CSScore@@ -84,8 +76,20 @@ > import qualified Numeric.NonNegative.Wrapper as NonNegW > import Numeric.NonNegative.Class ((-|)) -> import qualified Data.Accessor.Basic      as Accessor+> import Test.QuickCheck+>    (Property, (==>), Arbitrary, resize, arbitrary, sized, choose,+>     Testable, Gen, oneof, frequency, )+> import qualified Test.QuickCheck       as QC+> import qualified Test.QuickCheck.Batch as QCB+> import qualified Test.HUnit      as HUnit+> import qualified Test.HUnit.Text as HUnitText+> import System.Random (Random, ) +> import qualified Data.Accessor.Basic as Accessor++> import System.Cmd (system, )+> import qualified Data.ByteString.Lazy as B+   import Debug.Trace (trace)  @@ -167,9 +171,9 @@ >    do > --   diffMidiBin name (sortMidi stream) >      let path = midiDir++name++".mid"->      let new  = SaveMidi.toByteList (sortMidi stream)->      -- BinIO.writeBinaryFile path new->      orig <- BinIO.readBinaryFile path+>      let new  = SaveMidi.toByteString (sortMidi stream)+>      -- B.writeFile path new+>      orig <- B.readFile path >      -- putStrLn (show (length orig) ++ " -- " ++ show (length stream)) >      HUnit.assertEqual "saveMidi" orig new @@ -219,13 +223,16 @@ > testReadMidi :: FilePath -> HUnit.Test > testReadMidi name = HUnit.TestCase $ >    do->      contents <- BinIO.readBinaryFile (midiDir++name++".mid")->      let midiFile = LoadMidi.fromByteList contents->      let midiFileRewritten = sortMidi (writeMusic (ReadMidi.toGMMusic midiFile))+>      contents <- B.readFile (midiDir++name++".mid")+>      let midiFile =+>             either (error "on reading back MIDI") id $+>             MidiReport.result $+>             LoadMidi.maybeFromByteString contents+>      let midiFileRewritten = sortMidi $ writeMusic $ ReadMidi.toGMMusic midiFile >      HUnit.assertEqual >         "loadMidi" >         contents->         (SaveMidi.toByteList midiFile)+>         (SaveMidi.toByteString midiFile) >      -- diffMidiBin name (MidiFile.sortEvents (writeMusic (ReadMidi.toGMMusic midiFile))) >      {- Notes of zero duration bring note events out of order >         if sorted with MidiFile.sortEvents.@@ -238,11 +245,11 @@ >      HUnit.assertEqual >         "ReadMidi.toGMMusic[1]" > {-->         (return (SaveMidi.toByteList (MidiFile.sortEvents midiFile)->             == SaveMidi.toByteList midiFileRewritten))+>         (return (SaveMidi.toByteString (MidiFile.sortEvents midiFile)+>             == SaveMidi.toByteString midiFileRewritten)) > -} >         contents->         (SaveMidi.toByteList midiFileRewritten)+>         (SaveMidi.toByteString midiFileRewritten) >      -- sorting necessary for test14b  > testReadMidiPure :: MidiFile.T -> HUnit.Assertion@@ -566,7 +573,7 @@ >    arbitrary = >       oneof >          [liftM Music.Tempo->                    (untilM (0<) (resize 20 arbitrary)),+>                    (M.until (0<) (resize 20 arbitrary)), >           liftM Music.Transpose (resize 20 arbitrary)] >    coarbitrary = undefined @@ -611,8 +618,8 @@  > -- we need this e.g. for Equivalence.propTempoRest0 > instance (Integral a, Arbitrary a) => Arbitrary (Ratio a) where-> --   arbitrary = liftM2 (%+) arbitrary (untilM (0/=) arbitrary)-> {-      untilM (0/=) leads to infinite loop in some cases,+> --   arbitrary = liftM2 (%+) arbitrary (M.until (0/=) arbitrary)+> {-      M.until (0/=) leads to infinite loop in some cases, >         probably because of 'size' reduced to zero. -} >    arbitrary = >       liftM2 (\numer denom -> numer % (if denom==0 then 1 else denom))@@ -943,10 +950,10 @@ >       if False >         then system ("echo 'main\n:q' | hugs -98 -P"++hugsPath++" GeneratedTest") >         else system ("ghc -e main -i"++hugsPath++" GeneratedTest")->       midi <- BinIO.readBinaryFile "test.mid"+>       midi <- B.readFile "test.mid" >       let expectedMidi =->              SaveMidi.toByteList (Render.generalMidi (withPiano ctrlMusic))->       -- BinIO.writeBinaryFile "expected.mid" expectedMidi+>              SaveMidi.toByteString (Render.generalMidi (withPiano ctrlMusic))+>       -- B.writeFile "expected.mid" expectedMidi >       HUnit.assertEqual >          "formatting music" >          expectedMidi