alsa-midi-0.3.2: examples/PlayMIDI.hs

module Main where

import qualified Sound.ALSA.Sequencer      as SndSeq
import qualified Sound.ALSA.Sequencer.FFI  as SndSeqFFI
import qualified Sound.ALSA.Sequencer.Play as SndSeqPlay

import qualified Sound.MIDI.File.Load as MIDILoad

-- import Control.Exception (bracket)
-- import Control.Monad.Error ()  -- Monad instance for Either
import Control.Monad (when)

import System.Console.GetOpt (getOpt, ArgOrder(..), OptDescr(..), ArgDescr(..), usageInfo)
import System.Environment (getArgs)
import System.Exit (exitWith, ExitCode(..))


play :: SndSeqFFI.Address -> FilePath -> IO ()
play dstAddress fileName =
   MIDILoad.fromFile fileName >>= SndSeqPlay.run dstAddress


parseAddress :: String -> Either String SndSeqFFI.Address
parseAddress str0 =
   let addrs =
          do (client, ':':str1) <- reads str0
             (port, [])         <- reads str1
             return $ SndSeq.numAddressEither client port
   in  case addrs of
          [addr] -> addr
          _      -> Left "address must be a string like '128:0'"

{-
parseAddressNaive :: String -> SndSeqFFI.Address
parseAddressNaive str =
   let (client, ':':port) = break (':'==) str
   in  SndSeqFFI.Address (read client) (read port)
-}


data Flags =
   Flags {
      optHelp :: Bool,
      optPort :: Either String SndSeqFFI.Address
     }

options :: [OptDescr (Flags -> Flags)]
options =
   Option ['h']     ["help"]    (NoArg (\ flags -> flags{optHelp = True}))  "show options" :
   Option ['p']     ["port"]    (ReqArg (\str flags -> flags{optPort = parseAddress str}) "PORT")  "destination PORT" :
   []

main :: IO ()
main =
   do argv <- getArgs
      let (opts, files, errors) = getOpt RequireOrder options argv
      when (not (null errors))
         (ioError . userError . concat $ errors)
      let flags = foldr ($)
            (Flags {optHelp = False,
                    optPort = Left "no port specified"}) opts
      when (optHelp flags)
         (putStrLn (usageInfo "Usage: playmidi [OPTIONS] FILES ..." options) >>
          exitWith ExitSuccess)
      port <-
         either
            (ioError . userError)
            return
            (optPort flags)
      mapM_ (play port) files