{-# LANGUAGE RecordWildCards #-} import Options.Applicative import System.FilePath import System.FileLock import Data.Char import Trivmix.Types data Options = Options { baseDirectory :: FilePath , targetDirectory :: FilePath , levelFile :: FilePath , adjustment :: Adjustment Level } optionParser :: Parser Options optionParser = Options <$> strOption ( long "base" <> metavar "DIRECTORY" <> value "/dev/shm/mix" <> showDefault <> help "Base directory" ) <*> strOption ( long "target" <> short 't' <> metavar "DIRECTORY" <> help "Directory relative to ‘--base’ containing the level file" ) <*> strOption ( long "level" <> metavar "FILENAME" <> value "level" <> help "Filename of the level file" <> showDefault ) <*> ( ( Set <$> option auto ( long "set" <> short 'o' <> metavar "LEVEL" <> help "Overwrite the current level" ) ) <|> ( Add <$> option auto ( long "add" <> short 'a' <> metavar "LEVEL" <> help "Add to the current level" ) ) <|> ( Sub <$> option auto ( long "sub" <> short 's' <> metavar "LEVEL" <> help "Subtract from the current level" ) ) <|> ( ($) <$> ( flag' Add ( long "inc" <> short 'i' <> help "Increase level by a preset amount (see ‘--by’)" ) <|> flag' Sub ( long "dec" <> short 'd' <> help "Decrease level by a preset amount (see ‘--by’)" ) ) <*> ( option auto ( long "by" <> metavar "LEVEL" <> value (read "5dB") <> showDefault <> help "Value to decrease/increase level by when using ‘--inc’ or ‘--dec’" ) ) ) ) main :: IO () main = execParser opts >>= adjmix where opts = info (helper <*> optionParser) ( fullDesc <> progDesc "Adjust the level file of a trivmix" <> header "Adjmix — A trivial interface to a trivial mixer" ) adjmix :: Options -> IO () adjmix Options{..} = withFileLock levelFile' Exclusive $ const $ do oldLevel <- readFile levelFile' >>= readIO . stripSpace let newLevel = oldLevel `doAdjustment` adjustment writeFile levelFile' (show newLevel ++ "\n") where levelFile' = baseDirectory targetDirectory levelFile stripSpace = reverse . stripSpace' . reverse . stripSpace' stripSpace' [] = [] stripSpace' l@(x:xs) = if isSpace x then stripSpace' xs else l