midimory-0.0.1: src/Option.hs

module Option where

import qualified Configuration as Config

import qualified Sound.ALSA.Sequencer.Event as Event

import qualified System.Exit as Exit
import qualified System.IO as IO

import qualified Options.Applicative as OP

import qualified Control.Functor.HT as FuncHT
import Control.Applicative ((<*>), )

import Data.Bool.HT (if')
import Data.Monoid ((<>))


exitFailureMsg :: String -> IO a
exitFailureMsg msg = do
   IO.hPutStrLn IO.stderr msg
   Exit.exitFailure

parseChannel :: String -> Either String Event.Channel
parseChannel str =
   case reads str of
      [(ch, "")] ->
         if' (ch<0) (Left "negative MIDI channel") $
         if' (ch>=16) (Left "MIDI channel larger than 15") $
         Right $ Event.Channel $ fromInteger ch
      _ -> Left "MIDI channel must be a number"

parseArgs :: OP.Parser (Either String Config.T, ([String], Event.Channel))
parseArgs =
   OP.liftA2 (,) Config.option $
   OP.liftA2 (,)
      (OP.many $ OP.strOption $
         OP.short 'p' <>
         OP.long "connect-to" <>
         OP.metavar "ADDRESS" <>
         OP.help "Connect with synthesizer at startup")
      (OP.option (OP.eitherReader parseChannel) $
         OP.long "midi-channel" <>
         OP.value (Event.Channel 0) <>
         OP.metavar "CHANNEL" <>
         OP.help "Send on a certain MIDI channel (default: 0)")

info :: String -> OP.Parser a -> OP.ParserInfo a
info desc parser =
   OP.info
      (OP.helper <*> parser)
      (OP.fullDesc <> OP.progDesc desc)

multiArgs :: String -> IO (Config.T, ([String], Event.Channel))
multiArgs desc = do
   FuncHT.mapFst (either exitFailureMsg return)
      =<< OP.execParser (info desc parseArgs)