\subsubsection{Instrument map} \seclabel{user-patch-map} \begin{haskelllisting} 
> module Haskore.Interface.MIDI.InstrumentMap where

> import Haskore.Music.Standard(Instr)
> import qualified Sound.MIDI.Message.Channel as ChannelMsg
> import qualified Sound.MIDI.General         as GeneralMidi

> import qualified Haskore.General.Map as Map
> import qualified Data.List as List
> import Data.Tuple.HT (swap, )
> import Data.Char (toLower, )
> import Data.Maybe (fromMaybe, )
\end{haskelllisting} A \type{InstrumentMap.ChannelProgramTable} is a user-supplied table for mapping instrument names (\type{Instr}s) to Midi channels and General Midi patch names. The patch names are by default General Midi names, although the user can also provide a \type{PatchMap} for mapping Patch Names to unconventional Midi Program Change numbers. \begin{haskelllisting} 
> type ChannelTable instr =
>    [(instr,  ChannelMsg.Channel)]
> type ChannelProgramTable instr =
>    [(instr, (ChannelMsg.Channel, ChannelMsg.Program))]
> type ChannelProgramPitchTable instr =
>    [(instr, (ChannelMsg.Channel, ChannelMsg.Program, ChannelMsg.Pitch))]
>
> type ToChannel instr =
>    instr ->  ChannelMsg.Channel
> type ToChannelProgram instr =
>    instr -> (ChannelMsg.Channel, ChannelMsg.Program)
> type ToChannelProgramPitch instr =
>    instr -> (ChannelMsg.Channel, ChannelMsg.Program, ChannelMsg.Pitch)
>
> type FromChannel instr =
>     ChannelMsg.Channel -> Maybe instr
> type FromChannelProgram instr =
>    (ChannelMsg.Channel, ChannelMsg.Program) -> Maybe instr
> type FromChannelProgramPitch instr =
>    (ChannelMsg.Channel, ChannelMsg.Program, ChannelMsg.Pitch) -> Maybe instr
\end{haskelllisting} The \function{allValid} is used to test whether or not every instrument in a list is found in a \type{InstrumentMap.ChannelProgramTable}. \begin{haskelllisting} 
> repair :: [Instr] -> ChannelProgramTable Instr -> ChannelProgramTable Instr
> repair insts pMap =
>    if allValid pMap insts
>        then pMap
>        else tableFromInstruments insts
>
> allValid :: ChannelProgramTable Instr -> [Instr] -> Bool
> allValid upm = all (\x -> any (partialMatch x . fst) upm)
\end{haskelllisting} If a Haskore user only uses General Midi instrument names as \type{Instr}s, we can define a function that automatically creates a \type{InstrumentMap.ChannelProgramTable} from these names. Note that, since there are only 15 Midi channels plus percussion, we can handle only 15 instruments. Perhaps in the future a function could be written to test whether or not two tracks can be combined with a Program Change (tracks can be combined if they don't overlap). \begin{haskelllisting} 
> tableFromInstruments :: [Instr] -> ChannelProgramTable Instr
> tableFromInstruments instrs =
>    zip instrs (assignChannels GeneralMidi.instrumentChannels instrs)
>         -- 10th channel (#9) is for percussion

> assignChannels :: [ChannelMsg.Channel] -> [Instr] ->
>       [(ChannelMsg.Channel, ChannelMsg.Program)]
> assignChannels _ [] = []
> assignChannels [] _ =
>    error "Too many instruments; not enough MIDI channels."
> assignChannels chans@(c:cs) (i:is) =
>    let percList = ["percussion", "perc", "drum", "drums"]
>    in  if map toLower i `elem` percList
>          then (GeneralMidi.drumChannel, GeneralMidi.drumProgram)
>                      : assignChannels chans is
>          else (c, fromMaybe
>             (error ("unknown instrument <<" ++ i ++ ">>"))
>             (GeneralMidi.instrumentNameToProgram i))
>                      : assignChannels cs is

> fromInstruments :: Ord instr => [instr] -> ToChannel instr
> fromInstruments instrs =
>    let fm = Map.fromList (zip instrs GeneralMidi.instrumentChannels)
>    in  Map.findWithDefault fm (error "More instruments than channels")
\end{haskelllisting} The following functions lookup \type{Instr}s in \type{InstrumentMap.ChannelProgramTable}s to recover channel and program change numbers. Note that the function that does string matching ignores case, and that instrument name and search pattern match if one is a prefix of the other one. For example, \code{"chur"} matches \code{"Church Organ"}. Note also that the {\em first} match succeeds, so using a substring should be done with care to be sure that the correct instrument is selected. \begin{haskelllisting} 
> partialMatch :: Instr -> Instr -> Bool
> partialMatch "piano" "Acoustic Grand Piano" = True
> partialMatch s1 s2 =
>   let s1' = map toLower s1
>       s2' = map toLower s2
>   in  all (uncurry (==)) (zip s1' s2')
>
> lookupIName :: [(Instr, a)] -> Instr -> a
> lookupIName  ys x =
>    maybe (error ("InstrumentMap.lookupIName: Instrument " ++ x ++ " unknown"))
>          snd (List.find (partialMatch x . fst) ys)
>
> lookup :: Eq instr => [(instr, a)] -> instr -> a
> lookup ys x =
>    fromMaybe (error ("InstrumentMap.lookup: Instrument unknown"))
>              (List.lookup x ys)
\end{haskelllisting} \begin{haskelllisting} 
> reverseLookupMaybe :: Eq a => [(instr, a)] -> a -> Maybe instr
> reverseLookupMaybe ys x =
>    List.lookup x (map swap ys)

> reverseLookup :: Eq a => [(instr, a)] -> a -> instr
> reverseLookup ys x =
>    let instr = reverseLookupMaybe ys x
>        err   = error "InstrumentMap.reverseLookup: channel+program not found"
>    in  fromMaybe err instr
\end{haskelllisting} A default \type{InstrumentMap.ChannelProgramTable}. Note: the PC sound card I'm using is limited to 9 instruments. \begin{haskelllisting} 
> defltTable :: [(Instr, ChannelMsg.Channel, GeneralMidi.Instrument)]
> defltTable =
>    map (\(instr,chan,gmInstr) -> (instr, ChannelMsg.toChannel chan, gmInstr))
>    [("piano",   1, GeneralMidi.AcousticGrandPiano),
>     ("vibes",   2, GeneralMidi.Vibraphone),
>     ("bass",    3, GeneralMidi.AcousticBass),
>     ("flute",   4, GeneralMidi.Flute),
>     ("sax",     5, GeneralMidi.TenorSax),
>     ("guitar",  6, GeneralMidi.AcousticGuitarSteel),
>     ("violin",  7, GeneralMidi.Viola),
>     ("violins", 8, GeneralMidi.StringEnsemble1),
>     ("drums",   9, GeneralMidi.AcousticGrandPiano)]
>       -- the GM name for drums is unimportant, only channel 9

> deflt :: ChannelProgramTable Instr
> deflt =
>    map (\(iName, chan, gmName) ->
>          (iName, (chan, GeneralMidi.instrumentToProgram gmName))) defltTable

> defltGM :: ChannelProgramTable GeneralMidi.Instrument
> defltGM =
>    map (\(_, chan, gmName) ->
>          (gmName, (chan, GeneralMidi.instrumentToProgram gmName))) defltTable

> defltCMap :: [(GeneralMidi.Instrument, ChannelMsg.Channel)]
> defltCMap =
>    map (\(_, chan, gmName) -> (gmName, chan)) defltTable
\end{haskelllisting}