midimory-0.0.2.2: src/Option.hs

module Option where

import qualified Configuration as Config

import qualified Sound.ALSA.Sequencer.Event as Event

import Shell.Utility.Exit (exitFailureMsg)

import qualified Options.Applicative as OP

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

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


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)